diff options
author | Miles Bader <miles@gnu.org> | 2007-07-09 08:00:55 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2007-07-09 08:00:55 +0000 |
commit | 1011c48763982d02797a7058556d29f639f6efca (patch) | |
tree | 5f1b7529b4cc483b73475b89245633c5848b8a5e | |
parent | 6f06dac7b57b8d73f4b26a855cd9862630192029 (diff) | |
parent | 69e4c7c4bacf19e9e004605fcb1c067e478beffe (diff) | |
download | emacs-1011c48763982d02797a7058556d29f639f6efca.tar.gz |
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 803-805)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-227
121 files changed, 10073 insertions, 2532 deletions
diff --git a/ChangeLog b/ChangeLog index f8bcf45ac3b..c90a2f73b1a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2007-06-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * configure.in: Complain if X seems to be installed but no + development files were found. + +2007-06-20 Glenn Morris <rgm@gnu.org> + + * configure.in: Prefer libgif over libungif. + 2007-06-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * configure.in: Check for all image libraries before exiting. @@ -6,11 +15,6 @@ * configure.in: Exit with error if image libraries aren't found. -2007-06-13 Michael Kifer <kifer@cs.stonybrook.edu> - - * ediff-ptch.el (ediff-context-diff-label-regexp): partially undid - previous patch - 2007-06-13 Chong Yidong <cyd@stupidchicken.com> * configure.in: Merge xaw3d and libXaw checks. Check xaw3d even diff --git a/configure b/configure index 7a44b81a3ca..2b767f3dc5e 100755 --- a/configure +++ b/configure @@ -686,6 +686,7 @@ ALSA_LIBS CFLAGS_SOUND SET_MAKE XMKMF +HAVE_XSERVER GTK_CFLAGS GTK_LIBS XFT_CFLAGS @@ -1345,7 +1346,7 @@ Optional Packages: --with-xpm use -lXpm for displaying XPM images --with-jpeg use -ljpeg for displaying JPEG images --with-tiff use -ltiff for displaying TIFF images - --with-gif use -lungif (or -lgif) for displaying GIF images + --with-gif use -lgif (or -lungif) for displaying GIF images --with-png use -lpng for displaying PNG images --with-freetype use -lfreetype for local fonts support --with-xft use -lXft for anti aliased fonts @@ -9614,6 +9615,68 @@ case "${window_system}" in ;; esac +if test "$window_system" = none && test "X$with_x" != "Xno"; then + # Extract the first word of "X", so it can be a program name with args. +set dummy X; ac_word=$2 +{ echo "$as_me:$LINENO: checking for $ac_word" >&5 +echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; } +if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test -n "$HAVE_XSERVER"; then + ac_cv_prog_HAVE_XSERVER="$HAVE_XSERVER" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_HAVE_XSERVER="true" + echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done +done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_HAVE_XSERVER" && ac_cv_prog_HAVE_XSERVER="false" +fi +fi +HAVE_XSERVER=$ac_cv_prog_HAVE_XSERVER +if test -n "$HAVE_XSERVER"; then + { echo "$as_me:$LINENO: result: $HAVE_XSERVER" >&5 +echo "${ECHO_T}$HAVE_XSERVER" >&6; } +else + { echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6; } +fi + + + if test "$HAVE_XSERVER" = true || + test -n "$DISPLAY" || + test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then + { { echo "$as_me:$LINENO: error: You seem to be running X, but no X development libraries +where found. You should install the relevant development files for X +and the for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make +sure you have development files for image handling, i.e. +tiff, gif, jpeg, png and xpm. +If you are sure you want Emacs compiled without X window support, pass + --without-x +to configure." >&5 +echo "$as_me: error: You seem to be running X, but no X development libraries +where found. You should install the relevant development files for X +and the for the toolkit you want, such as Gtk+, Lesstif or Motif. Also make +sure you have development files for image handling, i.e. +tiff, gif, jpeg, png and xpm. +If you are sure you want Emacs compiled without X window support, pass + --without-x +to configure." >&2;} + { (exit 1); exit 1; }; } + fi +fi + ### If we're using X11, we should use the X menu package. HAVE_MENUS=no case ${HAVE_X11} in @@ -14270,13 +14333,13 @@ fi if test $ac_cv_header_gif_lib_h = yes; then # EGifPutExtensionLast only exists from version libungif-4.1.0b1. # Earlier versions can crash Emacs. - { echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lungif" >&5 -echo $ECHO_N "checking for EGifPutExtensionLast in -lungif... $ECHO_C" >&6; } -if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then + { echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lgif" >&5 +echo $ECHO_N "checking for EGifPutExtensionLast in -lgif... $ECHO_C" >&6; } +if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lungif $LIBS" +LIBS="-lgif $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -14317,24 +14380,24 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - ac_cv_lib_ungif_EGifPutExtensionLast=yes + ac_cv_lib_gif_EGifPutExtensionLast=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_lib_ungif_EGifPutExtensionLast=no + ac_cv_lib_gif_EGifPutExtensionLast=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5 -echo "${ECHO_T}$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } -if test $ac_cv_lib_ungif_EGifPutExtensionLast = yes; then +{ echo "$as_me:$LINENO: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5 +echo "${ECHO_T}$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } +if test $ac_cv_lib_gif_EGifPutExtensionLast = yes; then HAVE_GIF=yes else - try_libgif=yes + try_libungif=yes fi fi @@ -14342,18 +14405,18 @@ fi if test "$HAVE_GIF" = yes; then - ac_gif_lib_name="-lungif" + ac_gif_lib_name="-lgif" fi -# If gif_lib.h but no libungif, try libgif. - if test x"$try_libgif" = xyes; then - { echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lgif" >&5 -echo $ECHO_N "checking for EGifPutExtensionLast in -lgif... $ECHO_C" >&6; } -if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then +# If gif_lib.h but no libgif, try libungif. + if test x"$try_libungif" = xyes; then + { echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lungif" >&5 +echo $ECHO_N "checking for EGifPutExtensionLast in -lungif... $ECHO_C" >&6; } +if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_check_lib_save_LIBS=$LIBS -LIBS="-lgif $LIBS" +LIBS="-lungif $LIBS" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF @@ -14394,21 +14457,21 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 test ! -s conftest.err } && test -s conftest$ac_exeext && $as_test_x conftest$ac_exeext; then - ac_cv_lib_gif_EGifPutExtensionLast=yes + ac_cv_lib_ungif_EGifPutExtensionLast=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_cv_lib_gif_EGifPutExtensionLast=no + ac_cv_lib_ungif_EGifPutExtensionLast=no fi rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS fi -{ echo "$as_me:$LINENO: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5 -echo "${ECHO_T}$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test $ac_cv_lib_gif_EGifPutExtensionLast = yes; then +{ echo "$as_me:$LINENO: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5 +echo "${ECHO_T}$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } +if test $ac_cv_lib_ungif_EGifPutExtensionLast = yes; then HAVE_GIF=yes fi @@ -14416,10 +14479,10 @@ fi if test "$HAVE_GIF" = yes; then cat >>confdefs.h <<\_ACEOF -#define LIBGIF -lgif +#define LIBGIF -lungif _ACEOF - ac_gif_lib_name="-lgif" + ac_gif_lib_name="-lungif" fi fi @@ -24601,6 +24664,7 @@ ALSA_LIBS!$ALSA_LIBS$ac_delim CFLAGS_SOUND!$CFLAGS_SOUND$ac_delim SET_MAKE!$SET_MAKE$ac_delim XMKMF!$XMKMF$ac_delim +HAVE_XSERVER!$HAVE_XSERVER$ac_delim GTK_CFLAGS!$GTK_CFLAGS$ac_delim GTK_LIBS!$GTK_LIBS$ac_delim XFT_CFLAGS!$XFT_CFLAGS$ac_delim @@ -24628,6 +24692,12 @@ lispdir!$lispdir$ac_delim locallisppath!$locallisppath$ac_delim lisppath!$lisppath$ac_delim x_default_search_path!$x_default_search_path$ac_delim +etcdir!$etcdir$ac_delim +archlibdir!$archlibdir$ac_delim +bitmapdir!$bitmapdir$ac_delim +gamedir!$gamedir$ac_delim +gameuser!$gameuser$ac_delim +c_switch_system!$c_switch_system$ac_delim _ACEOF if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then @@ -24669,12 +24739,6 @@ _ACEOF ac_delim='%!_!# ' for ac_last_try in false false false false false :; do cat >conf$$subs.sed <<_ACEOF -etcdir!$etcdir$ac_delim -archlibdir!$archlibdir$ac_delim -bitmapdir!$bitmapdir$ac_delim -gamedir!$gamedir$ac_delim -gameuser!$gameuser$ac_delim -c_switch_system!$c_switch_system$ac_delim c_switch_machine!$c_switch_machine$ac_delim LD_SWITCH_X_SITE!$LD_SWITCH_X_SITE$ac_delim LD_SWITCH_X_SITE_AUX!$LD_SWITCH_X_SITE_AUX$ac_delim diff --git a/configure.in b/configure.in index 1b8bcc8880e..5fc3e584d5f 100644 --- a/configure.in +++ b/configure.in @@ -105,7 +105,7 @@ AC_ARG_WITH(jpeg, AC_ARG_WITH(tiff, [ --with-tiff use -ltiff for displaying TIFF images]) AC_ARG_WITH(gif, -[ --with-gif use -lungif (or -lgif) for displaying GIF images]) +[ --with-gif use -lgif (or -lungif) for displaying GIF images]) AC_ARG_WITH(png, [ --with-png use -lpng for displaying PNG images]) AC_ARG_WITH(freetype, @@ -1901,6 +1901,22 @@ dnl use the toolkit if we have gtk, or X11R5 or newer. ;; esac +if test "$window_system" = none && test "X$with_x" != "Xno"; then + AC_CHECK_PROG(HAVE_XSERVER, X, true, false) + if test "$HAVE_XSERVER" = true || + test -n "$DISPLAY" || + test "`echo /usr/lib/libX11.*`" != "/usr/lib/libX11.*"; then + AC_MSG_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. +tiff, gif, jpeg, png and xpm. +If you are sure you want Emacs compiled without X window support, pass + --without-x +to configure.]) + fi +fi + ### If we're using X11, we should use the X menu package. HAVE_MENUS=no case ${HAVE_X11} in @@ -2593,24 +2609,24 @@ if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then AC_CHECK_HEADER(gif_lib.h, # EGifPutExtensionLast only exists from version libungif-4.1.0b1. # Earlier versions can crash Emacs. - AC_CHECK_LIB(ungif, EGifPutExtensionLast, HAVE_GIF=yes, try_libgif=yes)) + AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes, try_libungif=yes)) if test "$HAVE_GIF" = yes; then - ac_gif_lib_name="-lungif" + ac_gif_lib_name="-lgif" fi -# If gif_lib.h but no libungif, try libgif. - if test x"$try_libgif" = xyes; then - AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes) +# If gif_lib.h but no libgif, try libungif. + if test x"$try_libungif" = xyes; then + AC_CHECK_LIB(ungif, EGifPutExtensionLast, HAVE_GIF=yes) if test "$HAVE_GIF" = yes; then - AC_DEFINE(LIBGIF, -lgif, [Compiler option to link with the gif library (if not -lungif).]) - ac_gif_lib_name="-lgif" + AC_DEFINE(LIBGIF, -lungif, [Compiler option to link with the gif library (if not -lgif).]) + ac_gif_lib_name="-lungif" fi fi if test "${HAVE_GIF}" = "yes"; then - AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif library (default -lungif; otherwise specify with LIBGIF).]) + AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif library (default -lgif; otherwise specify with LIBGIF).]) fi fi diff --git a/etc/ChangeLog b/etc/ChangeLog index 49028bdf691..b88e98af123 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,19 @@ +2007-07-07 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: New function `start-file-process'. + +2007-07-02 Carsten Dominik <dominik@science.uva.nl> + + * orgcard.tex: Version 5.01 + +2007-06-27 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: `dired-call-process' has been removed. + +2007-06-20 Glenn Morris <rgm@gnu.org> + + * NEWS: configure prefers libgif over libungif. + 2007-06-14 Nick Roberts <nickrob@snap.net.nz> * NEWS: Mention mouse highlighting in a GNU/Linux console. @@ -28,17 +28,24 @@ so we will look at it and add it to the manual. ** The default X toolkit is now Gtk+, rather than Lucid. -** configure now checks for libgif (as well as libungif) when -searching for a GIF library. +** configure now checks for libgif before libungif when searching for +a GIF library. * Changes in Emacs 23.1 +** If you set find-file-confirm-nonexistent-file to t, then C-x C-f +requires confirmation before opening a non-existent file. + ** If the gpm mouse server is running and t-mouse-mode enabled, Emacs uses a Unix socket in a GNU/Linux console to talk to server, rather than faking events using the client program mev. This C level approach provides mouse highlighting, and help echoing in the minibuffer. +** The new variable next-error-recenter specifies how next-error should +recenter the visited source file. Its value can be a number (for example, +0 for top line, -1 for bottom line), or nil for no recentering. + * Startup Changes in Emacs 23.1 @@ -57,6 +64,8 @@ highlighting, and help echoing in the minibuffer. ** bibtex-style-mode helps you write BibTeX's *.bst files. +** vera-mode to edit Vera files. + ** socks.el (which had been part of W3) is now part of Emacs. ** minibuffer-indicate-depth-mode shows the minibuffer depth in the prompt. @@ -68,8 +77,23 @@ highlighting, and help echoing in the minibuffer. Only copyright lines with holders matching copyright-names-regexp will be considered for update. +** VC +*** VC backends can provide completion of revision names. +*** VC has some support for Bazaar (bzr). + +*** VC has some support for Mercurial (hg). + +** sgml-electric-tag-pair-mode lets you simultaneously edit matched tag pairs. + +** BibTeX mode: + +*** New `bibtex-entry-format' options `whitespace', `braces', and +`string', disabled by default. -** VC has some support for Bazaar (bzr). +*** New variable `bibtex-cite-matcher-alist' contains rules to +identify cited keys in BibTeX entries, used by `bibtex-find-crossref. + +*** Command `bibtex-url' now allows multiple URLs per entry. * Changes in Emacs 23.1 on non-free operating systems @@ -77,9 +101,15 @@ considered for update. * Incompatible Lisp Changes in Emacs 23.1 ++++ +** The function `dired-call-process' has been removed. + * Lisp Changes in Emacs 23.1 +** The `require-match' argument to `completing-read' accepts a new value +`confirm-only'. + +++ ** The regexp form \(?<num>:<regexp>\) specifies the group number explicitly. @@ -91,6 +121,11 @@ Use this instead of "~/.emacs.d". ** The new function `image-refresh' refreshes all images associated with a given image specification. ++++ +** The new function `start-file-process is similar to `start-process', +but obeys file handlers. The file handler is chosen based on +`default-directory'. + * New Packages for Lisp Programming in Emacs 23.1 diff --git a/etc/NEWS.22 b/etc/NEWS.22 index ed9babda50c..4da26ff9271 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -50,8 +50,14 @@ to be scrolled horizontally or vertically instead. ** The new package css-mode.el provides a major mode for editing CSS files. +** The new package vera-mode.el provides a major mode for editing Vera files. + ** The new package socks.el implements the SOCKS v5 protocol. +** VC + +*** VC has some support for Mercurial (hg). + * Installation Changes in Emacs 22.1 @@ -259,6 +265,14 @@ need to quote the space with a C-q. The underlying changes in the keymaps that are active in the minibuffer are described below under "New keymaps for typing file names". +If you want the old behavior back, put these two key bindings to your +~/.emacs init file: + + (define-key minibuffer-local-filename-completion-map + " " 'minibuffer-complete-word) + (define-key minibuffer-local-must-match-filename-map + " " 'minibuffer-complete-word) + ** The completion commands TAB, SPC and ? in the minibuffer apply only to the text before point. If there is text in the buffer after point, it remains unchanged. diff --git a/etc/orgcard.tex b/etc/orgcard.tex index ab891a0be13..d9f60f62f8c 100644 --- a/etc/orgcard.tex +++ b/etc/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{4.77} +\def\orgversionnumber{5.01} \def\versionyear{2007} % latest update \def\year{2007} % latest copyright year @@ -111,14 +111,17 @@ are preserved on all copies. \footline{\hss\folio} \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} \else %2 or 3 columns uses prereduced size - \hsize 3.2in \if 1\the\letterpaper + \hsize 3.2in \vsize 7.95in + \hoffset -.75in + \voffset -.745in \else + \hsize 3.2in \vsize 7.65in + \hoffset -.25in + \voffset -.745in \fi - \hoffset -.75in - \voffset -.745in \font\titlefont=cmbx10 \scaledmag2 \font\headingfont=cmbx10 \scaledmag1 \font\smallfont=cmr6 @@ -418,6 +421,7 @@ formula, \kbd{:=} a field formula. \key{toggle coordinate grid}{C-c \}} \key{toggle formula debugger}{C-c \{} +\newcolumn {\it Formula Editor} \key{edit formulas in separate buffer}{C-c '} @@ -617,7 +621,7 @@ To set categories, add lines like$^2$: {\bf Change display} \key{delete other windows}{o} -\key{switch to daily / weekly view}{d / w} +\key{switch to day/week/month/year view}{d w m y} \key{toggle inclusion of diary entries}{D} \key{toggle time grid for daily schedule}{g} \key{toggle display of logbook entries}{l} diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 649b37c4494..dfea40b56ba 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,14 +1,140 @@ -2007-07-08 Chong Yidong <cyd@stupidchicken.com> +2007-07-08 Martin Rudalics <rudalics@gmx.at> - * longlines.el (longlines-wrap-region): Avoid marking buffer as - modified. - (longlines-auto-wrap, longlines-window-change-function): Remove - unnecessary calls to set-buffer-modified-p. + * novice.el (disabled-command-function): Fit window to buffer to + make last line visible. + Reported by Stephen Berman <Stephen.Berman at gmx.net>. + + * mouse.el (mouse-drag-track): Reset transient-mark-mode to nil + when handling the terminating event. + +2007-07-07 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-read-number-simple): Remove leading 0s. + (math-bignum-digit-length): Change to optimal value. + + * calc/calc-bin.el (math-bignum-logb-digit-size) + (math-bignum-digit-power-of-two): Evaluate when compiled. + + * calc/calc-comb.el (math-small-factorial-table) + (math-init-random-base,math-prime-test): Remove unnecessary calls + to `math-read-number-simple'. + + * calc/calc-ext.el (math-approx-pi,math-approx-sqrt-e) + (math-approx-gamma-const): Add docstrings. + + * calc/calc-forms.el (math-julian-date-beginning) + (math-julian-date-beginning-int) New constants. + (math-format-date-part,math-parse-standard-date,calcFunc-julian): + Use the new constants. + + * calc/calc-funcs.el (math-gammap1-raw): Add docstring. + + * calc/calc-math.el (math-approx-ln-10,math-approx-ln-2): Add docstrings. + +2007-07-07 Tom Tromey <tromey@redhat.com> + + * vc.el (vc-annotate): Jump to line and output message only after the + process is really all done. + +2007-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc.el (vc-exec-after): Don't move point from the sentinel. + Forcefully read all the remaining text in the pipe upon process exit. + (vc-annotate-display-autoscale, vc-annotate-lines): + Don't stop at the first unrecognized line. + (vc-annotate-display-select): Run autoscale after the process is done + since it depends on the whole result. + +2007-07-07 Eli Zaretskii <eliz@gnu.org> + + * term/w32-win.el (menu-bar-open): New function. + Bind <f10> to it. + +2007-07-07 Michael Albinus <michael.albinus@gmx.de> + + * simple.el (start-file-process): New defun. + +2007-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (find-file-confirm-nonexistent-file): Rename from + find-file-confirm-inexistent-file. Update users. + + * emacs-lisp/autoload.el (autoload-find-destination): Understand a new + format of autoload block where the file's time-stamp is replaced by its + MD5 checksum. + (autoload-generate-file-autoloads): Use MD5 checksum instead of + time-stamp for secondary autoloads files. + (update-directory-autoloads): Remove duplicate entries. + Use time-less-p for time-stamps, as done in autoload-find-destination. + +2007-07-07 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-read-number): Replace number by variable. + (math-read-number-simple): Properly parse small integers. + +2007-07-07 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Fix doc for the checkout function. + +2007-07-06 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-root): New function. + (vc-hg-registered): Use it. + (vc-hg-diff-tree): New defalias. + (vc-hg-responsible-p): Likewise. + (vc-hg-checkout): Comment out, not needed. + (vc-hg-delete-file, vc-hg-rename-file, vc-hg-could-register) + (vc-hg-find-version, vc-hg-next-version): New functions. + +2007-07-06 Andreas Schwab <schwab@suse.de> + + * emacs-lisp/lisp-mode.el (eval-last-sexp): Avoid introducing any + dynamic bindings around the evaluation of the expression. + Reported by Jay Belanger <jay.p.belanger@gmail.com>. + +2007-07-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * autorevert.el (auto-revert-tail-handler): Use inhibit-read-only. + Run before-revert-hook. Suggested by Denis Bueno <denbuen@sandia.gov>. + Use run-hooks rather than run-mode-hooks. + +2007-07-05 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-comb.el (math-random-digit): Rename to + `math-random-three-digit-number'. + (math-random-digits): Don't depend on representation of integer. + + * calc/calc-bin.el (math-bignum-logb-digit-size) + (math-bignum-digit-power-of-two): New constants. + (math-and-bignum,math-or-bignum,math-xor-bignum,math-diff-bignum) + (math-not-bignum,math-clip-bignum): Use the constants + `math-bignum-digit-power-of-two' and `math-bignum-logb-digit-size' + instead of their values. + (math-clip): Use math-small-integer-size instead of its value. + + * calc/calc.el (math-add-bignum): Replace number by constant. 2007-07-05 Chong Yidong <cyd@stupidchicken.com> - * wid-edit.el (widget-documentation-string-value-create): Insert - spaces for indentation. + * wid-edit.el (widget-documentation-string-value-create): + Insert indentation spaces. + +2007-07-05 Thien-Thi Nguyen <ttn@gnuvola.org> + + * emacs-lisp/byte-opt.el: Revert last change. + +2007-07-05 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hooks.el (vc-handled-backends): Add HG. + + * vc-hg.el (vc-handled-backends): Remove, done in vc-hooks.el now. + +2007-07-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * complete.el (PC-do-complete-and-exit): Add support for the new + `confirm-only' confirmation mode. + +2007-07-05 Chong Yidong <cyd@stupidchicken.com> * cus-edit.el (custom-commands): New variable. (custom-tool-bar-map): New variable. Initialize using @@ -35,6 +161,633 @@ (custom-group-reset-current, custom-group-reset-saved) (custom-group-reset-standard): Minor cleanup. +2007-07-05 Thien-Thi Nguyen <ttn@gnuvola.org> + + * Makefile.in (bootstrap-prepare): When copying from + ldefs-boot.el, make sure loaddefs.el is writeable. + + (bootstrap-prepare): Make $(lisp)/ps-print.el + and $(lisp)/emacs-lisp/cl-loaddefs.el writable, as well. + +2007-07-05 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-internal-status): Inline in `vc-hg-state', the + only caller, and delete. + (vc-hg-state): Deal with exceptions and only parse the output on + successful return. + (vc-hg-internal-log): Inline in `vc-hg-workfile-version', the only + caller, and delete. + (vc-hg-workfile-version): Deal with exceptions and only parse the + output on successful return. + (vc-hg-revert): New function. + +2007-07-04 Jay Belanger <jay.p.belanger@gmail.com> + + * calculator.el (calculator-expt): Use more cases to determine + the value. + +2007-07-03 Jay Belanger <jay.p.belanger@gmail.com> + + * calculator.el (calculator-expt, calculator-integer-p): + New functions. + (calculator-fact): Check to see if the factorial will be too + large before computing it. + (calculator-initial-operators): Use `calculator-expt' to + compute "^". + (calculator-mode): Mention that results which are too large + will return inf. + * calc/calc-comb.el (math-small-factorial-table): Replace list + by vector. + +2007-07-03 David Kastrup <dak@gnu.org> + + * shell.el: On request of the authors, remove their addresses for + the sake of bug reports, and add the developer list address as + maintainer information. + +2007-07-03 Richard Stallman <rms@gnu.org> + + * files.el (make-directory): Doc fix. + (find-file-confirm-inexistent-file): Make it a defcustom. + Make nil the default. + +2007-07-02 Richard Stallman <rms@gnu.org> + + * startup.el (command-line): Set buffer-offer-save in *scratch* + and enable auto-save in it. + +2007-07-02 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (orgstruct-mode-map): New variable. + (orgstruct-mode): New minor mode. + (turn-on-orgstruct, orgstruct-error, orgstruct-setup) + (orgstruct-make-binding, org-context-p, org-get-local-variables) + (org-run-like-in-org-mode): New functions. + (org-cycle-list-bullet): New command. + (org-special-properties, org-property-start-re) + (org-property-end-re): New constants. + (org-with-point-at): New macro. + (org-get-property-block, org-entry-properties, org-entry-get) + (org-entry-delete, org-entry-get-with-inheritance) + (org-entry-put, org-buffer-property-keys): New functions. + (org-insert-property-drawer): New command. + (org-entry-property-inherited-from): New variable. + (org-column): New face. + (org-column-overlays, org-current-columns-fmt) + (org-current-columns-maxwidths, org-column-map): New variables. + (org-column-menu): New menu. + (org-new-column-overlay, org-overlay-columns) + (org-overlay-columns-title, org-remove-column-overlays) + (org-column-show-value, org-column-quit, org-column-edit): New + functions. + (org-columns, org-agenda-columns): New commands. + (org-get-columns-autowidth-alist): New functions. + (org-properties): New customize group. + (org-default-columns-format): New option. + (org-priority): Realign tags after changing priority. + (org-preserve-lc): New macro. + (org-update-checkbox-count): Catch case when there is no headline. + (org-agenda-quit): Remove any column overlays. + (org-beginning-of-item-list): Fixed bug when non-item line is + indented too deep. + (org-cached-props): New variable. + (org-cached-entry-get): New function. + (org-make-tags-matcher): Handle property matches. + (org-table-recalculate): Swap evaluation order: Field formula + first, then column formulas, but don't allow them to overwrite the + field formulas. + (org-table-eval-formula): New argument untouchable. + (org-table-put-field-property): New function. + +2007-07-02 Martin Rudalics <rudalics@gmx.at> + + * help-mode.el (help-make-xrefs): Skip spaces too when + skipping tabs. + + * ffap.el (dired-at-point-prompter): Improve prompt in + list-directory case. + +2007-07-01 Richard Stallman <rms@gnu.org> + + * cus-start.el (max-mini-window-height): Added. + +2007-07-01 Sean O'Rourke <sorourke@cs.ucsd.edu> (tiny change) + + * complete.el (partial-completion-mode): Remove advice of + read-file-name-internal. + (PC-do-completion): Rebind minibuffer-completion-table. + (PC-read-file-name-internal): New function doing what + read-file-name-internal advice did. + +2007-07-01 Paul Pogonyshev <pogonyshev@gmx.net> + + * emacs-lisp/byte-opt.el: Set `binding-is-magic' + property on a few symbols. + (byte-compile-side-effect-free-dynamically-safe-ops): New defconst. + (byte-optimize-lapcode): Remove bindings that are not referenced + and certainly will not effect through dynamic scoping. + +2007-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (find-file-confirm-inexistent-file): New var. + (find-file, find-file-other-window, find-file-other-frame) + (find-file-read-only, find-file-read-only-other-window) + (find-file-read-only-other-frame): Use it. + +2007-06-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/rx.el (rx-constituents): Fix up `anything'. + +2007-06-29 Juanma Barranquero <lekktu@gmail.com> + + * generic-x.el (generic-define-mswindows-modes) + (generic-define-unix-modes, apache-log-generic-mode) + (bat-generic-mode-keymap, java-manifest-generic-mode) + (show-tabs-generic-mode): Fix typos in docstrings. + +2007-06-29 Ryan Yeske <rcyeske@gmail.com> + + * net/rcirc.el (rcirc-server-alist): Rename from rcirc-connections. + (rcirc-default-full-name): Rename from rcirc-default-user-full-name. + (rcirc-clear-activity): Make sure RCIRC-ACTIVITY isn't modified. + (rcirc-print): Never ignore messages from ourself. + +2007-06-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (lisp-font-lock-keywords-2): Recognize the new \(?1:..\) + syntax as well. Reported by Juri Linkov <juri@jurta.org>. + +2007-06-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to + replace-regexp-in-string. + +2007-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl.el: Set edebug and indentation before loading + cl-loaddefs.el so that its use of dolist doesn't load cl-macs. + +2007-06-28 Andreas Schwab <schwab@suse.de> + + * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Depend on + $(lisp)/subdirs.el. + +2007-06-28 Juanma Barranquero <lekktu@gmail.com> + + * speedbar.el (speedbar-handle-delete-frame): Don't try to delete + the speedbar frame if nil; that deletes the current frame or + causes an error if it is the only frame. + Reported by Angelo Graziosi <Angelo.Graziosi@roma1.infn.it>. + +2007-06-28 Kevin Ryde <user42@zip.com.au> + + * textmodes/nroff-mode.el: Groff \# comments. + (nroff-mode-syntax-table): \# comment intro, + plain # as punct per global table. + (nroff-font-lock-keywords): Add # as a single char escape. + (nroff-mode): In comment-start-skip, match \#. + +2007-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-bzr.el (vc-functions): Clear up the cache when reloading the file. + (vc-bzr-workfile-version, vc-bzr-could-register): Don't hardcode + point-min == 1. + +2007-06-28 Nick Roberts <nickrob@snap.net.nz> + + * pcvs-util.el (cvs-strings->string, cvs-string->strings): + Rename and move to... + + * subr.el (strings->string, string->strings): ...here. + + * pcvs.el (cvs-reread-cvsrc, cvs-header-msg, cvs-checkout) + (cvs-mode-checkout, cvs-execute-single-file): Use new function names. + + * progmodes/gud.el (gud-common-init): Call string->strings instead + of split-string. + +2007-06-27 Michael Albinus <michael.albinus@gmx.de> + + * dired-aux.el: Remove `dired-call-process'. + (dired-check-process): Call `process-file'. + + * wdired.el (wdired-do-perm-changes): Call `process-file'. + + * net/ange-ftp.el (ange-ftp-dired-call-process): Reimplement it as + `ange-ftp-process-file'. + +2007-06-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl.el: Use cl-loaddefs.el rather than manual autoloads. + + * emacs-lisp/cl-extra.el: + * emacs-lisp/cl-seq.el: + * emacs-lisp/cl-macs.el: Set generated-autoload-file to cl-loaddefs.el. + Add autoload cookies on all defs autoloaded manually in cl.el. + + * emacs-lisp/cl-loaddefs.el: New file. + + * textmodes/texinfmt.el (texinfo-raisesections-alist) + (texinfo-lowersections-alist): Merge definition and declaration. + (texinfo-start-of-header, texinfo-end-of-header): Remove. + (texinfo-format-syntax-table): Merge init into declaration. + (texinfo-format-parse-line-args, texinfo-format-parse-args) + (texinfo-format-parse-defun-args, texinfo-format-node) + (texinfo-push-stack, texinfo-multitable-widths) + (texinfo-define-info-enclosure, texinfo-alias) + (texinfo-format-defindex, batch-texinfo-format): Use push. + (texinfo-footnote-number): Remove duplicate declaration. + + * ps-print.el: Update with auto-generated autoloads. + + * ps-mule.el: Set generated-autoload-file to "ps-print.el". + +2007-06-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (autoload-generated-file): Interpret names + relative to current dir for file-local settings. + (autoload-generate-file-autoloads): Add `outfile' arg. + (update-directory-autoloads): Use it to directly call + autoload-generate-file-autoloads instead of going through + update-file-autoloads so we avoid redundant searches and so we can know + the set of buffers changed so we can save them all. + + * emacs-lisp/autoload.el (autoload-find-destination): Return nil + rather than throwing `up-to-date'. + (autoload-generate-file-autoloads): Adjust correspondingly. + (update-file-autoloads): Be careful to let-bind + autoload-modified-buffers and adjust to new calling conventions. + (autoload-modified-buffers): Make it a dynamically scoped var. + (update-directory-autoloads): Use file-relative-name instead of + autoload-trim-file-name. + (autoload-insert-section-header): Don't use autoload-trim-file-name + since the file is already relative now. + (autoload-trim-file-name): Remove. + + * vc-arch.el (vc-arch-add-tagline): Do a slightly cleaner job. + (vc-arch-complete, vc-arch--version-completion-table) + (vc-arch-revision-completion-table): New functions to provide + completion of revision names. + (vc-arch-trim-find-least-useful-rev, vc-arch-trim-make-sentinel) + (vc-arch-trim-one-revlib, vc-arch-trim-revlib): New functions + to let the user trim the revlib. + + * vc.el: Add new VC operation `revision-completion-table'. + (vc-default-revision-completion-table): New function. + (vc-version-diff, vc-version-other-window): Use it to provide + completion of revision names if the backend provides it. + + * log-edit.el (log-edit-changelog-entries): Use with-current-buffer. + + * vc-svn.el (vc-svn-repository-hostname): Adjust to non-XML format + of newer .svn/entries. + +2007-06-25 David Kastrup <dak@gnu.org> + + * calc/calc-poly.el (math-padded-polynomial) + (math-partial-fractions): Add some function comments. + +2007-06-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (autoload-generate-file-autoloads): + Make `outbuf' optional. + (update-file-autoloads): Use it. + +2007-06-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (autoload-modified-buffers): New var. + (autoload-find-destination): Keep it uptodate. + (autoload-save-buffers): New fun. + (update-file-autoloads): Use it. Re-add the "up to date" message. + + * emacs-lisp/autoload.el: Refactor for upcoming changes. + (autoload-find-destination): New function extracted from + update-file-autoloads. + (update-file-autoloads): Use it. + (autoload-generate-file-autoloads): New function extracted from + generate-file-autoloads. Use file-relative-name. Delay computation of + output-start to the first cookie. Remove done-any, replaced by + output-start. + (generate-file-autoloads): Use it. + +2007-06-24 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-comb.el (math-init-random-base, math-prime-test): + Use math-read-number-simple to insert constants. + (math-prime-test): Redo calculation of sum. + + * calc/calc-misc.el (math-div2-bignum): Use math-bignum-digit-size. + + * calc/calc-math.el (math-scale-bignum-digit-size): Rename from + math-scale-bignum-3. + (math-isqrt-bignum): Use math-scale-bignum-digit-size and + math-bignum-digit-size. + (math-isqrt-small): Add another possible initial guess. + +2007-06-23 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-entry-format): New options + `whitespace', `braces', and `string'. + (bibtex-field-braces-alist, bibtex-field-strings-alist) + (bibtex-field-braces-opt, bibtex-field-strings-opt) + (bibtex-cite-matcher-alist): New variables. + (bibtex-font-lock-keywords): Use bibtex-cite-matcher-alist. + (bibtex-flash-head): Use blink-matching-delay. + (bibtex-insert-kill, bibtex-mark-entry): Use push-mark. + (bibtex-format-entry, bibtex-reformat): Handle new options of + bibtex-entry-format. + (bibtex-field-re-init, bibtex-font-lock-cite, bibtex-dist): + New functions. + (bibtex-complete-internal): Do not display messages while + minibuffer is used. Do not leave around a completions buffer + that is out of date. + (bibtex-copy-summary-as-kill): New optional arg. + (bibtex-font-lock-url): New optional arg no-button. + (bibtex-find-crossref): Use `bibtex-cite-matcher-alist'. + (bibtex-url): Allow multiple URLs per entry. + +2007-06-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (autoload-generated-file): New function. + (update-file-autoloads, update-directory-autoloads): Use it. + (autoload-file-load-name): New function. + (generate-file-autoloads, update-file-autoloads): Use it. + (autoload-find-file): Accept non-absolute argument. Set default-dir. + (generate-file-autoloads): If the autoloaded form is malformed, + indicate the problem with a warning instead of aborting. + +2007-06-23 Thien-Thi Nguyen <ttn@gnuvola.org> + + * simple.el (next-error-recenter): Accept `(4)' as well; + also, specify `integer' instead of `number'. + +2007-06-23 Eli Zaretskii <eliz@gnu.org> + + * ls-lisp.el (insert-directory): If an invalid regexp error is + thrown, try using FILE as a literal file name, not a wildcard. + +2007-06-23 Juanma Barranquero <lekktu@gmail.com> + + * ruler-mode.el (ruler-mode): Prevent clobbering the original + `header-line-format' when reentering ruler mode. + +2007-06-23 Eli Zaretskii <eliz@gnu.org> + + * ls-lisp.el (insert-directory): Don't treat FILE as a wildcard if + FILE exists as a file. + +2007-06-22 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-bignum-digit-length) + (math-bignum-digit-size, math-small-integer-size): + New constants. + (math-normalize, math-bignum-big, math-make-float) + (math-div10-bignum, math-scale-left, math-scale-left-bignum) + (math-scale-right, math-scale-right-bignum, math-scale-rounding) + (math-add, math-add-bignum, math-sub-bignum, math-sub, math-mul) + (math-mul-bignum, math-mul-bignum-digit, math-idivmod) + (math-quotient, math-div-bignum, math-div-bignum-digit) + (math-div-bignum-part, math-format-bignum-decimal) + (math-read-bignum): Use math-bignum-digit-length, + math-bignum-digit-size and math-small-integer-size. + + * calc/calc-ext.el (math-fixnum-big): Use the variable + math-bignum-digit-size. + +2007-06-23 Dan Nicolaescu <dann@ics.uci.edu> + + * log-view.el (log-view-mode-menu): New menu. + +2007-06-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-font-lock-keywords): Fix M. Kifer's last change + differently. + + * vc-hg.el (vc-hg-registered): Add an autoloaded version. + (vc-hg-log-view-mode): Use log-view-font-lock-keywords. + +2007-06-22 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-print-log): Insert the file name. + (vc-hg-log-view-mode): Fontify the file name. + +2007-06-22 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-format-date-part, calc-parse-standard-date) + (calcFunc-julian): Fix incorrect number used in calculations. + +2007-06-22 Thien-Thi Nguyen <ttn@gnuvola.org> + + * simple.el (next-error-recenter): New defcustom. + (next-error, next-error-internal): Recenter if specified, + immediately prior to running `next-error-hook'. + + * progmodes/hideshow.el (hs-show-block): Use line-end-position. + (hs-hide-block-at-point, hs-hide-comment-region): Likewise. + + * progmodes/hideshow.el (hs-hide-all): Use progress reporter. + +2007-06-22 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-comb.el (math-small-factorial-table): New variable. + (calcFunc-fact): Use `math-small-factorial-table'. + + * calc/calc-ext.el (math-defcache): Allow forms to evaluate + initial values. + (math-approx-pi, math-approx-sqrt-e, math-approx-gamma-const): + New variables to use in caches. + + * calc/calc-forms.el (math-format-date-part, math-parse-standard-date) + (calcFunc-julian): Use `math-read-number-simple' to insert bignums. + + * calc/calc-func.el (math-besJ0, math-besJ1, math-besY0, math-besY1) + (math-bernoulli-b-cache): Use math-read-number-simple to insert + bignums. + + * calc/calc-math.el (math-approx-ln-10, math-approx-ln-2): + New variables to use in caches. + +2007-06-22 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-bzr.el (vc-bzr-log-view-mode): Add + to the email address regexp. + + * vc-hg.el (vc-hg-log-view-mode): New mode. + +2007-06-21 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-read-number-simple): New function. + +2007-06-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * vera-mode.el (vera-mode): Fix `commend-end-skip' setting. + (vera-font-lock-match-item): Fix doc string. + (vera-in-comment-p): Remove unused function. + (vera-skip-forward-literal, vera-skip-backward-literal): Improve code, + use `syntax-ppss'. + (vera-forward-syntactic-ws): Fix argument order. + (vera-prepare-search): Use `with-syntax-table'. + (vera-indent-line): Fix doc string. + (vera-electric-tab): Fix doc string. + (vera-expand-abbrev): Define alias instead of using `fset'. + (vera-comment-uncomment-region): Use `comment-start-skip'. + +2007-06-21 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-export-with-footnotes): New option. + (org-export-as-html): Fix replacement bug for XEmacs. + (org-agenda-default-appointment-duration): New option. + +2007-06-21 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el: Add to do items. + (vc-hg-diff): Add support for comparing different revisions. + (vc-hg-diff, vc-hg-annotate-command, vc-hg-annotate-time) + (vc-hg-annotate-extract-revision-at-line) + (vc-hg-previous-version, vc-hg-checkin): New functions. + (vc-hg-annotate-re): New constant. + +2007-06-20 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (math-standard-ops): Fix precedence of multiplication. + +2007-06-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * log-view.el (log-view-font-lock-keywords): Use `eval' to consult the + buffer-local value of log-view-*-re if applicable. + + * vc-bzr.el (vc-bzr-dir-state): Use setq rather than set. + Use vc-bzr-command rather than the ill defined vc-bzr-command*. + (vc-bzr-command*): Remove both (incompatible) versions. + (vc-bzr-do-command*): Remove. + (vc-bzr-with-process-environment, vc-bzr-std-process-invocation): + Remove by folding into its only caller vc-bzr-command. + (vc-bzr-command): Always set the environment, even when ineffective. + (vc-bzr-version): Minor fix up. + (vc-bzr-admin-dirname): New var. + (vc-bzr-bzr-dir): Remove. + (vc-bzr-root-dir): New fun. + (vc-bzr-registered): Use it. Add an autoloaded version. + (vc-bzr-responsible-p): Use vc-bzr-root-dir as well. + (vc-bzr-view-log-function): Remove. + (vc-bzr-log-view-mode): New major mode to replace it. + (vc-bzr-print-log): Only activate the old hack if needed. + + * vc.el (vc-default-log-view-mode): New function. + (vc-print-log): Add new `log-view-mode' VC operation. + +2007-06-20 Juanma Barranquero <lekktu@gmail.com> + + * ido.el (ido-find-file-in-dir): Don't signal an error for + empty directories. + + * add-log.el (change-log-mode): Set `show-trailing-whitespace'. + + * desktop.el (desktop-read): Run `desktop-not-loaded-hook' in the + directory where the desktop file was found, as the docstring says. + (desktop-kill): Use `read-directory-name'. + +2007-06-20 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-mode.el (c-remove-any-local-eval-or-mode-variables): + When removing lines, also remove the \n. Correction of patch of + 2007-04-21. + +2007-06-20 Martin Rudalics <rudalics@gmx.at> + + * mouse.el (mouse-drag-mode-line-1): Quit mouse tracking when + event is not a cons cell. Do not unread drag-mouse-1 events. + Select right window in check whether space was stolen from + window above. + + * help-mode.el (help-make-xrefs): Adjust position of new forward + button. + +2007-06-20 Riccardo Murri <riccardo.murri@gmail.com> + + * vc-bzr.el (vc-bzr-with-process-environment) + (vc-bzr-std-process-invocation): New macros. + (vc-bzr-command, vc-bzr-command*): Use them. + (vc-bzr-with-c-locale): Remove. + (vc-bzr-dir-state): Replace its use with vc-bzr-command. + (vc-bzr-buffer-nonblank-p): New function. + (vc-bzr-state-words): New const. + (vc-bzr-state): Look for `bzr status` keywords in output. + Display everything else as a warning message to the user. + Fix status report with bzr >= 0.15. + +2007-06-20 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-global-switches): Simplify. + (vc-hg-state): Handle more states. + (vc-hg-diff): Fix doc-string. + (vc-hg-register): New function. + (vc-hg-checkout): Likewise. + +2007-06-20 Reto Zimmermann <reto@gnu.org> + + * progmodes/vera-mode.el: New file. + +2007-06-19 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-multiplication-has-precendence): + New variable. + (math-standard-ops, math-standard-ops-p, math-expr-ops): + New functions. + (math-expr-opers): Define using math-standard-ops rather than + math-standard-opers. + * calc/calc-aent.el (calc-do-calc-eval): Let math-expr-opers + equal the function math-standard-ops rather than the variable + math-standard-opers. + (calc-algebraic-entry): Let math-expr-opers equal + math-standard-ops or math-expr-ops, as appropriate. + (math-expr-read-level, math-read-factor): Let math-expr-opers + equal math-expr-ops. + * calc/calc-embed.el (calc-embedded-finish-edit): + Let math-expr-opers equal the function math-standard-ops + rather than the variable math-standard-opers. + * calc/calc-ext.el (math-read-plain-expr) + (math-format-flat-expr-fancy): Let math-expr-opers equal the + function math-standard-ops rather than the variable + math-standard-opers. + * calc/calc-lang.el (calc-set-language, math-read-big-rec): + Let math-expr-opers equal the function math-standard-ops rather + than the variable math-standard-opers. + * calc/calc-prog.el (calc-read-parse-table): Let math-expr-opers + equal the function math-standard-ops rather than the variable + math-standard-opers. + * calc/calc-yank.el (calc-finish-stack-edit): Let math-expr-opers + equal the function math-standard-ops rather than the variable + math-standard-opers. + * calc/calccomp.el (math-compose-expr): Let math-expr-opers equal + math-expr-ops. + +2007-06-19 Ivan Kanis <apple@kanis.eu> + + * vc-hg.el: New file. + +2007-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-font-lock-paren): Mark the relevant text + with font-lock-multiline. + +2007-06-17 Glenn Morris <rgm@gnu.org> + + * lpr.el (lpr-page-header-switches): Move %s to separate element + for correct quoting. Doc fix. + +2007-06-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/sgml-mode.el (sgml-xml-guess): Return the result rather + than setting sgml-xml-mode. + (sgml-mode, html-mode): Set sgml-xml-mode. + (sgml-skip-tag-backward): Tell if we skipped over matched tags. + (sgml-skip-tag-backward, sgml-electric-tag-pair-overlays): New var. + (sgml-electric-tag-pair-before-change-function) + (sgml-electric-tag-pair-flush-overlays): New functions. + (sgml-electric-tag-pair-mode): New minor mode. + (sgml-font-lock-keywords-2, sgml-get-context, sgml-unclosed-tag-p) + (sgml-calculate-indent): Use assoc-string. + 2007-06-16 Karl Fogel <kfogel@red-bean.com> * thingatpt.el (thing-at-point-email-regexp): Don't require two @@ -51,16 +804,15 @@ 2007-06-15 Masatake YAMATO <jet@gyve.org> - * vc-bzr.el (vc-bzr-root): Cache the output of shell command - execution. + * vc-bzr.el (vc-bzr-root): Cache the output of shell command execution. * vc.el (vc-dired-hook): Check the backend returned from `vc-responsible-backend' can really handle `subdir'. 2007-06-15 Chong Yidong <cyd@stupidchicken.com> - * wid-edit.el (widget-add-documentation-string-button): Fix - handling of documentation indent. + * wid-edit.el (widget-add-documentation-string-button): + Fix handling of documentation indent. 2007-06-15 Miles Bader <miles@fencepost.gnu.org> @@ -84,8 +836,8 @@ (custom-variable-value-create, custom-face-value-create) (custom-visibility): New widget. (custom-visibility): New face. - (custom-group-value-create): Call - widget-add-documentation-string-button, using `custom-visibility'. + (custom-group-value-create): + Call widget-add-documentation-string-button, using `custom-visibility'. 2007-06-14 Stefan Monnier <monnier@iro.umontreal.ca> @@ -97,8 +849,8 @@ 2007-06-14 Michael Kifer <kifer@cs.stonybrook.edu> * viper.el (viper-describe-key-ad, viper-describe-key-briefly-ad): - different advices for Emacs and XEmacs. Compile them conditionally. - (viper-version): belated version change. + Different advices for Emacs and XEmacs. Compile them conditionally. + (viper-version): Belated version change. 2007-06-14 Juanma Barranquero <lekktu@gmail.com> @@ -193,6 +945,11 @@ * vc-arch.el (vc-arch-command): Remove bzr. It's a different program. +2007-06-13 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff-ptch.el (ediff-context-diff-label-regexp): Partially undo + previous change. + 2007-06-12 Tom Tromey <tromey@redhat.com> * subr.el (user-emacs-directory): New defconst. @@ -297,7 +1054,7 @@ (desktop-kill): Tell `desktop-save' that this is the last save. Release the lock afterwards. (desktop-buffer-info): New function. - (desktop-save): Use it. Run `desktop-save-hook' where the doc + (desktop-save): Use it. Run `desktop-save-hook' where the doc says to. Detect conflicts, and manage the lock. (desktop-read): Detect conflicts. Manage the lock. @@ -307,7 +1064,7 @@ * emulation/tpu-edt.el (tpu-gold-map): Rename from GOLD-map. (tpu-lucid-emacs-p): Remove. Use (featurep 'xemacs) instead. - (CSI-map, GOLD-CSI-map, GOLD-SS3-map, SS3-map): Delete vars. + (CSI-map, GOLD-CSI-map, GOLD-SS3-map, SS3-map): Delete vars. (tpu-gold-map, tpu-global-map): Add all the SS3 and CSI bindings, using keysyms rather than byte sequences. (tpu-copy-keyfile): Don't force the user to use tpu-mapper.el. @@ -506,9 +1263,9 @@ (org-table-use-standard-references, org-disputed-keys) (org-export-skip-text-before-1st-heading, org-agenda-with-colors) (org-agenda-export-html-style): New option. - (org-allow-auto-repeat, org-agenda-remove-tags-when-in-prefix) + (org-allow-auto-repeat, org-agenda-remove-tags-when-in-prefix) (org-CUA-compatible): Option removed. - (org-agenda-structure, org-sexp-date): New face. + (org-agenda-structure, org-sexp-date): New face. (org-todo-keywords-for-agenda, org-not-done-keywords) (org-planning-or-clock-line-re, org-agenda-name) (org-table-colgroup-info, org-todo-sets) @@ -524,7 +1281,7 @@ (org-repeat-re, org-todo-kwd-max-priority) (org-version, org-done-string) (org-table-clean-did-remove-column-1, org-disputed-keys): - Remove Variables. + Remove variables. (org-table-translate-regexp, org-repeat-re, org-version): New consts. (org-ts-lengths): Constant removed. (org-follow-gnus-link): Don't ask how many articles to read. @@ -681,7 +1438,7 @@ 2007-05-25 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/derived.el (define-derived-mode): Remove bogus - compatibiity code. + compatibility code. * emacs-lisp/copyright.el (copyright-names-regexp): New var. (copyright-update-year): Use it. diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index a5b9de08daa..957d9a51bb4 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -2595,7 +2595,7 @@ path. Rewrite function in `cond' style for readability. Suggested by: Stephen Eglen <S.J.Eglen{_AT_}damtp.cam.ac.uk>. - (The path shortening, that is, not the rearrarangement.) + (The path shortening, that is, not the rearrangement.) 2007-01-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> @@ -6360,7 +6360,7 @@ * help.el (describe-key-briefly): When reading a down-event on mode lines or scroll bar, swallow the following up event, too. - Use the new mouse sensitity of `key-binding' for lookup. + Use the new mouse sensitivity of `key-binding' for lookup. (describe-key): The same here. 2006-09-15 Juanma Barranquero <lekktu@gmail.com> @@ -7911,11 +7911,11 @@ * tumme.el (tumme-display-thumbnail-original-image): Make sure image display buffer is displayed before call to - `tumme-display-image. + `tumme-display-image'. (tumme-dired-display-image): Make sure image display buffer is - displayed before call to `tumme-display-image. + displayed before call to `tumme-display-image'. (tumme-mouse-display-image): Make sure image display buffer is - displayed before call to `tumme-display-image. + displayed before call to `tumme-display-image'. (tumme-widget-list): Add. (tumme-dired-edit-comment-and-tags): Add. (tumme-save-information-from-widgets): Add. @@ -8042,7 +8042,7 @@ instead of retired `allout-resumptions'. For hook functions, use `local' parameter so hook settings are created and removed as buffer-local settings. Revise (resumptions) setting - auto-fill-function so it is set only if already active. (The + auto-fill-function so it is set only if already active. The related fill-function settings are all made in either case, so that activating auto-fill-mode activity will have the custom allout-mode behaviors (hanging indent on topics, if configured for it). @@ -9788,7 +9788,7 @@ * calendar/cal-menu.el (calendar-mode-map, calendar-mouse-3-map): * calendar/calendar.el (calendar-mode-map): - * calendar/diary-lib.el (include-other-diary-files,diary-mail-entries): + * calendar/diary-lib.el (include-other-diary-files, diary-mail-entries): * calendar/appt.el (appt-check, appt-make-list): Refer to diary-view-entries, diary-list-entries, diary-show-all-entries rather than obsolete aliases. @@ -9998,7 +9998,7 @@ 2006-05-09 Masatake YAMATO <jet@gyve.org> - * font-lock.el (cpp-font-lock-keywords-source-directives): Addded + * font-lock.el (cpp-font-lock-keywords-source-directives): Added "warning" and "import". (cpp-font-lock-keywords): Added "warning". @@ -10865,7 +10865,7 @@ (org-table-create-or-convert-from-region): New commands (org-table-toggle-vline-visibility): Command removed. (org-table-convert-region): Made a command. - (orgtbl-deleta-backward-char,orgtbl-delete-char): Remove commands. + (orgtbl-deleta-backward-char, orgtbl-delete-char): Remove commands. Replace with the normal org- functions. (org-self-insert-command): Don't trigger realign unnecessarily when blanking a field that is not full. @@ -11275,7 +11275,7 @@ (ibuffer-mode-header-map): New keymaps. (ibuffer-update-title-and-summary): Enable mouse face highlighting and keybindings for column headers. - (name,size,mode) <define-ibuffer-column>: Add a header-mouse-map + (name, size, mode) <define-ibuffer-column>: Add a header-mouse-map property. 2006-04-02 Drew Adams <drew.adams@oracle.com> (tiny change) @@ -20649,7 +20649,7 @@ (ibuffer-do-print, ibuffer-filter-by-mode, ibuffer-filter-by-used-mode) (ibuffer-filter-by-name, ibuffer-filter-by-filename) (ibuffer-filter-by-size-gt, ibuffer-filter-by-size-lt) - (ibuffer-filter-by-content, ibuffer-filter-by-predicate + (ibuffer-filter-by-content, ibuffer-filter-by-predicate) (ibuffer-do-sort-by-major-mode, ibuffer-do-sort-by-mode-name) (ibuffer-do-sort-by-alphabetic, ibuffer-do-sort-by-size): Autoload file sans suffix. @@ -20758,7 +20758,7 @@ (gdb-info-frames-custom): Put `font-lock-function-name-face' and `font-lock-variable-name-face' (gdb-registers-font-lock-keywords): New font lock keywords definition. - (gdb-registers-mode): Use `gdb-registers-font-lock-keywords`. + (gdb-registers-mode): Use `gdb-registers-font-lock-keywords'. (gdb-memory-font-lock-keywords): New font lock keywords definition. (gdb-memory-mode): Use `gdb-memory-font-lock-keywords'. (gdb-local-font-lock-keywords): New font lock keywords definition. @@ -22168,7 +22168,7 @@ 2005-08-30 Richard M. Stallman <rms@gnu.org> * files.el (risky-local-variable-p): - Match `-predicates' and `-commands. + Match `-predicates' and `-commands'. * cus-edit.el (custom-buffer-sort-alphabetically): Default to t. (custom-save-all): Visit the file if necessary; @@ -23161,7 +23161,7 @@ (tramp-handle-set-visited-file-modtime) (tramp-handle-insert-file-contents) (tramp-handle-write-region): No special handling for - `last-coding-system-used, because this is done in + `last-coding-system-used', because this is done in `tramp-accept-process-output' now. (tramp-accept-process-output): New defun. (tramp-process-one-action, tramp-process-one-multi-action) @@ -23199,7 +23199,7 @@ * net/tramp-smb.el: Remove defvar of `last-coding-system-used' in the XEmacs case; not necessary anymore. (tramp-smb-handle-write-region): No special handling for - `last-coding-system-used, because this is done in + `last-coding-system-used', because this is done in `tramp-accept-process-output' now. (tramp-smb-wait-for-output): Call `tramp-accept-process-output'. @@ -24608,7 +24608,7 @@ (tree-widget-theme, tree-widget-image-properties-emacs) (tree-widget-image-properties-xemacs, tree-widget-create-image) (tree-widget-image-formats, tree-widget-control) - (tree-widget-empty-control, tree-widget-leaf-control + (tree-widget-empty-control, tree-widget-leaf-control) (tree-widget-guide, tree-widget-end-guide, tree-widget-no-guide) (tree-widget-handle, tree-widget-no-handle, tree-widget-p) (tree-widget-keep, tree-widget-after-toggle-functions) @@ -25816,8 +25816,7 @@ (ebrowse-draw-member-buffer-class-line, ebrowse-draw-member-long-fn) (ebrowse-draw-member-short-fn): Use renamed ebrowse faces. - * progmodes/antlr-mode.el (antlr-default, antlr-keyword, - antlr-syntax) + * progmodes/antlr-mode.el (antlr-default, antlr-keyword, antlr-syntax) (antlr-ruledef, antlr-tokendef, antlr-ruleref, antlr-tokenref) (antlr-literal): Remove "-face" suffix and "font-lock-" from face names. @@ -27755,7 +27754,7 @@ * progmodes/make-mode.el (makefile-add-this-line-targets): Simplify and integrate into `makefile-pickup-targets'. (makefile-add-this-line-macro): Simplify and integrate into - `makefile-pickup-macros. + `makefile-pickup-macros'. (makefile-pickup-filenames-as-targets): Simplify. (makefile-previous-dependency, makefile-match-dependency): Don't stumble over `::'. @@ -32740,7 +32739,7 @@ Adrian Aichner <adrian@xemacs.org>. * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add entry for - `substitute-in-file-name. + `substitute-in-file-name'. (tramp-smb-handle-substitute-in-file-name): New defun. (tramp-smb-advice-PC-do-completion): Delete advice. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 5ad3542c7ad..704978d6e82 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -241,7 +241,7 @@ MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \ $(lisp)/mh-e/mh-xface.el mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el -$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) +$(lisp)/mh-e/mh-loaddefs.el: $(lisp)/subdirs.el $(MH_E_SRC) echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@ echo "" >> $@ echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc." >> $@ @@ -277,6 +277,9 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) # an up-to-date copy of loaddefs.el that is uncorrupted by # local changes. (Because loaddefs.el is an automatically generated # file, we don't want to store it in the source repository). +# +# The chmod +w is to handle env var CVSREAD=1. Files named +# are identified by being the value of `generated-autoload-file'. bootstrap-prepare: if test -x $(EMACS); then \ @@ -284,6 +287,9 @@ bootstrap-prepare: else \ cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \ fi + chmod +w $(lisp)/loaddefs.el \ + $(lisp)/ps-print.el \ + $(lisp)/emacs-lisp/cl-loaddefs.el maintainer-clean: distclean cd $(lisp); rm -f *.elc */*.elc $(AUTOGENEL) diff --git a/lisp/add-log.el b/lisp/add-log.el index 08ce78d371d..3ec00b81b35 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -695,7 +695,8 @@ Runs `change-log-mode-hook'. (setq left-margin 8 fill-column 74 indent-tabs-mode t - tab-width 8) + tab-width 8 + show-trailing-whitespace t) (set (make-local-variable 'fill-paragraph-function) 'change-log-fill-paragraph) (set (make-local-variable 'indent-line-function) 'change-log-indent) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 170ca4b88c2..3831d7c1c05 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -447,20 +447,21 @@ This is an internal function used by Auto-Revert Mode." (defun auto-revert-tail-handler () (let ((size (nth 7 (file-attributes buffer-file-name))) (modified (buffer-modified-p)) - buffer-read-only ; ignore + (inhibit-read-only t) ; Ignore. (file buffer-file-name) - buffer-file-name) ; ignore that file has changed + (buffer-file-name nil)) ; Ignore that file has changed. (when (> size auto-revert-tail-pos) + (run-hooks 'before-revert-hook) (undo-boundary) (save-restriction (widen) (save-excursion (goto-char (point-max)) (insert-file-contents file nil auto-revert-tail-pos size))) - (run-mode-hooks 'after-revert-hook) + (run-hooks 'after-revert-hook) (undo-boundary) (setq auto-revert-tail-pos size) - (set-buffer-modified-p modified))) + (restore-buffer-modified-p modified))) (set-visited-file-modtime)) (defun auto-revert-buffers () @@ -534,5 +535,5 @@ the timer when no buffers need to be checked." (run-hooks 'auto-revert-load-hook) -;;; arch-tag: f6bcb07b-4841-477e-9e44-b18678e58876 +;; arch-tag: f6bcb07b-4841-477e-9e44-b18678e58876 ;;; autorevert.el ends here diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 4b954fabd0c..be77030c914 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -100,7 +100,7 @@ (cond ((and (consp str) (not (symbolp (car str)))) (let ((calc-language nil) - (math-expr-opers math-standard-opers) + (math-expr-opers (math-standard-ops)) (calc-internal-prec 12) (calc-word-size 32) (calc-symbolic-mode nil) @@ -254,7 +254,7 @@ The value t means abort and give an error message.") (interactive "P") (calc-wrapper (let ((calc-language (if prefix nil calc-language)) - (math-expr-opers (if prefix math-standard-opers math-expr-opers))) + (math-expr-opers (if prefix (math-standard-ops) (math-expr-ops)))) (calc-alg-entry (and auto (char-to-string last-command-char)))))) (defvar calc-alg-entry-history nil @@ -876,7 +876,10 @@ in Calc algebraic input.") calcFunc-eq calcFunc-neq)) (defun math-read-expr-level (exp-prec &optional exp-term) - (let* ((x (math-read-factor)) (first t) op op2) + (let* ((math-expr-opers (math-expr-ops)) + (x (math-read-factor)) + (first t) + op op2) (while (and (or (and calc-user-parse-table (setq op (calc-check-user-syntax x exp-prec)) (setq x op @@ -1121,7 +1124,8 @@ in Calc algebraic input.") (assoc math-expr-data '(("(") ("[") ("{")))))) (defun math-read-factor () - (let (op) + (let ((math-expr-opers (math-expr-ops)) + op) (cond ((eq math-exp-token 'number) (let ((num (math-read-number math-expr-data))) (if (not num) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index 3963700a599..2dde6216a06 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -32,6 +32,17 @@ (require 'calc-ext) (require 'calc-macs) +;;; Some useful numbers +(defconst math-bignum-logb-digit-size + (eval-when-compile (logb math-bignum-digit-size)) + "The logb of the size of a bignum digit. +This is the largest value of B such that 2^B is less than +the size of a Calc bignum digit.") + +(defconst math-bignum-digit-power-of-two + (eval-when-compile (expt 2 (logb math-bignum-digit-size))) + "The largest power of 2 less than the size of a Calc bignum digit.") + ;;; b-prefix binary commands. (defun calc-and (n) @@ -297,11 +308,11 @@ (defun math-and-bignum (a b) ; [l l l] (and a b - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-and-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logand (cdr qa) (cdr qb)))))) (defun calcFunc-or (a b &optional w) ; [I I I] [Public] @@ -324,11 +335,11 @@ (defun math-or-bignum (a b) ; [l l l] (and (or a b) - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-or-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logior (cdr qa) (cdr qb)))))) (defun calcFunc-xor (a b &optional w) ; [I I I] [Public] @@ -351,11 +362,11 @@ (defun math-xor-bignum (a b) ; [l l l] (and (or a b) - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-xor-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logxor (cdr qa) (cdr qb)))))) (defun calcFunc-diff (a b &optional w) ; [I I I] [Public] @@ -378,11 +389,11 @@ (defun math-diff-bignum (a b) ; [l l l] (and a - (let ((qa (math-div-bignum-digit a 512)) - (qb (math-div-bignum-digit b 512))) + (let ((qa (math-div-bignum-digit a math-bignum-digit-power-of-two)) + (qb (math-div-bignum-digit b math-bignum-digit-power-of-two))) (math-mul-bignum-digit (math-diff-bignum (math-norm-bignum (car qa)) (math-norm-bignum (car qb))) - 512 + math-bignum-digit-power-of-two (logand (cdr qa) (lognot (cdr qb))))))) (defun calcFunc-not (a &optional w) ; [I I] [Public] @@ -402,14 +413,15 @@ w)))))) (defun math-not-bignum (a w) ; [l l] - (let ((q (math-div-bignum-digit a 512))) - (if (<= w 9) + (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) + (if (<= w math-bignum-logb-digit-size) (list (logand (lognot (cdr q)) (1- (lsh 1 w)))) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) - (- w 9)) - 512 - (logxor (cdr q) 511))))) + (- w math-bignum-logb-digit-size)) + math-bignum-digit-power-of-two + (logxor (cdr q) + (1- math-bignum-digit-power-of-two)))))) (defun calcFunc-lsh (a &optional n w) ; [I I] [Public] (setq a (math-trunc a) @@ -510,8 +522,8 @@ (math-sub a (math-power-of-2 (- w))))) ((Math-negp a) (math-normalize (cons 'bigpos (math-binary-arg a w)))) - ((and (integerp a) (< a 1000000)) - (if (>= w 20) + ((and (integerp a) (< a math-small-integer-size)) + (if (> w (logb math-small-integer-size)) a (logand a (1- (lsh 1 w))))) (t @@ -523,13 +535,13 @@ (defalias 'calcFunc-clip 'math-clip) (defun math-clip-bignum (a w) ; [l l] - (let ((q (math-div-bignum-digit a 512))) - (if (<= w 9) + (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) + (if (<= w math-bignum-logb-digit-size) (list (logand (cdr q) (1- (lsh 1 w)))) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) - (- w 9)) - 512 + (- w math-bignum-logb-digit-size)) + math-bignum-digit-power-of-two (cdr q))))) (defvar math-max-digits-cache nil) diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 6c30177a0b0..c933ecd7e00 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -294,6 +294,19 @@ ;;; Factorial and related functions. +(defconst math-small-factorial-table + (eval-when-compile + (vector 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 + (math-read-number-simple "479001600") + (math-read-number-simple "6227020800") + (math-read-number-simple "87178291200") + (math-read-number-simple "1307674368000") + (math-read-number-simple "20922789888000") + (math-read-number-simple "355687428096000") + (math-read-number-simple "6402373705728000") + (math-read-number-simple "121645100408832000") + (math-read-number-simple "2432902008176640000")))) + (defun calcFunc-fact (n) ; [I I] [F F] [Public] (let (temp) (cond ((Math-integer-negp n) @@ -302,14 +315,7 @@ (math-reject-arg n 'range))) ((integerp n) (if (<= n 20) - (aref '[1 1 2 6 24 120 720 5040 40320 362880 - (bigpos 800 628 3) (bigpos 800 916 39) - (bigpos 600 1 479) (bigpos 800 20 227 6) - (bigpos 200 291 178 87) (bigpos 0 368 674 307 1) - (bigpos 0 888 789 922 20) (bigpos 0 96 428 687 355) - (bigpos 0 728 705 373 402 6) - (bigpos 0 832 408 100 645 121) - (bigpos 0 640 176 8 902 432 2)] n) + (aref math-small-factorial-table n) (math-factorial-iter (1- n) 2 1))) ((and (math-messy-integerp n) (Math-lessp n 100)) @@ -551,9 +557,9 @@ nil (if (Math-integerp var-RandSeed) (let* ((seed (math-sub 161803 var-RandSeed)) - (mj (1+ (math-mod seed '(bigpos 0 0 1)))) - (mk (1+ (math-mod (math-quotient seed '(bigpos 0 0 1)) - '(bigpos 0 0 1)))) + (mj (1+ (math-mod seed 1000000))) + (mk (1+ (math-mod (math-quotient seed 1000000) + 1000000))) (i 0)) (setq math-random-table (cons 'vec (make-list 55 mj))) (while (<= (setq i (1+ i)) 54) @@ -601,7 +607,8 @@ ;;; Avoid various pitfalls that may lurk in the built-in (random) function! ;;; Shuffling algorithm from Numerical Recipes, section 7.1. (defvar math-random-last) -(defun math-random-digit () +(defun math-random-three-digit-number () + "Return a random three digit number." (let (i) (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) (math-init-random-base)) @@ -621,17 +628,17 @@ ;;; Produce an N-digit random integer. (defun math-random-digits (n) - (cond ((<= n 6) - (math-scale-right (+ (* (math-random-digit) 1000) (math-random-digit)) - (- 6 n))) - (t (let* ((slop (% (- 900003 n) 3)) - (i (/ (+ n slop) 3)) - (digs nil)) - (while (> i 0) - (setq digs (cons (math-random-digit) digs) - i (1- i))) - (math-normalize (math-scale-right (cons 'bigpos digs) - slop)))))) + "Produce a random N digit integer." + (let* ((slop (% (- 3 (% n 3)) 3)) + (i (/ (+ n slop) 3)) + (rnum 0)) + (while (> i 0) + (setq rnum + (math-add + (math-random-three-digit-number) + (math-mul rnum 1000))) + (setq i (1- i))) + (math-normalize (math-scale-right rnum slop)))) ;;; Produce a uniformly-distributed random float 0 <= N < 1. (defun math-random-float () @@ -802,7 +809,7 @@ (error "Argument must be an integer")) ((Math-integer-negp n) '(nil)) - ((Math-natnum-lessp n '(bigpos 0 0 8)) + ((Math-natnum-lessp n 8000000) (setq n (math-fixnum n)) (let ((i -1) v) (while (and (> (% n (setq v (aref math-primes-table @@ -815,15 +822,17 @@ ((not (equal n (car math-prime-test-cache))) (cond ((= (% (nth 1 n) 2) 0) '(nil 2)) ((= (% (nth 1 n) 5) 0) '(nil 5)) - (t (let ((dig (cdr n)) (sum 0)) - (while dig - (if (cdr dig) - (setq sum (% (+ (+ sum (car dig)) - (* (nth 1 dig) 1000)) - 111111) - dig (cdr (cdr dig))) - (setq sum (% (+ sum (car dig)) 111111) - dig nil))) + (t (let ((q n) (sum 0)) + (while (not (eq q 0)) + (setq sum (% + (+ + sum + (calcFunc-mod + q 1000000)) + 111111)) + (setq q + (math-quotient + q 1000000))) (cond ((= (% sum 3) 0) '(nil 3)) ((= (% sum 7) 0) '(nil 7)) ((= (% sum 11) 0) '(nil 11)) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index a064905943f..f31c19e3390 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -403,7 +403,7 @@ (let ((val (save-excursion (set-buffer (aref info 1)) (let ((calc-language nil) - (math-expr-opers math-standard-opers)) + (math-expr-opers (math-standard-ops))) (math-read-expr str))))) (if (eq (car-safe val) 'error) (progn diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index ca89928d46e..65383df308c 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1878,8 +1878,19 @@ calc-kill calc-kill-region calc-yank)))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) (list 'progn - (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'defvar cache-val (list 'quote init)) +; (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) + (list 'defvar cache-prec + `(cond + ((consp ,init) (math-numdigs (nth 1 ,init))) + (,init + (nth 1 (math-numdigs (eval ,init)))) + (t + -100))) + (list 'defvar cache-val + `(cond + ((consp ,init) ,init) + (,init (eval ,init)) + (t ,init))) (list 'defvar last-prec -100) (list 'defvar last-val nil) (list 'setq 'math-cache-list @@ -1914,7 +1925,12 @@ calc-kill calc-kill-region calc-yank)))) (put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] -(math-defcache math-pi (float (bigpos 463 238 793 589 653 592 141 3) -21) +(defconst math-approx-pi + (eval-when-compile + (math-read-number-simple "3.141592653589793238463")) + "An approximation for pi.") + +(math-defcache math-pi math-approx-pi (math-add-float (math-mul-float '(float 16 0) (math-arctan-raw '(float 2 -1))) (math-mul-float '(float -4 0) @@ -1945,7 +1961,11 @@ calc-kill calc-kill-region calc-yank)))) (math-defcache math-sqrt-two-pi nil (math-sqrt-float (math-two-pi))) -(math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21) +(defconst math-approx-sqrt-e + (eval-when-compile (math-read-number-simple "1.648721270700128146849")) + "An approximation for sqrt(3).") + +(math-defcache math-sqrt-e math-approx-sqrt-e (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1)))) (math-defcache math-e nil @@ -1955,10 +1975,14 @@ calc-kill calc-kill-region calc-yank)))) (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0)) '(float 5 -1))) -(math-defcache math-gamma-const nil - '(float (bigpos 495 467 917 632 470 369 709 646 776 267 677 848 348 672 - 057 988 235 399 359 593 421 310 024 824 900 120 065 606 - 328 015 649 156 772 5) -100)) +(defconst math-approx-gamma-const + (eval-when-compile + (math-read-number-simple + "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495")) + "An approximation for gamma.") + +(math-defcache math-gamma-const nil + math-approx-gamma-const) (defun math-half-circle (symb) (if (eq calc-angle-mode 'rad) @@ -2202,7 +2226,7 @@ calc-kill calc-kill-region calc-yank)))) (defun math-fixnum-big (a) (if (cdr a) - (+ (car a) (* (math-fixnum-big (cdr a)) 1000)) + (+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size)) (car a))) (defvar math-simplify-only nil) @@ -2960,7 +2984,7 @@ calc-kill calc-kill-region calc-yank)))) (defun math-read-plain-expr (exp-str &optional error-check) (let* ((calc-language nil) - (math-expr-opers math-standard-opers) + (math-expr-opers (math-standard-ops)) (val (math-read-expr exp-str))) (and error-check (eq (car-safe val) 'error) @@ -3116,7 +3140,7 @@ calc-kill calc-kill-region calc-yank)))) (concat (substring (symbol-name (car a)) 9) "(" (math-vector-to-string (nth 1 a) t) ")")) (t - (let ((op (math-assq2 (car a) math-standard-opers))) + (let ((op (math-assq2 (car a) (math-standard-ops)))) (cond ((and op (= (length a) 3)) (if (> prec (min (nth 2 op) (nth 3 op))) (concat "(" (math-format-flat-expr a 0) ")") diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 10bbf7dc3dd..5f319800999 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -544,6 +544,14 @@ (setcdr math-fd-dt nil)) fmt)))) +(defconst math-julian-date-beginning '(float 17214235 -1) + "The beginning of the Julian calendar, +as measured in the number of days before January 1 of the year 1AD.") + +(defconst math-julian-date-beginning-int 1721424 + "The beginning of the Julian calendar, +as measured in the integer number of days before January 1 of the year 1AD.") + (defun math-format-date-part (x) (cond ((stringp x) x) @@ -558,9 +566,12 @@ ((eq x 'n) (math-format-number (math-floor math-fd-date))) ((eq x 'J) - (math-format-number (math-add math-fd-date '(float (bigpos 235 214 17) -1)))) + (math-format-number + (math-add math-fd-date math-julian-date-beginning))) ((eq x 'j) - (math-format-number (math-add (math-floor math-fd-date) '(bigpos 424 721 1)))) + (math-format-number (math-add + (math-floor math-fd-date) + math-julian-date-beginning-int))) ((eq x 'U) (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) ((progn @@ -935,9 +946,8 @@ 0 (if (or (eq this 'j) (math-integerp num)) - '(bigpos 424 721 1) - '(float (bigpos 235 214 17) - -1)))) + math-julian-date-beginning-int + math-julian-date-beginning))) hour (or (nth 3 num) hour) minute (or (nth 4 num) minute) second (or (nth 5 num) second) @@ -1146,14 +1156,14 @@ (defun calcFunc-julian (date &optional zone) (if (math-realp date) (list 'date (if (math-integerp date) - (math-sub date '(bigpos 424 721 1)) - (setq date (math-sub date '(float (bigpos 235 214 17) -1))) + (math-sub date math-julian-date-beginning-int) + (setq date (math-sub date math-julian-date-beginning)) (math-sub date (math-div (calcFunc-tzone zone date) '(float 864 2))))) (if (eq (car date) 'date) (math-add (nth 1 date) (if (math-integerp (nth 1 date)) - '(bigpos 424 721 1) - (math-add '(float (bigpos 235 214 17) -1) + math-julian-date-beginning-int + (math-add math-julian-date-beginning (math-div (calcFunc-tzone zone date) '(float 864 2))))) (math-reject-arg date 'datep)))) diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 479116b0c76..78d0df34cdb 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -147,7 +147,8 @@ (or (math-numberp x) (math-reject-arg x 'numberp)) (calcFunc-fact (math-add x -1))) -(defun math-gammap1-raw (x &optional fprec nfprec) ; compute gamma(1 + x) +(defun math-gammap1-raw (x &optional fprec nfprec) + "Compute gamma(1+X) to the appropriate precision." (or fprec (setq fprec (math-float calc-internal-prec) nfprec (math-float (- calc-internal-prec)))) @@ -567,42 +568,54 @@ ((Math-lessp '(float 8 0) (math-abs-approx x)) (let* ((z (math-div '(float 8 0) x)) (y (math-sqr z)) - (xx (math-add x '(float (bigneg 164 398 785) -9))) + (xx (math-add x + (eval-when-compile + (math-read-number-simple "-0.785398164")))) (a1 (math-poly-eval y - '((float (bigpos 211 887 093 2) -16) - (float (bigneg 639 370 073 2) -15) - (float (bigpos 407 510 734 2) -14) - (float (bigneg 627 628 098 1) -12) - (float 1 0)))) + (eval-when-compile + (list + (math-read-number-simple "0.0000002093887211") + (math-read-number-simple "-0.000002073370639") + (math-read-number-simple "0.00002734510407") + (math-read-number-simple "-0.001098628627") + '(float 1 0))))) (a2 (math-poly-eval y - '((float (bigneg 152 935 934) -16) - (float (bigpos 161 095 621 7) -16) - (float (bigneg 651 147 911 6) -15) - (float (bigpos 765 488 430 1) -13) - (float (bigneg 995 499 562 1) -11)))) + (eval-when-compile + (list + (math-read-number-simple "-0.0000000934935152") + (math-read-number-simple "0.0000007621095161") + (math-read-number-simple "-0.000006911147651") + (math-read-number-simple "0.0001430488765") + (math-read-number-simple "-0.01562499995"))))) (sc (math-sin-cos-raw xx))) (if yflag (setq sc (cons (math-neg (cdr sc)) (car sc)))) (math-mul (math-sqrt - (math-div '(float (bigpos 722 619 636) -9) x)) + (math-div (eval-when-compile + (math-read-number-simple "0.636619722")) + x)) (math-sub (math-mul (cdr sc) a1) (math-mul (car sc) (math-mul z a2)))))) (t (let ((y (math-sqr x))) (math-div (math-poly-eval y - '((float (bigneg 456 052 849 1) -7) - (float (bigpos 017 233 739 7) -5) - (float (bigneg 418 442 121 1) -2) - (float (bigpos 407 196 516 6) -1) - (float (bigneg 354 590 362 13) 0) - (float (bigpos 574 490 568 57) 0))) + (eval-when-compile + (list + (math-read-number-simple "-184.9052456") + (math-read-number-simple "77392.33017") + (math-read-number-simple "-11214424.18") + (math-read-number-simple "651619640.7") + (math-read-number-simple "-13362590354.0") + (math-read-number-simple "57568490574.0")))) (math-poly-eval y - '((float 1 0) - (float (bigpos 712 532 678 2) -7) - (float (bigpos 853 264 927 5) -5) - (float (bigpos 718 680 494 9) -3) - (float (bigpos 985 532 029 1) 0) - (float (bigpos 411 490 568 57) 0)))))))) + (eval-when-compile + (list + '(float 1 0) + (math-read-number-simple "267.8532712") + (math-read-number-simple "59272.64853") + (math-read-number-simple "9494680.718") + (math-read-number-simple "1029532985.0") + (math-read-number-simple "57568490411.0"))))))))) (defun math-besJ1 (x &optional yflag) (cond ((and (math-negp (calcFunc-re x)) (not yflag)) @@ -610,25 +623,33 @@ ((Math-lessp '(float 8 0) (math-abs-approx x)) (let* ((z (math-div '(float 8 0) x)) (y (math-sqr z)) - (xx (math-add x '(float (bigneg 491 194 356 2) -9))) + (xx (math-add x (eval-when-compile + (math-read-number-simple "-2.356194491")))) (a1 (math-poly-eval y - '((float (bigneg 019 337 240) -15) - (float (bigpos 174 520 457 2) -15) - (float (bigneg 496 396 516 3) -14) - (float 183105 -8) - (float 1 0)))) + (eval-when-compile + (list + (math-read-number-simple "-0.000000240337019") + (math-read-number-simple "0.000002457520174") + (math-read-number-simple "-0.00003516396496") + '(float 183105 -8) + '(float 1 0))))) (a2 (math-poly-eval y - '((float (bigpos 412 787 105) -15) - (float (bigneg 987 228 88) -14) - (float (bigpos 096 199 449 8) -15) - (float (bigneg 873 690 002 2) -13) - (float (bigpos 995 499 687 4) -11)))) + (eval-when-compile + (list + (math-read-number-simple "0.000000105787412") + (math-read-number-simple "-0.00000088228987") + (math-read-number-simple "0.000008449199096") + (math-read-number-simple "-0.0002002690873") + (math-read-number-simple "0.04687499995"))))) (sc (math-sin-cos-raw xx))) (if yflag (setq sc (cons (math-neg (cdr sc)) (car sc))) (if (math-negp x) (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc)))))) - (math-mul (math-sqrt (math-div '(float (bigpos 722 619 636) -9) x)) + (math-mul (math-sqrt (math-div + (eval-when-compile + (math-read-number-simple "0.636619722")) + x)) (math-sub (math-mul (cdr sc) a1) (math-mul (car sc) (math-mul z a2)))))) (t @@ -636,20 +657,23 @@ (math-mul x (math-div (math-poly-eval y - '((float (bigneg 606 036 016 3) -8) - (float (bigpos 826 044 157) -4) - (float (bigneg 439 611 972 2) -3) - (float (bigpos 531 968 423 2) -1) - (float (bigneg 235 059 895 7) 0) - (float (bigpos 232 614 362 72) 0))) + (eval-when-compile + (list + (math-read-number-simple "-30.16036606") + (math-read-number-simple "15704.4826") + (math-read-number-simple "-2972611.439") + (math-read-number-simple "242396853.1") + (math-read-number-simple "-7895059235.0") + (math-read-number-simple "72362614232.0")))) (math-poly-eval y - '((float 1 0) - (float (bigpos 397 991 769 3) -7) - (float (bigpos 394 743 944 9) -5) - (float (bigpos 474 330 858 1) -2) - (float (bigpos 178 535 300 2) 0) - (float (bigpos 442 228 725 144) - 0))))))))) + (eval-when-compile + (list + '(float 1 0) + (math-read-number-simple "376.9991397") + (math-read-number-simple "99447.43394") + (math-read-number-simple "18583304.74") + (math-read-number-simple "2300535178.0") + (math-read-number-simple "144725228442.0")))))))))) (defun calcFunc-besY (v x) (math-inexact-result) @@ -690,20 +714,25 @@ (let ((y (math-sqr x))) (math-add (math-div (math-poly-eval y - '((float (bigpos 733 622 284 2) -7) - (float (bigneg 757 792 632 8) -5) - (float (bigpos 129 988 087 1) -2) - (float (bigneg 036 598 123 5) -1) - (float (bigpos 065 834 062 7) 0) - (float (bigneg 389 821 957 2) 0))) + (eval-when-compile + (list + (math-read-number-simple "228.4622733") + (math-read-number-simple "-86327.92757") + (math-read-number-simple "10879881.29") + (math-read-number-simple "-512359803.6") + (math-read-number-simple "7062834065.0") + (math-read-number-simple "-2957821389.0")))) (math-poly-eval y - '((float 1 0) - (float (bigpos 244 030 261 2) -7) - (float (bigpos 647 472 474) -4) - (float (bigpos 438 466 189 7) -3) - (float (bigpos 648 499 452 7) -1) - (float (bigpos 269 544 076 40) 0)))) - (math-mul '(float (bigpos 772 619 636) -9) + (eval-when-compile + (list + '(float 1 0) + (math-read-number-simple "226.1030244") + (math-read-number-simple "47447.2647") + (math-read-number-simple "7189466.438") + (math-read-number-simple "745249964.8") + (math-read-number-simple "40076544269.0"))))) + (math-mul (eval-when-compile + (math-read-number-simple "0.636619772")) (math-mul (math-besJ0 x) (math-ln-raw x)))))) ((math-negp (calcFunc-re x)) (math-add (math-besJ0 (math-neg x) t) @@ -719,22 +748,26 @@ (math-mul x (math-div (math-poly-eval y - '((float (bigpos 935 937 511 8) -6) - (float (bigneg 726 922 237 4) -3) - (float (bigpos 551 264 349 7) -1) - (float (bigneg 139 438 153 5) 1) - (float (bigpos 439 527 127) 4) - (float (bigneg 943 604 900 4) 3))) + (eval-when-compile + (list + (math-read-number-simple "8511.937935") + (math-read-number-simple "-4237922.726") + (math-read-number-simple "734926455.1") + (math-read-number-simple "-51534381390.0") + (math-read-number-simple "1275274390000.0") + (math-read-number-simple "-4900604943000.0")))) (math-poly-eval y - '((float 1 0) - (float (bigpos 885 632 549 3) -7) - (float (bigpos 605 042 102) -3) - (float (bigpos 002 904 245 2) -2) - (float (bigpos 367 650 733 3) 0) - (float (bigpos 664 419 244 4) 2) - (float (bigpos 057 958 249) 5))))) - (math-mul '(float (bigpos 772 619 636) -9) - (math-sub (math-mul (math-besJ1 x) (math-ln-raw x)) + (eval-when-compile + (list + '(float 1 0) + (math-read-number-simple "354.9632885") + (math-read-number-simple "102042.605") + (math-read-number-simple "22459040.02") + (math-read-number-simple "3733650367.0") + (math-read-number-simple "424441966400.0") + (math-read-number-simple "24995805700000.0")))))) + (math-mul (eval-when-compile (math-read-number-simple "0.636619772")) + (math-sub (math-mul (math-besJ1 x) (math-ln-raw x)) (math-div 1 x)))))) ((math-negp (calcFunc-re x)) (math-neg @@ -799,16 +832,40 @@ (calcFunc-euler n '(float 5 -1))) (calcFunc-euler n '(frac 1 2)))))) -(defvar math-bernoulli-b-cache '((frac -174611 - (bigpos 0 200 291 698 662 857 802)) - (frac 43867 (bigpos 0 944 170 217 94 109 5)) - (frac -3617 (bigpos 0 880 842 622 670 10)) - (frac 1 (bigpos 600 249 724 74)) - (frac -691 (bigpos 0 368 674 307 1)) - (frac 1 (bigpos 160 900 47)) - (frac -1 (bigpos 600 209 1)) - (frac 1 30240) (frac -1 720) - (frac 1 12) 1 )) +(defvar math-bernoulli-b-cache + (eval-when-compile + (list + (list 'frac + -174611 + (math-read-number-simple "802857662698291200000")) + (list 'frac + 43867 + (math-read-number-simple "5109094217170944000")) + (list 'frac + -3617 + (math-read-number-simple "10670622842880000")) + (list 'frac + 1 + (math-read-number-simple "74724249600")) + (list 'frac + -691 + (math-read-number-simple "1307674368000")) + (list 'frac + 1 + (math-read-number-simple "47900160")) + (list 'frac + -1 + (math-read-number-simple "1209600")) + (list 'frac + 1 + 30240) + (list 'frac + -1 + 720) + (list 'frac + 1 + 12) + 1 ))) (defvar math-bernoulli-B-cache '((frac -174611 330) (frac 43867 798) (frac -3617 510) (frac 7 6) (frac -691 2730) diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 79c33b473c3..c009dbe18aa 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -35,7 +35,7 @@ ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) - (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers) + (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops)) math-expr-function-mapping (get lang 'math-function-table) math-expr-special-function-mapping (get lang 'math-special-function-table) math-expr-variable-mapping (get lang 'math-variable-table) @@ -1225,7 +1225,7 @@ h (1+ v) (1+ h) math-rb-v2) (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h) (assoc (math-match-substring line 0) - math-standard-opers))) + (math-standard-ops)))) (and (>= (nth 2 widest) prec) (setq h (match-end 0))) (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index b6481d30b73..d8de812421f 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -310,15 +310,15 @@ (let* ((top (nthcdr (- len 2) a))) (math-isqrt-bignum-iter a - (math-scale-bignum-3 + (math-scale-bignum-digit-size (math-bignum-big (1+ (math-isqrt-small - (+ (* (nth 1 top) 1000) (car top))))) + (+ (* (nth 1 top) math-bignum-digit-size) (car top))))) (1- (/ len 2))))) (let* ((top (nth (1- len) a))) (math-isqrt-bignum-iter a - (math-scale-bignum-3 + (math-scale-bignum-digit-size (list (1+ (math-isqrt-small top))) (/ len 2))))))) @@ -341,14 +341,15 @@ (while (eq (car (setq a (cdr a))) 0)) (null a)))) -(defun math-scale-bignum-3 (a n) ; [L L S] +(defun math-scale-bignum-digit-size (a n) ; [L L S] (while (> n 0) (setq a (cons 0 a) n (1- n))) a) (defun math-isqrt-small (a) ; A > 0. [S S] - (let ((g (cond ((>= a 10000) 1000) + (let ((g (cond ((>= a 1000000) 10000) + ((>= a 10000) 1000) ((>= a 100) 100) (t 10))) g2) @@ -1717,10 +1718,20 @@ sum (math-lnp1-series nextsum (1+ n) nextx x)))) -(math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21) +(defconst math-approx-ln-10 + (eval-when-compile + (math-read-number-simple "2.302585092994045684018")) + "An approximation for ln(10).") + +(math-defcache math-ln-10 math-approx-ln-10 (math-ln-raw-2 '(float 1 1))) -(math-defcache math-ln-2 (float (bigpos 417 309 945 559 180 147 693) -21) +(defconst math-approx-ln-2 + (eval-when-compile + (math-read-number-simple "0.693147180559945309417")) + "An approximation for ln(2).") + +(math-defcache math-ln-2 math-approx-ln-2 (math-ln-raw-3 (math-float '(frac 1 3)))) diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index e9674ff938b..ecc304a5f5f 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -579,7 +579,7 @@ loaded and the keystroke automatically re-typed." (defun math-div2-bignum (a) ; [l l] (if (cdr a) - (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) 500)) + (cons (+ (/ (car a) 2) (* (% (nth 1 a) 2) (/ math-bignum-digit-size 2))) (math-div2-bignum (cdr a))) (list (/ (car a) 2)))) diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 0bcf78af861..23000888749 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -982,10 +982,16 @@ (defun math-padded-polynomial (expr var deg) + "Return a polynomial as list of coefficients. +If EXPR is of the form \"a + bx + cx^2 + ...\" in the variable VAR, return +the list (a b c ...) with at least DEG elements, else return NIL." (let ((p (math-is-polynomial expr var deg))) (append p (make-list (- deg (length p)) 0)))) (defun math-partial-fractions (r den var) + "Return R divided by DEN expressed in partial fractions of VAR. +All whole factors of DEN have already been split off from R. +If no partial fraction representation can be found, return nil." (let* ((fden (calcFunc-factors den var)) (tdeg (math-polynomial-p den var)) (fp fden) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 4dff6f04013..cacad666772 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -568,7 +568,7 @@ (set-buffer calc-buf) (let ((calc-user-parse-tables nil) (calc-language nil) - (math-expr-opers math-standard-opers) + (math-expr-opers (math-standard-ops)) (calc-hashes-used 0)) (math-read-expr (if (string-match ",[ \t]*\\'" str) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index abd78e5f926..a872f69d83f 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -559,7 +559,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (aset str pos ?\,))) (switch-to-buffer calc-original-buffer) (let ((vals (let ((calc-language nil) - (math-expr-opers math-standard-opers)) + (math-expr-opers (math-standard-ops))) (and (string-match "[^\n\t ]" str) (math-read-exprs str))))) (when (eq (car-safe vals) 'error) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4ca5662afdc..6a235e42321 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -401,6 +401,13 @@ This is not required to be present for user-written mode annotations." :group 'calc :type '(choice (string) (sexp))) +(defcustom calc-multiplication-has-precedence + t + "*If non-nil, multiplication has precedence over division +in normal mode." + :group 'calc + :type 'boolean) + (defvar calc-bug-address "jay.p.belanger@gmail.com" "Address of the maintainer of Calc, for use by `report-calc-bug'.") @@ -2276,7 +2283,21 @@ See calc-keypad for details." +(defconst math-bignum-digit-length 4 +; (truncate (/ (log10 (/ most-positive-fixnum 2)) 2)) + "The length of a \"digit\" in Calc bignums. +If a big integer is of the form (bigpos N0 N1 ...), this is the +length of the allowable Emacs integers N0, N1,... +The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the +largest Emacs integer.") + +(defconst math-bignum-digit-size + (expt 10 math-bignum-digit-length) + "An upper bound for the size of the \"digit\"s in Calc bignums.") +(defconst math-small-integer-size + (expt math-bignum-digit-size 2) + "An upper bound for the size of \"small integer\"s in Calc.") ;;;; Arithmetic routines. @@ -2285,11 +2306,17 @@ See calc-keypad for details." ;;; following forms: ;;; ;;; integer An integer. For normalized numbers, this format -;;; is used only for -999999 ... 999999. +;;; is used only for +;;; negative math-small-integer-size + 1 to +;;; math-small-integer-size - 1 ;;; -;;; (bigpos N0 N1 N2 ...) A big positive integer, N0 + N1*1000 + N2*10^6 ... -;;; (bigneg N0 N1 N2 ...) A big negative integer, - N0 - N1*1000 ... -;;; Each digit N is in the range 0 ... 999. +;;; (bigpos N0 N1 N2 ...) A big positive integer, +;;; N0 + N1*math-bignum-digit-size +;;; + N2*(math-bignum-digit-size)^2 ... +;;; (bigneg N0 N1 N2 ...) A big negative integer, +;;; - N0 - N1*math-bignum-digit-size ... +;;; Each digit N is in the range +;;; 0 ... math-bignum-digit-size -1. ;;; Normalized, always at least three N present, ;;; and the most significant N is nonzero. ;;; @@ -2379,7 +2406,8 @@ See calc-keypad for details." (cond ((not (consp math-normalize-a)) (if (integerp math-normalize-a) - (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000)) + (if (or (>= math-normalize-a math-small-integer-size) + (<= math-normalize-a (- math-small-integer-size))) (math-bignum math-normalize-a) math-normalize-a) math-normalize-a)) @@ -2394,7 +2422,8 @@ See calc-keypad for details." math-normalize-a (cond ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) 1000))) + (* (nth 2 math-normalize-a) + math-bignum-digit-size))) ((cdr math-normalize-a) (nth 1 math-normalize-a)) (t 0)))) ((eq (car math-normalize-a) 'bigneg) @@ -2408,7 +2437,8 @@ See calc-keypad for details." math-normalize-a (cond ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) 1000)))) + (* (nth 2 math-normalize-a) + math-bignum-digit-size)))) ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) (t 0)))) ((eq (car math-normalize-a) 'float) @@ -2528,7 +2558,8 @@ See calc-keypad for details." (defun math-bignum-big (a) ; [L s] (if (= a 0) nil - (cons (% a 1000) (math-bignum-big (/ a 1000))))) + (cons (% a math-bignum-digit-size) + (math-bignum-big (/ a math-bignum-digit-size))))) ;;; Build a normalized floating-point number. [F I S] @@ -2545,7 +2576,7 @@ See calc-keypad for details." (progn (while (= (car digs) 0) (setq digs (cdr digs) - exp (+ exp 3))) + exp (+ exp math-bignum-digit-length))) (while (= (% (car digs) 10) 0) (setq digs (math-div10-bignum digs) exp (1+ exp))) @@ -2563,7 +2594,8 @@ See calc-keypad for details." (defun math-div10-bignum (a) ; [l l] (if (cdr a) - (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100)) + (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) + (expt 10 (1- math-bignum-digit-length)))) (math-div10-bignum (cdr a))) (list (/ (car a) 10)))) @@ -2594,7 +2626,7 @@ See calc-keypad for details." (if (cdr a) (let* ((len (1- (length a))) (top (nth len a))) - (+ (* len 3) (cond ((>= top 100) 0) ((>= top 10) -1) (t -2)))) + (+ (* (1- len) math-bignum-digit-length) (math-numdigs top))) 0) (cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3)) ((>= a 10) 2) @@ -2615,24 +2647,24 @@ See calc-keypad for details." a (if (consp a) (cons (car a) (math-scale-left-bignum (cdr a) n)) - (if (>= n 3) - (if (or (>= a 1000) (<= a -1000)) + (if (>= n math-bignum-digit-length) + (if (or (>= a math-bignum-digit-size) + (<= a (- math-bignum-digit-size))) (math-scale-left (math-bignum a) n) - (math-scale-left (* a 1000) (- n 3))) - (if (= n 2) - (if (or (>= a 10000) (<= a -10000)) - (math-scale-left (math-bignum a) 2) - (* a 100)) - (if (or (>= a 100000) (<= a -100000)) - (math-scale-left (math-bignum a) 1) - (* a 10))))))) + (math-scale-left (* a math-bignum-digit-size) + (- n math-bignum-digit-length))) + (let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n)))) + (if (or (>= a sz) (<= a (- sz))) + (math-scale-left (math-bignum a) n) + (* a (expt 10 n)))))))) (defun math-scale-left-bignum (a n) - (if (>= n 3) + (if (>= n math-bignum-digit-length) (while (>= (setq a (cons 0 a) - n (- n 3)) 3))) + n (- n math-bignum-digit-length)) + math-bignum-digit-length))) (if (> n 0) - (math-mul-bignum-digit a (if (= n 2) 100 10) 0) + (math-mul-bignum-digit a (expt 10 n) 0) a)) (defun math-scale-right (a n) ; [i i S] @@ -2644,21 +2676,20 @@ See calc-keypad for details." (if (= a 0) 0 (- (math-scale-right (- a) n))) - (if (>= n 3) - (while (and (> (setq a (/ a 1000)) 0) - (>= (setq n (- n 3)) 3)))) - (if (= n 2) - (/ a 100) - (if (= n 1) - (/ a 10) - a)))))) + (if (>= n math-bignum-digit-length) + (while (and (> (setq a (/ a math-bignum-digit-size)) 0) + (>= (setq n (- n math-bignum-digit-length)) + math-bignum-digit-length)))) + (if (> n 0) + (/ a (expt 10 n)) + a))))) (defun math-scale-right-bignum (a n) ; [L L S; l l S] - (if (>= n 3) - (setq a (nthcdr (/ n 3) a) - n (% n 3))) + (if (>= n math-bignum-digit-length) + (setq a (nthcdr (/ n math-bignum-digit-length) a) + n (% n math-bignum-digit-length))) (if (> n 0) - (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0)) + (cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n)) 0)) a)) ;;; Multiply (with rounding) the integer A by 10^N. [I i S] @@ -2668,16 +2699,18 @@ See calc-keypad for details." ((consp a) (math-normalize (cons (car a) - (let ((val (if (< n -3) - (math-scale-right-bignum (cdr a) (- -3 n)) - (if (= n -2) - (math-mul-bignum-digit (cdr a) 10 0) - (if (= n -1) - (math-mul-bignum-digit (cdr a) 100 0) - (cdr a)))))) ; n = -3 - (if (and val (>= (car val) 500)) + (let ((val (if (< n (- math-bignum-digit-length)) + (math-scale-right-bignum + (cdr a) + (- (- math-bignum-digit-length) n)) + (if (< n 0) + (math-mul-bignum-digit + (cdr a) + (expt 10 (+ math-bignum-digit-length n)) 0) + (cdr a))))) ; n = -math-bignum-digit-length + (if (and val (>= (car val) (/ math-bignum-digit-size 2))) (if (cdr val) - (if (eq (car (cdr val)) 999) + (if (eq (car (cdr val)) (1- math-bignum-digit-size)) (math-add-bignum (cdr val) '(1)) (cons (1+ (car (cdr val))) (cdr (cdr val)))) '(1)) @@ -2696,7 +2729,7 @@ See calc-keypad for details." (and (not (or (consp a) (consp b))) (progn (setq a (+ a b)) - (if (or (<= a -1000000) (>= a 1000000)) + (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size)) (math-bignum a) a))) (and (Math-zerop a) (not (eq (car-safe a) 'mod)) @@ -2745,21 +2778,22 @@ See calc-keypad for details." (let* ((a (copy-sequence a)) (aa a) (carry nil) sum) (while (and aa b) (if carry - (if (< (setq sum (+ (car aa) (car b))) 999) + (if (< (setq sum (+ (car aa) (car b))) + (1- math-bignum-digit-size)) (progn (setcar aa (1+ sum)) (setq carry nil)) - (setcar aa (+ sum -999))) - (if (< (setq sum (+ (car aa) (car b))) 1000) + (setcar aa (- sum (1- math-bignum-digit-size)))) + (if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size) (setcar aa sum) - (setcar aa (+ sum -1000)) + (setcar aa (- sum math-bignum-digit-size)) (setq carry t))) (setq aa (cdr aa) b (cdr b))) (if carry (if b (nconc a (math-add-bignum b '(1))) - (while (eq (car aa) 999) + (while (eq (car aa) (1- math-bignum-digit-size)) (setcar aa 0) (setq aa (cdr aa))) (if aa @@ -2783,17 +2817,17 @@ See calc-keypad for details." (progn (setcar aa (1- diff)) (setq borrow nil)) - (setcar aa (+ diff 999))) + (setcar aa (+ diff (1- math-bignum-digit-size)))) (if (>= (setq diff (- (car aa) (car b))) 0) (setcar aa diff) - (setcar aa (+ diff 1000)) + (setcar aa (+ diff math-bignum-digit-size)) (setq borrow t))) (setq aa (cdr aa) b (cdr b))) (if borrow (progn (while (eq (car aa) 0) - (setcar aa 999) + (setcar aa (1- math-bignum-digit-size)) (setq aa (cdr aa))) (if aa (progn @@ -2833,7 +2867,7 @@ See calc-keypad for details." (if (or (consp a) (consp b)) (math-add a (math-neg b)) (setq a (- a b)) - (if (or (<= a -1000000) (>= a 1000000)) + (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size)) (math-bignum a) a))) @@ -2860,7 +2894,8 @@ See calc-keypad for details." (defun math-mul (a b) (or (and (not (consp a)) (not (consp b)) - (< a 1000) (> a -1000) (< b 1000) (> b -1000) + (< a math-bignum-digit-size) (> a (- math-bignum-digit-size)) + (< b math-bignum-digit-size) (> b (- math-bignum-digit-size)) (* a b)) (and (Math-zerop a) (not (eq (car-safe b) 'mod)) (if (Math-scalarp b) @@ -2929,14 +2964,14 @@ See calc-keypad for details." aa a) (while (progn (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d)) - c)) 1000)) + c)) math-bignum-digit-size)) (setq aa (cdr aa))) - (setq c (/ prod 1000) + (setq c (/ prod math-bignum-digit-size) ss (or (cdr ss) (setcdr ss (list 0))))) - (if (>= prod 1000) + (if (>= prod math-bignum-digit-size) (if (cdr ss) - (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss)))) - (setcdr ss (list (/ prod 1000)))))) + (setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car (cdr ss)))) + (setcdr ss (list (/ prod math-bignum-digit-size)))))) sum))) ;;; Multiply digit list A by digit D. [L L D D; l l D D] @@ -2946,12 +2981,14 @@ See calc-keypad for details." (and (= d 1) a) (let* ((a (copy-sequence a)) (aa a) prod) (while (progn - (setcar aa (% (setq prod (+ (* (car aa) d) c)) 1000)) + (setcar aa + (% (setq prod (+ (* (car aa) d) c)) + math-bignum-digit-size)) (cdr aa)) (setq aa (cdr aa) - c (/ prod 1000))) - (if (>= prod 1000) - (setcdr aa (list (/ prod 1000)))) + c (/ prod math-bignum-digit-size))) + (if (>= prod math-bignum-digit-size) + (setcdr aa (list (/ prod math-bignum-digit-size)))) a)) (and (> c 0) (list c)))) @@ -2964,7 +3001,7 @@ See calc-keypad for details." (if (eq b 0) (math-reject-arg a "*Division by zero")) (if (or (consp a) (consp b)) - (if (and (natnump b) (< b 1000)) + (if (and (natnump b) (< b math-bignum-digit-size)) (let ((res (math-div-bignum-digit (cdr a) b))) (cons (math-normalize (cons (car a) (car res))) @@ -2983,7 +3020,7 @@ See calc-keypad for details." (if (= b 0) (math-reject-arg a "*Division by zero") (/ a b)) - (if (and (natnump b) (< b 1000)) + (if (and (natnump b) (< b math-bignum-digit-size)) (if (= b 0) (math-reject-arg a "*Division by zero") (math-normalize (cons (car a) @@ -2992,7 +3029,7 @@ See calc-keypad for details." (or (consp b) (setq b (math-bignum b))) (let* ((alen (1- (length a))) (blen (1- (length b))) - (d (/ 1000 (1+ (nth (1- blen) (cdr b))))) + (d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b))))) (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0) (math-mul-bignum-digit (cdr b) d 0) alen blen))) @@ -3006,7 +3043,7 @@ See calc-keypad for details." (if (cdr b) (let* ((alen (length a)) (blen (length b)) - (d (/ 1000 (1+ (nth (1- blen) b)))) + (d (/ math-bignum-digit-size (1+ (nth (1- blen) b)))) (res (math-div-bignum-big (math-mul-bignum-digit a d 0) (math-mul-bignum-digit b d 0) alen blen))) @@ -3021,7 +3058,7 @@ See calc-keypad for details." (defun math-div-bignum-digit (a b) (if a (let* ((res (math-div-bignum-digit (cdr a) b)) - (num (+ (* (cdr res) 1000) (car a)))) + (num (+ (* (cdr res) math-bignum-digit-size) (car a)))) (cons (cons (/ num b) (car res)) (% num b))) @@ -3037,10 +3074,11 @@ See calc-keypad for details." (cons (car res2) (car res)) (cdr res2))))) -(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L] - (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0))) +(defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l l L] + (let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size) + (or (nth (1- blen) a) 0))) (den (nth (1- blen) b)) - (guess (min (/ num den) 999))) + (guess (min (/ num den) (1- math-bignum-digit-size)))) (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))) (defun math-div-bignum-try (a b c guess) ; [D.l l l D] @@ -3351,15 +3389,22 @@ See calc-keypad for details." (if a (let ((s "")) (while (cdr (cdr a)) - (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s) + (setq s (concat + (format + (concat "%0" + (number-to-string (* 2 math-bignum-digit-length)) + "d") + (+ (* (nth 1 a) math-bignum-digit-size) (car a))) s) a (cdr (cdr a)))) - (concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s)) + (concat (int-to-string + (+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s)) "0")) ;;; Parse a simple number in string form. [N X] [Public] (defun math-read-number (s) + "Convert the string S into a Calc number." (math-normalize (cond @@ -3370,7 +3415,7 @@ See calc-keypad for details." (> (length digs) 1) (eq (aref digs 0) ?0)) (math-read-number (concat "8#" digs)) - (if (<= (length digs) 6) + (if (<= (length digs) (* 2 math-bignum-digit-length)) (string-to-number digs) (cons 'bigpos (math-read-bignum digs)))))) @@ -3416,15 +3461,42 @@ See calc-keypad for details." ;; Syntax error! (t nil)))) +;;; Parse a very simple number, keeping all digits. +(defun math-read-number-simple (s) + "Convert the string S into a Calc number. +S is assumed to be a simple number (integer or float without an exponent) +and all digits are kept, regardless of Calc's current precision." + (cond + ;; Integer + ((string-match "^[0-9]+$" s) + (if (string-match "^\\(0+\\)" s) + (setq s (substring s (match-end 0)))) + (if (<= (length s) (* 2 math-bignum-digit-length)) + (string-to-number s) + (cons 'bigpos (math-read-bignum s)))) + ;; Minus sign + ((string-match "^-[0-9]+$" s) + (if (<= (length s) (1+ (* 2 math-bignum-digit-length))) + (string-to-number s) + (cons 'bigneg (math-read-bignum (substring s 1))))) + ;; Decimal point + ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s) + (let ((int (math-match-substring s 1)) + (frac (math-match-substring s 2))) + (list 'float (math-read-number-simple (concat int frac)) + (- (length frac))))) + ;; Syntax error! + (t nil))) + (defun math-match-substring (s n) (if (match-beginning n) (substring s (match-beginning n) (match-end n)) "")) (defun math-read-bignum (s) ; [l X] - (if (> (length s) 3) - (cons (string-to-number (substring s -3)) - (math-read-bignum (substring s 0 -3))) + (if (> (length s) math-bignum-digit-length) + (cons (string-to-number (substring s (- math-bignum-digit-length))) + (math-read-bignum (substring s 0 (- math-bignum-digit-length)))) (list (string-to-number s)))) @@ -3467,8 +3539,6 @@ See calc-keypad for details." ( "!" calcFunc-fact 210 -1 ) ( "^" ^ 201 200 ) ( "**" ^ 201 200 ) - ( "*" * 196 195 ) - ( "2x" * 196 195 ) ( "/" / 190 191 ) ( "%" % 190 191 ) ( "\\" calcFunc-idiv 190 191 ) @@ -3492,7 +3562,31 @@ See calc-keypad for details." ( "::" calcFunc-condition 45 46 ) ( "=>" calcFunc-evalto 40 41 ) ( "=>" calcFunc-evalto 40 -1 ))) -(defvar math-expr-opers math-standard-opers) + +(defun math-standard-ops () + (if calc-multiplication-has-precedence + (cons + '( "*" * 196 195 ) + (cons + '( "2x" * 196 195 ) + math-standard-opers)) + (cons + '( "*" * 190 191 ) + (cons + '( "2x" * 190 191 ) + math-standard-opers)))) + +(defvar math-expr-opers (math-standard-ops)) + +(defun math-standard-ops-p () + (let ((meo (caar math-expr-opers))) + (and (stringp meo) + (string= meo "*")))) + +(defun math-expr-ops () + (if (math-standard-ops-p) + (math-standard-ops) + math-expr-opers)) ;;;###autoload (defun calc-grab-region (top bot arg) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 7b385261735..3b52edecaec 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -83,6 +83,7 @@ (defun math-compose-expr (a prec) (let ((math-compose-level (1+ math-compose-level)) + (math-expr-opers (math-expr-ops)) spfn) (cond ((or (and (eq a math-comp-selected) a) diff --git a/lisp/calculator.el b/lisp/calculator.el index 53a3c96d948..b0e3069d3e1 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -278,7 +278,7 @@ Examples: ("IC" acos (D (acos X)) x 6) ("IT" atan (D (atan X)) x 6) ("Q" sqrt sqrt x 7) - ("^" ^ expt 2 7) + ("^" ^ calculator-expt 2 7) ("!" ! calculator-fact x 7) (";" 1/ (/ 1 X) 1 7) ("_" - - 1 8) @@ -596,7 +596,8 @@ specified, then it is fixed, otherwise it depends on this variable). `+' and `-' can be used as either binary operators or prefix unary operators. Numbers can be entered with exponential notation using `e', except when using a non-decimal radix mode for input (in this case `e' -will be the hexadecimal digit). +will be the hexadecimal digit). If the result of a calculation is too +large (out of range for Emacs), the value of \"inf\" is returned. Here are the editing keys: * `RET' `=' evaluate the current expression @@ -1779,13 +1780,57 @@ To use this, apply a binary operator (evaluate it), then call this." (car calculator-last-opXY) (nth 1 calculator-last-opXY) x)) x)) +(defun calculator-integer-p (x) + "Non-nil if X is equal to an integer." + (condition-case nil + (= x (ftruncate x)) + (error nil))) + +(defun calculator-expt (x y) + "Compute X^Y, dealing with errors appropriately." + (condition-case + nil + (expt x y) + (domain-error 0.0e+NaN) + (range-error + (cond + ((and (< x 1.0) (> x -1.0)) + ;; For small x, the range error comes from large y. + 0.0) + ((and (> x 0.0) (< y 0.0)) + ;; For large positive x and negative y, the range error + ;; comes from large negative y. + 0.0) + ((and (> x 0.0) (> y 0.0)) + ;; For large positive x and positive y, the range error + ;; comes from large y. + 1.0e+INF) + ;; For the rest, x must be large and negative. + ;; The range errors come from large integer y. + ((< y 0.0) + 0.0) + ((oddp (truncate y)) + ;; If y is odd + -1.0e+INF) + (t + ;; + 1.0e+INF))) + (error 0.0e+NaN))) + (defun calculator-fact (x) "Simple factorial of X." - (let ((r (if (<= x 10) 1 1.0))) - (while (> x 0) - (setq r (* r (truncate x))) - (setq x (1- x))) - (+ 0.0 r))) + (if (and (>= x 0) + (calculator-integer-p x)) + (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF) + 1.0e+INF + (let ((r (if (<= x 10) 1 1.0))) + (while (> x 0) + (setq r (* r (truncate x))) + (setq x (1- x))) + (+ 0.0 r))) + (if (= x 1.0e+INF) + x + 0.0e+NaN))) (defun calculator-truncate (n) "Truncate N, return 0 in case of overflow." diff --git a/lisp/complete.el b/lisp/complete.el index 7d9bd989089..b90553b1816 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -222,13 +222,6 @@ second TAB brings up the `*Completions*' buffer." (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) ((not PC-disable-includes) (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) - ;; ... with some underhand redefining. - (cond ((not partial-completion-mode) - (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file) - (ad-activate 'read-file-name-internal)) - ((not PC-disable-includes) - (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file) - (ad-activate 'read-file-name-internal))) ;; Adjust the completion selection in *Completion* buffers to the way ;; we work. The default minibuffer completion code only completes the ;; text before point and leaves the text after point alone (new in @@ -335,14 +328,24 @@ See `PC-complete' for details." (PC-do-complete-and-exit))) (defun PC-do-complete-and-exit () - (if (= (point-max) (minibuffer-prompt-end)) ; Duplicate the "bug" that Info-menu relies on... - (exit-minibuffer) + (cond + ((= (point-max) (minibuffer-prompt-end)) + ;; Duplicate the "bug" that Info-menu relies on... + (exit-minibuffer)) + ((eq minibuffer-completion-confirm 'confirm-only) + (if (or (eq last-command this-command) + (test-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate)) + (exit-minibuffer) + (PC-temp-minibuffer-message " [Confirm]"))) + (t (let ((flag (PC-do-completion 'exit))) (and flag (if (or (eq flag 'complete) (not minibuffer-completion-confirm)) (exit-minibuffer) - (PC-temp-minibuffer-message " [Confirm]")))))) + (PC-temp-minibuffer-message " [Confirm]"))))))) (defun PC-completion-help () @@ -430,7 +433,9 @@ point-max (as is appropriate for completing a file name). If GOTO-END is non-nil, however, it instead replaces up to END." (or beg (setq beg (minibuffer-prompt-end))) (or end (setq end (point-max))) - (let* ((table minibuffer-completion-table) + (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) + 'PC-read-file-name-internal + minibuffer-completion-table)) (pred minibuffer-completion-predicate) (filename (funcall PC-completion-as-file-name-predicate)) (dirname nil) ; non-nil only if a filename is being completed @@ -523,11 +528,11 @@ GOTO-END is non-nil, however, it instead replaces up to END." (insert str) (setq end (+ beg (length str))))) (if origstr - ;; If the wildcards were introduced by us, it's possible - ;; that read-file-name-internal (especially our - ;; PC-include-file advice) can still find matches for the - ;; original string even if we couldn't, so remove the - ;; added wildcards. + ;; If the wildcards were introduced by us, it's + ;; possible that PC-read-file-name-internal can + ;; still find matches for the original string + ;; even if we couldn't, so remove the added + ;; wildcards. (setq str origstr) (setq filename nil table nil pred nil))))) @@ -912,7 +917,7 @@ or properties are considered." (point-min) t) (+ (point) 2) (point-min))) - (minibuffer-completion-table 'read-file-name-internal) + (minibuffer-completion-table 'PC-read-file-name-internal) (minibuffer-completion-predicate "") (PC-not-minibuffer t)) (goto-char end) @@ -1098,24 +1103,23 @@ absolute rather than relative to some directory on the SEARCH-PATH." (setq sorted (cdr sorted))) compressed)))) -(defadvice read-file-name-internal (around PC-include-file disable) - (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0)) - (let* ((string (ad-get-arg 0)) - (action (ad-get-arg 2)) - (name (match-string 1 string)) +(defun PC-read-file-name-internal (string dir action) + "Extend `read-file-name-internal' to handle include files. +This is only used by " + (if (string-match "<\\([^\"<>]*\\)>?\\'" string) + (let* ((name (match-string 1 string)) (str2 (substring string (match-beginning 0))) (completion-table (mapcar (lambda (x) (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) (PC-include-file-all-completions name (PC-include-file-path))))) - (setq ad-return-value (cond ((not completion-table) nil) ((eq action 'lambda) (test-completion str2 completion-table nil)) ((eq action nil) (PC-try-completion str2 completion-table nil)) - ((eq action t) (all-completions str2 completion-table nil))))) - ad-do-it)) + ((eq action t) (all-completions str2 completion-table nil)))) + (read-file-name-internal string dir action))) (provide 'complete) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 8ef655e3739..e003e4f4622 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -142,6 +142,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; eval.c (max-specpdl-size limits integer) (max-lisp-eval-depth limits integer) + (max-mini-window-height limits + (choice (const :tag "quarter screen" nil) + number)) (stack-trace-on-error debug (choice (const :tag "off") (repeat :menu-tag "When" diff --git a/lisp/desktop.el b/lisp/desktop.el index 98b0826084e..ca5ed9290b0 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -626,9 +626,7 @@ is nil, ask the user where to save the desktop." (setq desktop-dirname (file-name-as-directory (expand-file-name - (call-interactively - (lambda (dir) - (interactive "DDirectory for desktop file: ") dir)))))) + (read-directory-name "Directory for desktop file: " nil nil t))))) (condition-case err (desktop-save desktop-dirname t) (file-error @@ -965,9 +963,9 @@ It returns t if a desktop file was loaded, nil otherwise." (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ Using it may cause conflicts. Use it anyway? " owner))))) (progn - (setq desktop-dirname nil) (let ((default-directory desktop-dirname)) (run-hooks 'desktop-not-loaded-hook)) + (setq desktop-dirname nil) (message "Desktop file in use; not loaded.")) (desktop-lazy-abort) ;; Evaluate desktop buffer and remember when it was modified. diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 973e387f230..64199147c21 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -338,7 +338,7 @@ when editing big diffs)." ("^--- .+ ----$" . diff-hunk-header-face) ;context ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal ("^---$" . diff-hunk-header-face) ;normal - ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^ \t]+\\)\\(.*[^*-]\\)?\n" + ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+\\)\\(.*[^*-]\\)?\n" (0 diff-header-face) (2 diff-file-header-face prepend)) ("^\\([-<]\\)\\(.*\n\\)" (1 diff-indicator-removed-face) (2 diff-removed-face)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 4bad556e015..8661df033ed 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -582,18 +582,6 @@ can be produced by `dired-get-marked-files', for example." ;; Return nil for sake of nconc in dired-bunch-files. nil) -;; In Emacs 19 this will return program's exit status. -;; This is a separate function so that ange-ftp can redefine it. -(defun dired-call-process (program discard &rest arguments) -; "Run PROGRAM with output to current buffer unless DISCARD is t. -;Remaining arguments are strings passed as command arguments to PROGRAM." - ;; Look for a handler for default-directory in case it is a remote file name. - (let ((handler - (find-file-name-handler (directory-file-name default-directory) - 'dired-call-process))) - (if handler (apply handler 'dired-call-process - program discard arguments) - (apply 'call-process program nil (not discard) nil arguments)))) (defun dired-check-process (msg program &rest arguments) ; "Display MSG while running PROGRAM, and check for output. @@ -610,8 +598,7 @@ can be produced by `dired-get-marked-files', for example." (set-buffer err-buffer) (erase-buffer) (setq default-directory dir ; caller's default-directory - err (not (eq 0 - (apply (function dired-call-process) program nil arguments)))) + err (not (eq 0 (apply 'process-file program nil t nil arguments)))) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) @@ -1203,7 +1190,7 @@ Special value `always' suppresses confirmation." ;; It is a symlink (make-symbolic-link (car attrs) to ok-flag) (copy-file from to ok-flag dired-copy-preserve-time)) - (file-date-error + (file-date-error (push (dired-make-relative from) dired-create-files-failures) (dired-log "Can't set date on %s:\n%s\n" from err)))))) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 7fbcc87b8b1..93ba83bb729 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -41,15 +41,18 @@ A `.el' file can set this in its local variables section to make its autoloads go somewhere else. The autoload file is assumed to contain a trailer starting with a FormFeed character.") +(put 'generated-autoload-file 'safe-local-variable 'stringp) -(defconst generate-autoload-cookie ";;;###autoload" +;; This feels like it should be a defconst, but MH-E sets it to +;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el. +(defvar generate-autoload-cookie ";;;###autoload" "Magic comment indicating the following form should be autoloaded. Used by \\[update-file-autoloads]. This string should be meaningless to Lisp (e.g., a comment). This string is used: -;;;###autoload +\;;;###autoload \(defun function-to-be-autoloaded () ...) If this string appears alone on a line, the following form will be @@ -65,6 +68,8 @@ that text will be copied verbatim to `generated-autoload-file'.") (defconst generate-autoload-section-continuation ";;;;;; " "String to add on each continuation of the section header form.") +(defvar autoload-modified-buffers) ;Dynamically scoped var. + (defun make-autoload (form file) "Turn FORM into an autoload or defvar for source file FILE. Returns nil if FORM is not a special autoload form (i.e. a function definition @@ -149,16 +154,14 @@ or macro definition or a defcustom)." ;; the doc-string in FORM. ;; Those properties are now set in lisp-mode.el. +(defun autoload-generated-file () + (expand-file-name generated-autoload-file + ;; File-local settings of generated-autoload-file should + ;; be interpreted relative to the file's location, + ;; of course. + (if (not (local-variable-p 'generated-autoload-file)) + (expand-file-name "lisp" source-directory)))) -(defun autoload-trim-file-name (file) - ;; Returns a relative file path for FILE - ;; starting from the directory that loaddefs.el is in. - ;; That is normally a directory in load-path, - ;; which means Emacs will be able to find FILE when it looks. - ;; Any extra directory names here would prevent finding the file. - (setq file (expand-file-name file)) - (file-relative-name file - (file-name-directory generated-autoload-file))) (defun autoload-read-section-header () "Read a section header form. @@ -253,9 +256,7 @@ put the output in." "Insert the section-header line, which lists the file name and which functions are in it, etc." (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads load-name - (if (stringp file) (autoload-trim-file-name file) file) - time) + (prin1 (list 'autoloads autoloads load-name file time) outbuf) (terpri outbuf) ;; Break that line at spaces, to avoid very long lines. @@ -272,12 +273,14 @@ which lists the file name and which functions are in it, etc." (defun autoload-find-file (file) "Fetch file and put it in a temp buffer. Return the buffer." ;; It is faster to avoid visiting the file. + (setq file (expand-file-name file)) (with-current-buffer (get-buffer-create " *autoload-file*") (kill-all-local-variables) (erase-buffer) (setq buffer-undo-list t buffer-read-only nil) (emacs-lisp-mode) + (setq default-directory (file-name-directory file)) (insert-file-contents file nil) (let ((enable-local-variables :safe)) (hack-local-variables)) @@ -286,6 +289,12 @@ which lists the file name and which functions are in it, etc." (defvar no-update-autoloads nil "File local variable to prevent scanning this file for autoload cookies.") +(defun autoload-file-load-name (file) + (let ((name (file-name-nondirectory file))) + (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) + (substring name 0 (match-beginning 0)) + name))) + (defun generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. Autoloads are generated for defuns and defmacros in FILE @@ -294,100 +303,152 @@ If FILE is being visited in a buffer, the contents of the buffer are used. Return non-nil in the case where no autoloads were added at point." (interactive "fGenerate autoloads for file: ") - (let ((outbuf (current-buffer)) - (autoloads-done '()) - (load-name (let ((name (file-name-nondirectory file))) - (if (string-match "\\.elc?\\(\\.\\|$\\)" name) - (substring name 0 (match-beginning 0)) - name))) - (print-length nil) - (print-readably t) ; This does something in Lucid Emacs. - (float-output-format nil) - (done-any nil) - (visited (get-file-buffer file)) - output-start) - - ;; If the autoload section we create here uses an absolute - ;; file name for FILE in its header, and then Emacs is installed - ;; under a different path on another system, - ;; `update-autoloads-here' won't be able to find the files to be - ;; autoloaded. So, if FILE is in the same directory or a - ;; subdirectory of the current buffer's directory, we'll make it - ;; relative to the current buffer's directory. - (setq file (expand-file-name file)) - (let* ((source-truename (file-truename file)) - (dir-truename (file-name-as-directory - (file-truename default-directory))) - (len (length dir-truename))) - (if (and (< len (length source-truename)) - (string= dir-truename (substring source-truename 0 len))) - (setq file (substring source-truename len)))) - - (with-current-buffer (or visited - ;; It is faster to avoid visiting the file. - (autoload-find-file file)) - ;; Obey the no-update-autoloads file local variable. - (unless no-update-autoloads - (message "Generating autoloads for %s..." file) - (setq output-start (with-current-buffer outbuf (point))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\f") - (cond - ((looking-at (regexp-quote generate-autoload-cookie)) - (search-forward generate-autoload-cookie) - (skip-chars-forward " \t") - (setq done-any t) - (if (eolp) - ;; Read the next form and make an autoload. - (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name))) - (if autoload - (push (nth 1 form) autoloads-done) - (setq autoload form)) - (let ((autoload-print-form-outbuf outbuf)) - (autoload-print-form autoload))) - - ;; Copy the rest of the line to the output. - (princ (buffer-substring - (progn - ;; Back up over whitespace, to preserve it. - (skip-chars-backward " \f\t") - (if (= (char-after (1+ (point))) ? ) - ;; Eat one space. - (forward-char 1)) - (point)) - (progn (forward-line 1) (point))) - outbuf))) - ((looking-at ";") - ;; Don't read the comment. - (forward-line 1)) - (t - (forward-sexp 1) - (forward-line 1)))))) - - (when done-any - (with-current-buffer outbuf - (save-excursion - ;; Insert the section-header line which lists the file name - ;; and which functions are in it, etc. - (goto-char output-start) - (autoload-insert-section-header - outbuf autoloads-done load-name file - (nth 5 (file-attributes file))) - (insert ";;; Generated autoloads from " - (autoload-trim-file-name file) "\n")) - (insert generate-autoload-section-trailer))) - (message "Generating autoloads for %s...done" file)) - (or visited - ;; We created this buffer, so we should kill it. - (kill-buffer (current-buffer)))) - (not done-any))) + (autoload-generate-file-autoloads file (current-buffer))) + +;; When called from `generate-file-autoloads' we should ignore +;; `generated-autoload-file' altogether. When called from +;; `update-file-autoloads' we don't know `outbuf'. And when called from +;; `update-directory-autoloads' it's in between: we know the default +;; `outbuf' but we should obey any file-local setting of +;; `generated-autoload-file'. +(defun autoload-generate-file-autoloads (file &optional outbuf outfile) + "Insert an autoload section for FILE in the appropriate buffer. +Autoloads are generated for defuns and defmacros in FILE +marked by `generate-autoload-cookie' (which see). +If FILE is being visited in a buffer, the contents of the buffer are used. +OUTBUF is the buffer in which the autoload statements should be inserted. +If OUTBUF is nil, it will be determined by `autoload-generated-file'. + +If provided, OUTFILE is expected to be the file name of OUTBUF. +If OUTFILE is non-nil and FILE specifies a `generated-autoload-file' +different from OUTFILE, then OUTBUF is ignored. + +Return non-nil iff FILE adds no autoloads to OUTFILE +\(or OUTBUF if OUTFILE is nil)." + (catch 'done + (let ((autoloads-done '()) + (load-name (autoload-file-load-name file)) + (print-length nil) + (print-readably t) ; This does something in Lucid Emacs. + (float-output-format nil) + (visited (get-file-buffer file)) + (otherbuf nil) + (absfile (expand-file-name file)) + relfile + ;; nil until we found a cookie. + output-start) + + (with-current-buffer (or visited + ;; It is faster to avoid visiting the file. + (autoload-find-file file)) + ;; Obey the no-update-autoloads file local variable. + (unless no-update-autoloads + (message "Generating autoloads for %s..." file) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n\f") + (cond + ((looking-at (regexp-quote generate-autoload-cookie)) + ;; If not done yet, figure out where to insert this text. + (unless output-start + (when (and outfile + (not (equal outfile (autoload-generated-file)))) + ;; A file-local setting of autoload-generated-file says + ;; we should ignore OUTBUF. + (setq outbuf nil) + (setq otherbuf t)) + (unless outbuf + (setq outbuf (autoload-find-destination absfile)) + (unless outbuf + ;; The file has autoload cookies, but they're + ;; already up-to-date. If OUTFILE is nil, the + ;; entries are in the expected OUTBUF, otherwise + ;; they're elsewhere. + (throw 'done outfile))) + (with-current-buffer outbuf + (setq relfile (file-relative-name absfile)) + (setq output-start (point))) + ;; (message "file=%S, relfile=%S, dest=%S" + ;; file relfile (autoload-generated-file)) + ) + (search-forward generate-autoload-cookie) + (skip-chars-forward " \t") + (if (eolp) + (condition-case err + ;; Read the next form and make an autoload. + (let* ((form (prog1 (read (current-buffer)) + (or (bolp) (forward-line 1)))) + (autoload (make-autoload form load-name))) + (if autoload + (push (nth 1 form) autoloads-done) + (setq autoload form)) + (let ((autoload-print-form-outbuf outbuf)) + (autoload-print-form autoload))) + (error + (message "Error in %s: %S" file err))) + + ;; Copy the rest of the line to the output. + (princ (buffer-substring + (progn + ;; Back up over whitespace, to preserve it. + (skip-chars-backward " \f\t") + (if (= (char-after (1+ (point))) ? ) + ;; Eat one space. + (forward-char 1)) + (point)) + (progn (forward-line 1) (point))) + outbuf))) + ((looking-at ";") + ;; Don't read the comment. + (forward-line 1)) + (t + (forward-sexp 1) + (forward-line 1)))))) + + (when output-start + (let ((secondary-autoloads-file-buf + (if (local-variable-p 'generated-autoload-file) + (current-buffer)))) + (with-current-buffer outbuf + (save-excursion + ;; Insert the section-header line which lists the file name + ;; and which functions are in it, etc. + (goto-char output-start) + (autoload-insert-section-header + outbuf autoloads-done load-name relfile + (if secondary-autoloads-file-buf + ;; MD5 checksums are much better because they do not + ;; change unless the file changes (so they'll be + ;; equal on two different systems and will change + ;; less often than time-stamps, thus leading to fewer + ;; unneeded changes causing spurious conflicts), but + ;; using time-stamps is a very useful optimization, + ;; so we use time-stamps for the main autoloads file + ;; (loaddefs.el) where we have special ways to + ;; circumvent the "random change problem", and MD5 + ;; checksum in secondary autoload files where we do + ;; not need the time-stamp optimization because it is + ;; already provided by the primary autoloads file. + (md5 secondary-autoloads-file-buf nil nil 'emacs-mule) + (nth 5 (file-attributes relfile)))) + (insert ";;; Generated autoloads from " relfile "\n")) + (insert generate-autoload-section-trailer)))) + (message "Generating autoloads for %s...done" file)) + (or visited + ;; We created this buffer, so we should kill it. + (kill-buffer (current-buffer)))) + ;; If the entries were added to some other buffer, then the file + ;; doesn't add entries to OUTFILE. + (or (not output-start) otherbuf)))) +(defun autoload-save-buffers () + (while autoload-modified-buffers + (with-current-buffer (pop autoload-modified-buffers) + (save-buffer)))) + ;;;###autoload (defun update-file-autoloads (file &optional save-after) "Update the autoloads for FILE in `generated-autoload-file' @@ -397,80 +458,80 @@ save the buffer too. Return FILE if there was no autoload cookie in it, else nil." (interactive "fUpdate autoloads for file: \np") - (let ((load-name (let ((name (file-name-nondirectory file))) - (if (string-match "\\.elc?\\(\\.\\|$\\)" name) - (substring name 0 (match-beginning 0)) - name))) - (found nil) - (existing-buffer (get-file-buffer file)) - (no-autoloads nil)) - (save-excursion - ;; We want to get a value for generated-autoload-file from - ;; the local variables section if it's there. - (if existing-buffer - (set-buffer existing-buffer)) - ;; We must read/write the file without any code conversion, - ;; but still decode EOLs. - (let ((coding-system-for-read 'raw-text)) - (set-buffer (find-file-noselect - (autoload-ensure-default-file - (expand-file-name generated-autoload-file - (expand-file-name "lisp" - source-directory))))) - ;; This is to make generated-autoload-file have Unix EOLs, so - ;; that it is portable to all platforms. - (setq buffer-file-coding-system 'raw-text-unix)) - (or (> (buffer-size) 0) - (error "Autoloads file %s does not exist" buffer-file-name)) - (or (file-writable-p buffer-file-name) - (error "Autoloads file %s is not writable" buffer-file-name)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - ;; Look for the section for LOAD-NAME. - (while (and (not found) - (search-forward generate-autoload-section-header nil t)) - (let ((form (autoload-read-section-header))) - (cond ((string= (nth 2 form) load-name) - ;; We found the section for this file. - ;; Check if it is up to date. - (let ((begin (match-beginning 0)) - (last-time (nth 4 form)) - (file-time (nth 5 (file-attributes file)))) - (if (and (or (null existing-buffer) - (not (buffer-modified-p existing-buffer))) - (listp last-time) (= (length last-time) 2) - (not (time-less-p last-time file-time))) - (progn - (if (interactive-p) - (message "\ -Autoload section for %s is up to date." - file)) - (setq found 'up-to-date)) - (search-forward generate-autoload-section-trailer) - (delete-region begin (point)) - (setq found t)))) - ((string< load-name (nth 2 form)) - ;; We've come to a section alphabetically later than - ;; LOAD-NAME. We assume the file is in order and so - ;; there must be no section for LOAD-NAME. We will - ;; insert one before the section here. - (goto-char (match-beginning 0)) - (setq found 'new))))) - (or found - (progn - (setq found 'new) - ;; No later sections in the file. Put before the last page. - (goto-char (point-max)) - (search-backward "\f" nil t))) - (or (eq found 'up-to-date) - (setq no-autoloads (generate-file-autoloads file))))) - (and save-after - (buffer-modified-p) - (save-buffer)) - - (if no-autoloads file)))) + (let* ((autoload-modified-buffers nil) + (no-autoloads (autoload-generate-file-autoloads file))) + (if autoload-modified-buffers + (if save-after (autoload-save-buffers)) + (if (interactive-p) + (message "Autoload section for %s is up to date." file))) + (if no-autoloads file))) + +(defun autoload-find-destination (file) + "Find the destination point of the current buffer's autoloads. +FILE is the file name of the current buffer. +Returns a buffer whose point is placed at the requested location. +Returns nil if the file's autoloads are uptodate, otherwise +removes any prior now out-of-date autoload entries." + (catch 'up-to-date + (let* ((load-name (autoload-file-load-name file)) + (buf (current-buffer)) + (existing-buffer (if buffer-file-name buf)) + (found nil)) + (with-current-buffer + ;; We must read/write the file without any code conversion, + ;; but still decode EOLs. + (let ((coding-system-for-read 'raw-text)) + (find-file-noselect + (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. + (setq buffer-file-coding-system 'raw-text-unix) + (or (> (buffer-size) 0) + (error "Autoloads file %s does not exist" buffer-file-name)) + (or (file-writable-p buffer-file-name) + (error "Autoloads file %s is not writable" buffer-file-name)) + (widen) + (goto-char (point-min)) + ;; Look for the section for LOAD-NAME. + (while (and (not found) + (search-forward generate-autoload-section-header nil t)) + (let ((form (autoload-read-section-header))) + (cond ((string= (nth 2 form) load-name) + ;; We found the section for this file. + ;; Check if it is up to date. + (let ((begin (match-beginning 0)) + (last-time (nth 4 form)) + (file-time (nth 5 (file-attributes file)))) + (if (and (or (null existing-buffer) + (not (buffer-modified-p existing-buffer))) + (or + ;; last-time is the time-stamp (specifying + ;; the last time we looked at the file) and + ;; the file hasn't been changed since. + (and (listp last-time) (= (length last-time) 2) + (not (time-less-p last-time file-time))) + ;; last-time is an MD5 checksum instead. + (and (stringp last-time) + (equal last-time + (md5 buf nil nil 'emacs-mule))))) + (throw 'up-to-date nil) + (autoload-remove-section begin) + (setq found t)))) + ((string< load-name (nth 2 form)) + ;; We've come to a section alphabetically later than + ;; LOAD-NAME. We assume the file is in order and so + ;; there must be no section for LOAD-NAME. We will + ;; insert one before the section here. + (goto-char (match-beginning 0)) + (setq found t))))) + (or found + (progn + ;; No later sections in the file. Put before the last page. + (goto-char (point-max)) + (search-backward "\f" nil t))) + (unless (memq (current-buffer) autoload-modified-buffers) + (push (current-buffer) autoload-modified-buffers)) + (current-buffer))))) (defun autoload-remove-section (begin) (goto-char begin) @@ -499,19 +560,19 @@ directory or directories specified." t files-re)) dirs))) (this-time (current-time)) - (no-autoloads nil) ;files with no autoload cookies. - (autoloads-file - (expand-file-name generated-autoload-file - (expand-file-name "lisp" source-directory))) - (top-dir (file-name-directory autoloads-file))) + ;; Files with no autoload cookies or whose autoloads go to other + ;; files because of file-local autoload-generated-file settings. + (no-autoloads nil) + (autoload-modified-buffers nil)) (with-current-buffer - (find-file-noselect (autoload-ensure-default-file autoloads-file)) + (find-file-noselect + (autoload-ensure-default-file (autoload-generated-file))) (save-excursion ;; Canonicalize file names and remove the autoload file itself. - (setq files (delete (autoload-trim-file-name buffer-file-name) - (mapcar 'autoload-trim-file-name files))) + (setq files (delete (file-relative-name buffer-file-name) + (mapcar 'file-relative-name files))) (goto-char (point-min)) (while (search-forward generate-autoload-section-header nil t) @@ -531,19 +592,26 @@ directory or directories specified." (push file no-autoloads) (setq files (delete file files))))))) ((not (stringp file))) - ((not (file-exists-p (expand-file-name file top-dir))) + ((not (and (file-exists-p file) + ;; Remove duplicates as well, just in case. + (member file files))) ;; Remove the obsolete section. (autoload-remove-section (match-beginning 0))) - ((equal (nth 4 form) (nth 5 (file-attributes file))) + ((not (time-less-p (nth 4 form) + (nth 5 (file-attributes file)))) ;; File hasn't changed. nil) (t - (update-file-autoloads file))) + (autoload-remove-section (match-beginning 0)) + (if (autoload-generate-file-autoloads + file (current-buffer) buffer-file-name) + (push file no-autoloads)))) (setq files (delete file files))))) ;; Elements remaining in FILES have no existing autoload sections yet. - (setq no-autoloads - (append no-autoloads - (delq nil (mapcar 'update-file-autoloads files)))) + (dolist (file files) + (if (autoload-generate-file-autoloads file nil buffer-file-name) + (push file no-autoloads))) + (when no-autoloads ;; Sort them for better readability. (setq no-autoloads (sort no-autoloads 'string<)) @@ -554,7 +622,10 @@ directory or directories specified." (current-buffer) nil nil no-autoloads this-time) (insert generate-autoload-section-trailer)) - (save-buffer)))) + (save-buffer) + ;; In case autoload entries were added to other files because of + ;; file-local autoload-generated-file settings. + (autoload-save-buffers)))) (define-obsolete-function-alias 'update-autoloads-from-directories 'update-directory-autoloads "22.1") diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 60c20e68b03..98e55dab98f 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -43,6 +43,7 @@ ;;; Type coercion. +;;;###autoload (defun coerce (x type) "Coerce OBJECT to type TYPE. TYPE is a Common Lisp type specifier. @@ -60,6 +61,7 @@ TYPE is a Common Lisp type specifier. ;;; Predicates. +;;;###autoload (defun equalp (x y) "Return t if two Lisp objects have similar structures and contents. This is like `equal', except that it accepts numerically equal @@ -87,6 +89,7 @@ strings case-insensitively." ;;; Control structures. +;;;###autoload (defun cl-mapcar-many (cl-func cl-seqs) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) @@ -119,6 +122,7 @@ strings case-insensitively." cl-res))) (nreverse cl-res)))) +;;;###autoload (defun map (cl-type cl-func cl-seq &rest cl-rest) "Map a FUNCTION across one or more SEQUENCEs, returning a sequence. TYPE is the sequence type to return. @@ -126,6 +130,7 @@ TYPE is the sequence type to return. (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) (and cl-type (coerce cl-res cl-type)))) +;;;###autoload (defun maplist (cl-func cl-list &rest cl-rest) "Map FUNCTION to each sublist of LIST or LISTs. Like `mapcar', except applies to lists and their cdr's rather than to @@ -154,6 +159,7 @@ the elements themselves. cl-seq) (mapc cl-func cl-seq))) +;;;###autoload (defun mapl (cl-func cl-list &rest cl-rest) "Like `maplist', but does not accumulate values returned by the function. \n(fn FUNCTION LIST...)" @@ -163,16 +169,19 @@ the elements themselves. (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) cl-list) +;;;###autoload (defun mapcan (cl-func cl-seq &rest cl-rest) "Like `mapcar', but nconc's together the values returned by the function. \n(fn FUNCTION SEQUENCE...)" (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) +;;;###autoload (defun mapcon (cl-func cl-list &rest cl-rest) "Like `maplist', but nconc's together the values returned by the function. \n(fn FUNCTION LIST...)" (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) +;;;###autoload (defun some (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of any element of SEQ or SEQs. If so, return the true (non-nil) value returned by PREDICATE. @@ -188,6 +197,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) cl-x))) +;;;###autoload (defun every (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is true of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" @@ -201,19 +211,23 @@ If so, return the true (non-nil) value returned by PREDICATE. (setq cl-seq (cdr cl-seq))) (null cl-seq))) +;;;###autoload (defun notany (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of every element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" (not (apply 'some cl-pred cl-seq cl-rest))) +;;;###autoload (defun notevery (cl-pred cl-seq &rest cl-rest) "Return true if PREDICATE is false of some element of SEQ or SEQs. \n(fn PREDICATE SEQ...)" (not (apply 'every cl-pred cl-seq cl-rest))) ;;; Support for `loop'. +;;;###autoload (defalias 'cl-map-keymap 'map-keymap) +;;;###autoload (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) (or cl-base (setq cl-base (copy-sequence [0]))) @@ -228,6 +242,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (funcall cl-func-rec cl-base cl-bind)))) cl-map)) +;;;###autoload (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) (or cl-what (setq cl-what (current-buffer))) (if (bufferp cl-what) @@ -255,6 +270,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (funcall cl-func cl-start (min cl-next cl-end)) (setq cl-start cl-next))))) +;;;###autoload (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) (if (fboundp 'overlay-lists) @@ -296,6 +312,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) ;;; Support for `setf'. +;;;###autoload (defun cl-set-frame-visible-p (frame val) (cond ((null val) (make-frame-invisible frame)) ((eq val 'icon) (iconify-frame frame)) @@ -304,6 +321,7 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;; Support for `progv'. (defvar cl-progv-save) +;;;###autoload (defun cl-progv-before (syms values) (while syms (push (if (boundp (car syms)) @@ -323,6 +341,7 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;; Numbers. +;;;###autoload (defun gcd (&rest args) "Return the greatest common divisor of the arguments." (let ((a (abs (or (pop args) 0)))) @@ -331,6 +350,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (while (> b 0) (setq b (% a (setq a b)))))) a)) +;;;###autoload (defun lcm (&rest args) "Return the least common multiple of the arguments." (if (memq 0 args) @@ -341,6 +361,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (setq a (* (/ a (gcd a b)) b)))) a))) +;;;###autoload (defun isqrt (x) "Return the integer square root of the argument." (if (and (integerp x) (> x 0)) @@ -352,12 +373,14 @@ If so, return the true (non-nil) value returned by PREDICATE. g) (if (eq x 0) 0 (signal 'arith-error nil)))) +;;;###autoload (defun floor* (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) +;;;###autoload (defun ceiling* (x &optional y) "Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient." @@ -365,12 +388,14 @@ With two arguments, return ceiling and remainder of their quotient." (if (= (car (cdr res)) 0) res (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) +;;;###autoload (defun truncate* (x &optional y) "Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient." (if (eq (>= x 0) (or (null y) (>= y 0))) (floor* x y) (ceiling* x y))) +;;;###autoload (defun round* (x &optional y) "Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient." @@ -389,14 +414,17 @@ With two arguments, return rounding and remainder of their quotient." (let ((q (round x))) (list q (- x q)))))) +;;;###autoload (defun mod* (x y) "The remainder of X divided by Y, with the same sign as Y." (nth 1 (floor* x y))) +;;;###autoload (defun rem* (x y) "The remainder of X divided by Y, with the same sign as X." (nth 1 (truncate* x y))) +;;;###autoload (defun signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) ((< x 0) -1) (t 0))) @@ -405,6 +433,7 @@ With two arguments, return rounding and remainder of their quotient." ;; Random numbers. (defvar *random-state*) +;;;###autoload (defun random* (lim &optional state) "Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object." @@ -412,7 +441,7 @@ Optional second arg STATE is a random-state object." ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. (let ((vec (aref state 3))) (if (integerp vec) - (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii) + (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1)) (aset state 3 (setq vec (make-vector 55 nil))) (aset vec 0 j) (while (> (setq i (% (+ i 21) 55)) 0) @@ -429,6 +458,7 @@ Optional second arg STATE is a random-state object." (if (< (setq n (logand n mask)) lim) n (random* lim state)))) (* (/ n '8388608e0) lim))))) +;;;###autoload (defun make-random-state (&optional state) "Return a copy of random-state STATE, or of `*random-state*' if omitted. If STATE is t, return a new state object seeded from the time of day." @@ -437,6 +467,7 @@ If STATE is t, return a new state object seeded from the time of day." ((integerp state) (vector 'cl-random-state-tag -1 30 state)) (t (make-random-state (cl-random-time))))) +;;;###autoload (defun random-state-p (object) "Return t if OBJECT is a random-state object." (and (vectorp object) (= (length object) 4) @@ -460,6 +491,7 @@ If STATE is t, return a new state object seeded from the time of day." (defvar float-epsilon) (defvar float-negative-epsilon) +;;;###autoload (defun cl-float-limits () (or most-positive-float (not (numberp '2e1)) (let ((x '2e0) y z) @@ -497,6 +529,7 @@ If STATE is t, return a new state object seeded from the time of day." ;;; Sequence functions. +;;;###autoload (defun subseq (seq start &optional end) "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. @@ -522,6 +555,7 @@ If START or END is negative, it counts from the end." (setq i (1+ i) start (1+ start))) res)))))) +;;;###autoload (defun concatenate (type &rest seqs) "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. \n(fn TYPE SEQUENCE...)" @@ -533,14 +567,17 @@ If START or END is negative, it counts from the end." ;;; List functions. +;;;###autoload (defun revappend (x y) "Equivalent to (append (reverse X) Y)." (nconc (reverse x) y)) +;;;###autoload (defun nreconc (x y) "Equivalent to (nconc (nreverse X) Y)." (nconc (nreverse x) y)) +;;;###autoload (defun list-length (x) "Return the length of list X. Return nil if list is circular." (let ((n 0) (fast x) (slow x)) @@ -548,6 +585,7 @@ If START or END is negative, it counts from the end." (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) (if fast (if (cdr fast) nil (1+ n)) n))) +;;;###autoload (defun tailp (sublist list) "Return true if SUBLIST is a tail of LIST." (while (and (consp list) (not (eq sublist list))) @@ -559,6 +597,7 @@ If START or END is negative, it counts from the end." ;;; Property lists. +;;;###autoload (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" @@ -569,6 +608,7 @@ If START or END is negative, it counts from the end." (setq plist (cdr (cdr plist)))) (if plist (car (cdr plist)) def))))) +;;;###autoload (defun getf (plist tag &optional def) "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. @@ -583,16 +623,19 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (setq plist (cdr (cdr plist)))) (if plist (car (cdr plist)) def)))) +;;;###autoload (defun cl-set-getf (plist tag val) (let ((p plist)) (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) +;;;###autoload (defun cl-do-remf (plist tag) (let ((p (cdr plist))) (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) +;;;###autoload (defun cl-remprop (sym tag) "Remove from SYMBOL's plist the property PROPNAME and its value. \n(fn SYMBOL PROPNAME)" @@ -600,6 +643,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (if (and plist (eq tag (car plist))) (progn (setplist sym (cdr (cdr plist))) t) (cl-do-remf plist tag)))) +;;;###autoload (defalias 'remprop 'cl-remprop) @@ -616,14 +660,22 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (defvar cl-builtin-clrhash (symbol-function 'clrhash)) (defvar cl-builtin-maphash (symbol-function 'maphash)) +;;;###autoload (defalias 'cl-gethash 'gethash) +;;;###autoload (defalias 'cl-puthash 'puthash) +;;;###autoload (defalias 'cl-remhash 'remhash) +;;;###autoload (defalias 'cl-clrhash 'clrhash) +;;;###autoload (defalias 'cl-maphash 'maphash) ;; These three actually didn't exist in Emacs-20. +;;;###autoload (defalias 'cl-make-hash-table 'make-hash-table) +;;;###autoload (defalias 'cl-hash-table-p 'hash-table-p) +;;;###autoload (defalias 'cl-hash-table-count 'hash-table-count) ;;; Some debugging aids. @@ -672,6 +724,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (defvar cl-macroexpand-cmacs nil) (defvar cl-closure-vars nil) +;;;###autoload (defun cl-macroexpand-all (form &optional env) "Expand all macro calls through a Lisp FORM. This also does some trivial optimizations to make the form prettier." @@ -753,6 +806,7 @@ This also does some trivial optimizations to make the form prettier." (defun cl-macroexpand-body (body &optional env) (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) +;;;###autoload (defun cl-prettyexpand (form &optional full) (message "Expanding...") (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) @@ -767,5 +821,9 @@ This also does some trivial optimizations to make the form prettier." (run-hooks 'cl-extra-load-hook) +;; Local variables: +;; generated-autoload-file: "cl-loaddefs.el" +;; End: + ;; arch-tag: bcd03437-0871-43fb-a8f1-ad0e0b5427ed ;;; cl-extra.el ends here diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el new file mode 100644 index 00000000000..65cb0754446 --- /dev/null +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -0,0 +1,1235 @@ +;;; cl-loaddefs.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (cl-prettyexpand cl-macroexpand-all cl-remprop +;;;;;; cl-do-remf cl-set-getf getf get* tailp list-length nreconc +;;;;;; revappend concatenate subseq cl-float-limits random-state-p +;;;;;; make-random-state random* signum rem* mod* round* truncate* +;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p +;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively +;;;;;; notevery notany every some mapcon mapcan mapl maplist map +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" (18050 +;;;;;; 46455)) +;;; Generated autoloads from cl-extra.el + +(autoload (quote coerce) "cl-extra" "\ +Coerce OBJECT to type TYPE. +TYPE is a Common Lisp type specifier. + +\(fn OBJECT TYPE)" nil nil) + +(autoload (quote equalp) "cl-extra" "\ +Return t if two Lisp objects have similar structures and contents. +This is like `equal', except that it accepts numerically equal +numbers of different types (float vs. integer), and also compares +strings case-insensitively. + +\(fn X Y)" nil nil) + +(autoload (quote cl-mapcar-many) "cl-extra" "\ +Not documented + +\(fn CL-FUNC CL-SEQS)" nil nil) + +(autoload (quote map) "cl-extra" "\ +Map a FUNCTION across one or more SEQUENCEs, returning a sequence. +TYPE is the sequence type to return. + +\(fn TYPE FUNCTION SEQUENCE...)" nil nil) + +(autoload (quote maplist) "cl-extra" "\ +Map FUNCTION to each sublist of LIST or LISTs. +Like `mapcar', except applies to lists and their cdr's rather than to +the elements themselves. + +\(fn FUNCTION LIST...)" nil nil) + +(autoload (quote mapl) "cl-extra" "\ +Like `maplist', but does not accumulate values returned by the function. + +\(fn FUNCTION LIST...)" nil nil) + +(autoload (quote mapcan) "cl-extra" "\ +Like `mapcar', but nconc's together the values returned by the function. + +\(fn FUNCTION SEQUENCE...)" nil nil) + +(autoload (quote mapcon) "cl-extra" "\ +Like `maplist', but nconc's together the values returned by the function. + +\(fn FUNCTION LIST...)" nil nil) + +(autoload (quote some) "cl-extra" "\ +Return true if PREDICATE is true of any element of SEQ or SEQs. +If so, return the true (non-nil) value returned by PREDICATE. + +\(fn PREDICATE SEQ...)" nil nil) + +(autoload (quote every) "cl-extra" "\ +Return true if PREDICATE is true of every element of SEQ or SEQs. + +\(fn PREDICATE SEQ...)" nil nil) + +(autoload (quote notany) "cl-extra" "\ +Return true if PREDICATE is false of every element of SEQ or SEQs. + +\(fn PREDICATE SEQ...)" nil nil) + +(autoload (quote notevery) "cl-extra" "\ +Return true if PREDICATE is false of some element of SEQ or SEQs. + +\(fn PREDICATE SEQ...)" nil nil) + +(defalias (quote cl-map-keymap) (quote map-keymap)) + +(autoload (quote cl-map-keymap-recursively) "cl-extra" "\ +Not documented + +\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) + +(autoload (quote cl-map-intervals) "cl-extra" "\ +Not documented + +\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) + +(autoload (quote cl-map-overlays) "cl-extra" "\ +Not documented + +\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) + +(autoload (quote cl-set-frame-visible-p) "cl-extra" "\ +Not documented + +\(fn FRAME VAL)" nil nil) + +(autoload (quote cl-progv-before) "cl-extra" "\ +Not documented + +\(fn SYMS VALUES)" nil nil) + +(autoload (quote gcd) "cl-extra" "\ +Return the greatest common divisor of the arguments. + +\(fn &rest ARGS)" nil nil) + +(autoload (quote lcm) "cl-extra" "\ +Return the least common multiple of the arguments. + +\(fn &rest ARGS)" nil nil) + +(autoload (quote isqrt) "cl-extra" "\ +Return the integer square root of the argument. + +\(fn X)" nil nil) + +(autoload (quote floor*) "cl-extra" "\ +Return a list of the floor of X and the fractional part of X. +With two arguments, return floor and remainder of their quotient. + +\(fn X &optional Y)" nil nil) + +(autoload (quote ceiling*) "cl-extra" "\ +Return a list of the ceiling of X and the fractional part of X. +With two arguments, return ceiling and remainder of their quotient. + +\(fn X &optional Y)" nil nil) + +(autoload (quote truncate*) "cl-extra" "\ +Return a list of the integer part of X and the fractional part of X. +With two arguments, return truncation and remainder of their quotient. + +\(fn X &optional Y)" nil nil) + +(autoload (quote round*) "cl-extra" "\ +Return a list of X rounded to the nearest integer and the remainder. +With two arguments, return rounding and remainder of their quotient. + +\(fn X &optional Y)" nil nil) + +(autoload (quote mod*) "cl-extra" "\ +The remainder of X divided by Y, with the same sign as Y. + +\(fn X Y)" nil nil) + +(autoload (quote rem*) "cl-extra" "\ +The remainder of X divided by Y, with the same sign as X. + +\(fn X Y)" nil nil) + +(autoload (quote signum) "cl-extra" "\ +Return 1 if X is positive, -1 if negative, 0 if zero. + +\(fn X)" nil nil) + +(autoload (quote random*) "cl-extra" "\ +Return a random nonnegative number less than LIM, an integer or float. +Optional second arg STATE is a random-state object. + +\(fn LIM &optional STATE)" nil nil) + +(autoload (quote make-random-state) "cl-extra" "\ +Return a copy of random-state STATE, or of `*random-state*' if omitted. +If STATE is t, return a new state object seeded from the time of day. + +\(fn &optional STATE)" nil nil) + +(autoload (quote random-state-p) "cl-extra" "\ +Return t if OBJECT is a random-state object. + +\(fn OBJECT)" nil nil) + +(autoload (quote cl-float-limits) "cl-extra" "\ +Not documented + +\(fn)" nil nil) + +(autoload (quote subseq) "cl-extra" "\ +Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end. + +\(fn SEQ START &optional END)" nil nil) + +(autoload (quote concatenate) "cl-extra" "\ +Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. + +\(fn TYPE SEQUENCE...)" nil nil) + +(autoload (quote revappend) "cl-extra" "\ +Equivalent to (append (reverse X) Y). + +\(fn X Y)" nil nil) + +(autoload (quote nreconc) "cl-extra" "\ +Equivalent to (nconc (nreverse X) Y). + +\(fn X Y)" nil nil) + +(autoload (quote list-length) "cl-extra" "\ +Return the length of list X. Return nil if list is circular. + +\(fn X)" nil nil) + +(autoload (quote tailp) "cl-extra" "\ +Return true if SUBLIST is a tail of LIST. + +\(fn SUBLIST LIST)" nil nil) + +(autoload (quote get*) "cl-extra" "\ +Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. + +\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) + +(autoload (quote getf) "cl-extra" "\ +Search PROPLIST for property PROPNAME; return its value or DEFAULT. +PROPLIST is a list of the sort returned by `symbol-plist'. + +\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) + +(autoload (quote cl-set-getf) "cl-extra" "\ +Not documented + +\(fn PLIST TAG VAL)" nil nil) + +(autoload (quote cl-do-remf) "cl-extra" "\ +Not documented + +\(fn PLIST TAG)" nil nil) + +(autoload (quote cl-remprop) "cl-extra" "\ +Remove from SYMBOL's plist the property PROPNAME and its value. + +\(fn SYMBOL PROPNAME)" nil nil) + +(defalias (quote remprop) (quote cl-remprop)) + +(defalias (quote cl-gethash) (quote gethash)) + +(defalias (quote cl-puthash) (quote puthash)) + +(defalias (quote cl-remhash) (quote remhash)) + +(defalias (quote cl-clrhash) (quote clrhash)) + +(defalias (quote cl-maphash) (quote maphash)) + +(defalias (quote cl-make-hash-table) (quote make-hash-table)) + +(defalias (quote cl-hash-table-p) (quote hash-table-p)) + +(defalias (quote cl-hash-table-count) (quote hash-table-count)) + +(autoload (quote cl-macroexpand-all) "cl-extra" "\ +Expand all macro calls through a Lisp FORM. +This also does some trivial optimizations to make the form prettier. + +\(fn FORM &optional ENV)" nil nil) + +(autoload (quote cl-prettyexpand) "cl-extra" "\ +Not documented + +\(fn FORM &optional FULL)" nil nil) + +;;;*** + +;;;### (autoloads (compiler-macroexpand define-compiler-macro ignore-errors +;;;;;; assert check-type typep cl-struct-setf-expander defstruct +;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf +;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method +;;;;;; declare the locally multiple-value-setq multiple-value-bind +;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels +;;;;;; flet progv psetq 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-compile-time-init) "cl-macs" +;;;;;; "cl-macs.el" (18051 52572)) +;;; Generated autoloads from cl-macs.el + +(autoload (quote cl-compile-time-init) "cl-macs" "\ +Not documented + +\(fn)" nil nil) + +(autoload (quote gensym) "cl-macs" "\ +Generate a new uninterned symbol. +The name is made by appending a number to PREFIX, default \"G\". + +\(fn &optional PREFIX)" nil nil) + +(autoload (quote gentemp) "cl-macs" "\ +Generate a new interned symbol with a unique name. +The name is made by appending a number to PREFIX, default \"G\". + +\(fn &optional PREFIX)" nil nil) + +(autoload (quote defun*) "cl-macs" "\ +Define NAME as a function. +Like normal `defun', except ARGLIST allows full Common Lisp conventions, +and BODY is implicitly surrounded by (block NAME ...). + +\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) + +(autoload (quote defmacro*) "cl-macs" "\ +Define NAME as a macro. +Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, +and BODY is implicitly surrounded by (block NAME ...). + +\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) + +(autoload (quote function*) "cl-macs" "\ +Introduce a function. +Like normal `function', except that if argument is a lambda form, +its argument list allows full Common Lisp conventions. + +\(fn FUNC)" nil (quote macro)) + +(autoload (quote destructuring-bind) "cl-macs" "\ +Not documented + +\(fn ARGS EXPR &rest BODY)" nil (quote macro)) + +(autoload (quote eval-when) "cl-macs" "\ +Control when BODY is evaluated. +If `compile' is in WHEN, BODY is evaluated when compiled at top-level. +If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. +If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. + +\(fn (WHEN...) BODY...)" nil (quote macro)) + +(autoload (quote load-time-value) "cl-macs" "\ +Like `progn', but evaluates the body at load time. +The result of the body appears to the compiler as a quoted constant. + +\(fn FORM &optional READ-ONLY)" nil (quote macro)) + +(autoload (quote case) "cl-macs" "\ +Eval EXPR and choose among clauses on that value. +Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared +against each key in each KEYLIST; the corresponding BODY is evaluated. +If no clause succeeds, case returns nil. A single atom may be used in +place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is +allowed only in the final clause, and matches if no other keys match. +Key values are compared by `eql'. + +\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) + +(autoload (quote ecase) "cl-macs" "\ +Like `case', but error if no case fits. +`otherwise'-clauses are not allowed. + +\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) + +(autoload (quote typecase) "cl-macs" "\ +Evals EXPR, chooses among clauses on that value. +Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it +satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, +typecase returns nil. A TYPE of t or `otherwise' is allowed only in the +final clause, and matches if no other keys match. + +\(fn EXPR (TYPE BODY...)...)" nil (quote macro)) + +(autoload (quote etypecase) "cl-macs" "\ +Like `typecase', but error if no case fits. +`otherwise'-clauses are not allowed. + +\(fn EXPR (TYPE BODY...)...)" nil (quote macro)) + +(autoload (quote block) "cl-macs" "\ +Define a lexically-scoped block named NAME. +NAME may be any symbol. Code inside the BODY forms can call `return-from' +to jump prematurely out of the block. This differs from `catch' and `throw' +in two respects: First, the NAME is an unevaluated symbol rather than a +quoted symbol or other form; and second, NAME is lexically rather than +dynamically scoped: Only references to it within BODY will work. These +references may appear inside macro expansions, but not inside functions +called from BODY. + +\(fn NAME &rest BODY)" nil (quote macro)) + +(autoload (quote return) "cl-macs" "\ +Return from the block named nil. +This is equivalent to `(return-from nil RESULT)'. + +\(fn &optional RESULT)" nil (quote macro)) + +(autoload (quote return-from) "cl-macs" "\ +Return from the block named NAME. +This jump out to the innermost enclosing `(block NAME ...)' form, +returning RESULT from that form (or nil if RESULT is omitted). +This is compatible with Common Lisp, but note that `defun' and +`defmacro' do not create implicit blocks as they do in Common Lisp. + +\(fn NAME &optional RESULT)" nil (quote macro)) + +(autoload (quote loop) "cl-macs" "\ +The Common Lisp `loop' macro. +Valid clauses are: + for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, + for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, + for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, + always COND, never COND, thereis COND, collect EXPR into VAR, + append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, + count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, + if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], + unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], + do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, + finally return EXPR, named NAME. + +\(fn CLAUSE...)" nil (quote macro)) + +(autoload (quote do) "cl-macs" "\ +The Common Lisp `do' loop. + +\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) + +(autoload (quote do*) "cl-macs" "\ +The Common Lisp `do*' loop. + +\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) + +(autoload (quote dolist) "cl-macs" "\ +Loop over a list. +Evaluate BODY with VAR bound to each `car' from LIST, in turn. +Then evaluate RESULT to get return value, default nil. + +\(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro)) + +(autoload (quote dotimes) "cl-macs" "\ +Loop a certain number of times. +Evaluate BODY with VAR bound to successive integers from 0, inclusive, +to COUNT, exclusive. Then evaluate RESULT to get return value, default +nil. + +\(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro)) + +(autoload (quote do-symbols) "cl-macs" "\ +Loop over all symbols. +Evaluate BODY with VAR bound to each interned symbol, or to each symbol +from OBARRAY. + +\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro)) + +(autoload (quote do-all-symbols) "cl-macs" "\ +Not documented + +\(fn SPEC &rest BODY)" nil (quote macro)) + +(autoload (quote psetq) "cl-macs" "\ +Set SYMs to the values VALs in parallel. +This is like `setq', except that all VAL forms are evaluated (in order) +before assigning any symbols SYM to the corresponding values. + +\(fn SYM VAL SYM VAL ...)" nil (quote macro)) + +(autoload (quote progv) "cl-macs" "\ +Bind SYMBOLS to VALUES dynamically in BODY. +The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. +Each symbol in the first list is bound to the corresponding value in the +second list (or made unbound if VALUES is shorter than SYMBOLS); then the +BODY forms are executed and their result is returned. This is much like +a `let' form, except that the list of symbols can be computed at run-time. + +\(fn SYMBOLS VALUES &rest BODY)" nil (quote macro)) + +(autoload (quote flet) "cl-macs" "\ +Make temporary function definitions. +This is an analogue of `let' that operates on the function cell of FUNC +rather than its value cell. The FORMs are evaluated with the specified +function definitions in place, then the definitions are undone (the FUNCs +go back to their previous definitions, or lack thereof). + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) + +(autoload (quote labels) "cl-macs" "\ +Make temporary function bindings. +This is like `flet', except the bindings are lexical instead of dynamic. +Unlike `flet', this macro is fully compliant with the Common Lisp standard. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) + +(autoload (quote macrolet) "cl-macs" "\ +Make temporary macro definitions. +This is like `flet', but for macros instead of functions. + +\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro)) + +(autoload (quote symbol-macrolet) "cl-macs" "\ +Make symbol macro definitions. +Within the body FORMs, references to the variable NAME will be replaced +by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). + +\(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro)) + +(autoload (quote lexical-let) "cl-macs" "\ +Like `let', but lexically scoped. +The main visible difference is that lambdas inside BODY will create +lexical closures as in Common Lisp. + +\(fn VARLIST BODY)" nil (quote macro)) + +(autoload (quote lexical-let*) "cl-macs" "\ +Like `let*', but lexically scoped. +The main visible difference is that lambdas inside BODY will create +lexical closures as in Common Lisp. + +\(fn VARLIST BODY)" nil (quote macro)) + +(autoload (quote multiple-value-bind) "cl-macs" "\ +Collect multiple return values. +FORM must return a list; the BODY is then executed with the first N elements +of this list bound (`let'-style) to each of the symbols SYM in turn. This +is analogous to the Common Lisp `multiple-value-bind' macro, using lists to +simulate true multiple return values. For compatibility, (values A B C) is +a synonym for (list A B C). + +\(fn (SYM...) FORM BODY)" nil (quote macro)) + +(autoload (quote multiple-value-setq) "cl-macs" "\ +Collect multiple return values. +FORM must return a list; the first N elements of this list are stored in +each of the symbols SYM in turn. This is analogous to the Common Lisp +`multiple-value-setq' macro, using lists to simulate true multiple return +values. For compatibility, (values A B C) is a synonym for (list A B C). + +\(fn (SYM...) FORM)" nil (quote macro)) + +(autoload (quote locally) "cl-macs" "\ +Not documented + +\(fn &rest BODY)" nil (quote macro)) + +(autoload (quote the) "cl-macs" "\ +Not documented + +\(fn TYPE FORM)" nil (quote macro)) + +(autoload (quote declare) "cl-macs" "\ +Not documented + +\(fn &rest SPECS)" nil (quote macro)) + +(autoload (quote define-setf-method) "cl-macs" "\ +Define a `setf' method. +This method shows how to handle `setf's to places of the form (NAME ARGS...). +The argument forms ARGS are bound according to ARGLIST, as if NAME were +going to be expanded as a macro, then the BODY forms are executed and must +return a list of five elements: a temporary-variables list, a value-forms +list, a store-variables list (of length one), a store-form, and an access- +form. See `defsetf' for a simpler way to define most setf-methods. + +\(fn NAME ARGLIST BODY...)" nil (quote macro)) + +(autoload (quote defsetf) "cl-macs" "\ +Define a `setf' method. +This macro is an easy-to-use substitute for `define-setf-method' that works +well for simple place forms. In the simple `defsetf' form, `setf's of +the form (setf (NAME ARGS...) VAL) are transformed to function or macro +calls of the form (FUNC ARGS... VAL). Example: + + (defsetf aref aset) + +Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). +Here, the above `setf' call is expanded by binding the argument forms ARGS +according to ARGLIST, binding the value form VAL to STORE, then executing +BODY, which must return a Lisp form that does the necessary `setf' operation. +Actually, ARGLIST and STORE may be bound to temporary variables which are +introduced automatically to preserve proper execution order of the arguments. +Example: + + (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v)) + +\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro)) + +(autoload (quote get-setf-method) "cl-macs" "\ +Return a list of five values describing the setf-method for PLACE. +PLACE may be any Lisp form which can appear as the PLACE argument to +a macro like `setf' or `incf'. + +\(fn PLACE &optional ENV)" nil nil) + +(autoload (quote setf) "cl-macs" "\ +Set each PLACE to the value of its VAL. +This is a generalized version of `setq'; the PLACEs may be symbolic +references such as (car x) or (aref x i), as well as plain symbols. +For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). +The return value is the last VAL in the list. + +\(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) + +(autoload (quote psetf) "cl-macs" "\ +Set PLACEs to the values VALs in parallel. +This is like `setf', except that all VAL forms are evaluated (in order) +before assigning any PLACEs to the corresponding values. + +\(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) + +(autoload (quote cl-do-pop) "cl-macs" "\ +Not documented + +\(fn PLACE)" nil nil) + +(autoload (quote remf) "cl-macs" "\ +Remove TAG from property list PLACE. +PLACE may be a symbol, or any generalized variable allowed by `setf'. +The form returns true if TAG was found and removed, nil otherwise. + +\(fn PLACE TAG)" nil (quote macro)) + +(autoload (quote shiftf) "cl-macs" "\ +Shift left among PLACEs. +Example: (shiftf A B C) sets A to B, B to C, and returns the old A. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. + +\(fn PLACE... VAL)" nil (quote macro)) + +(autoload (quote rotatef) "cl-macs" "\ +Rotate left among PLACEs. +Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. + +\(fn PLACE...)" nil (quote macro)) + +(autoload (quote letf) "cl-macs" "\ +Temporarily bind to PLACEs. +This is the analogue of `let', but with generalized variables (in the +sense of `setf') for the PLACEs. Each PLACE is set to the corresponding +VALUE, then the BODY forms are executed. On exit, either normally or +because of a `throw' or error, the PLACEs are set back to their original +values. Note that this macro is *not* available in Common Lisp. +As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', +the PLACE is not modified before executing BODY. + +\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) + +(autoload (quote letf*) "cl-macs" "\ +Temporarily bind to PLACEs. +This is the analogue of `let*', but with generalized variables (in the +sense of `setf') for the PLACEs. Each PLACE is set to the corresponding +VALUE, then the BODY forms are executed. On exit, either normally or +because of a `throw' or error, the PLACEs are set back to their original +values. Note that this macro is *not* available in Common Lisp. +As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', +the PLACE is not modified before executing BODY. + +\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) + +(autoload (quote callf) "cl-macs" "\ +Set PLACE to (FUNC PLACE ARGS...). +FUNC should be an unquoted function name. PLACE may be a symbol, +or any generalized variable allowed by `setf'. + +\(fn FUNC PLACE ARGS...)" nil (quote macro)) + +(autoload (quote callf2) "cl-macs" "\ +Set PLACE to (FUNC ARG1 PLACE ARGS...). +Like `callf', but PLACE is the second argument of FUNC, not the first. + +\(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro)) + +(autoload (quote define-modify-macro) "cl-macs" "\ +Define a `setf'-like modify macro. +If NAME is called, it combines its PLACE argument with the other arguments +from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +) + +\(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro)) + +(autoload (quote defstruct) "cl-macs" "\ +Define a struct type. +This macro defines a new Lisp data type called NAME, which contains data +stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' +copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. + +\(fn (NAME OPTIONS...) (SLOT SLOT-OPTS...)...)" nil (quote macro)) + +(autoload (quote cl-struct-setf-expander) "cl-macs" "\ +Not documented + +\(fn X NAME ACCESSOR PRED-FORM POS)" nil nil) + +(autoload (quote typep) "cl-macs" "\ +Check that OBJECT is of type TYPE. +TYPE is a Common Lisp-style type specifier. + +\(fn OBJECT TYPE)" nil nil) + +(autoload (quote check-type) "cl-macs" "\ +Verify that FORM is of type TYPE; signal an error if not. +STRING is an optional description of the desired type. + +\(fn FORM TYPE &optional STRING)" nil (quote macro)) + +(autoload (quote assert) "cl-macs" "\ +Verify that FORM returns non-nil; signal an error if not. +Second arg SHOW-ARGS means to include arguments of FORM in message. +Other args STRING and ARGS... are arguments to be passed to `error'. +They are not evaluated unless the assertion fails. If STRING is +omitted, a default message listing FORM itself is used. + +\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro)) + +(autoload (quote ignore-errors) "cl-macs" "\ +Execute BODY; if an error occurs, return nil. +Otherwise, return result of last form in BODY. + +\(fn &rest BODY)" nil (quote macro)) + +(autoload (quote define-compiler-macro) "cl-macs" "\ +Define a compiler-only macro. +This is like `defmacro', but macro expansion occurs only if the call to +FUNC is compiled (i.e., not interpreted). Compiler macros should be used +for optimizing the way calls to FUNC are compiled; the form returned by +BODY should do the same thing as a call to the normal function called +FUNC, though possibly more efficiently. Note that, like regular macros, +compiler macros are expanded repeatedly until no further expansions are +possible. Unlike regular macros, BODY can decide to \"punt\" and leave the +original function call alone by declaring an initial `&whole foo' parameter +and then returning foo. + +\(fn FUNC ARGS &rest BODY)" nil (quote macro)) + +(autoload (quote compiler-macroexpand) "cl-macs" "\ +Not documented + +\(fn FORM)" nil nil) + +;;;*** + +;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if +;;;;;; nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or +;;;;;; nset-difference set-difference nintersection intersection +;;;;;; nunion union rassoc-if-not rassoc-if rassoc* assoc-if-not +;;;;;; assoc-if assoc* cl-adjoin member-if-not member-if member* +;;;;;; merge stable-sort sort* search mismatch count-if-not count-if +;;;;;; count position-if-not position-if position find-if-not find-if +;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not +;;;;;; substitute-if substitute delete-duplicates remove-duplicates +;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" (18050 45841)) +;;; Generated autoloads from cl-seq.el + +(autoload (quote reduce) "cl-seq" "\ +Reduce two-argument FUNCTION across SEQ. + +Keywords supported: :start :end :from-end :initial-value :key + +\(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote fill) "cl-seq" "\ +Fill the elements of SEQ with ITEM. + +Keywords supported: :start :end + +\(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil) + +(autoload (quote replace) "cl-seq" "\ +Replace the elements of SEQ1 with the elements of SEQ2. +SEQ1 is destructively modified, then returned. + +Keywords supported: :start1 :end1 :start2 :end2 + +\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote remove*) "cl-seq" "\ +Remove all occurrences of ITEM in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :test :test-not :key :count :start :end :from-end + +\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote remove-if) "cl-seq" "\ +Remove all items satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :key :count :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote remove-if-not) "cl-seq" "\ +Remove all items not satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :key :count :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote delete*) "cl-seq" "\ +Remove all occurrences of ITEM in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :test :test-not :key :count :start :end :from-end + +\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote delete-if) "cl-seq" "\ +Remove all items satisfying PREDICATE in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :key :count :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote delete-if-not) "cl-seq" "\ +Remove all items not satisfying PREDICATE in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :key :count :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote remove-duplicates) "cl-seq" "\ +Return a copy of SEQ with all duplicate elements removed. + +Keywords supported: :test :test-not :key :start :end :from-end + +\(fn SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote delete-duplicates) "cl-seq" "\ +Remove all duplicate elements from SEQ (destructively). + +Keywords supported: :test :test-not :key :start :end :from-end + +\(fn SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote substitute) "cl-seq" "\ +Substitute NEW for OLD in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :test :test-not :key :count :start :end :from-end + +\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote substitute-if) "cl-seq" "\ +Substitute NEW for all items satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :key :count :start :end :from-end + +\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote substitute-if-not) "cl-seq" "\ +Substitute NEW for all items not satisfying PREDICATE in SEQ. +This is a non-destructive function; it makes a copy of SEQ if necessary +to avoid corrupting the original SEQ. + +Keywords supported: :key :count :start :end :from-end + +\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubstitute) "cl-seq" "\ +Substitute NEW for OLD in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :test :test-not :key :count :start :end :from-end + +\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubstitute-if) "cl-seq" "\ +Substitute NEW for all items satisfying PREDICATE in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :key :count :start :end :from-end + +\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubstitute-if-not) "cl-seq" "\ +Substitute NEW for all items not satisfying PREDICATE in SEQ. +This is a destructive function; it reuses the storage of SEQ whenever possible. + +Keywords supported: :key :count :start :end :from-end + +\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote find) "cl-seq" "\ +Find the first occurrence of ITEM in SEQ. +Return the matching ITEM, or nil if not found. + +Keywords supported: :test :test-not :key :start :end :from-end + +\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote find-if) "cl-seq" "\ +Find the first item satisfying PREDICATE in SEQ. +Return the matching item, or nil if not found. + +Keywords supported: :key :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote find-if-not) "cl-seq" "\ +Find the first item not satisfying PREDICATE in SEQ. +Return the matching item, or nil if not found. + +Keywords supported: :key :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote position) "cl-seq" "\ +Find the first occurrence of ITEM in SEQ. +Return the index of the matching item, or nil if not found. + +Keywords supported: :test :test-not :key :start :end :from-end + +\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote position-if) "cl-seq" "\ +Find the first item satisfying PREDICATE in SEQ. +Return the index of the matching item, or nil if not found. + +Keywords supported: :key :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote position-if-not) "cl-seq" "\ +Find the first item not satisfying PREDICATE in SEQ. +Return the index of the matching item, or nil if not found. + +Keywords supported: :key :start :end :from-end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote count) "cl-seq" "\ +Count the number of occurrences of ITEM in SEQ. + +Keywords supported: :test :test-not :key :start :end + +\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote count-if) "cl-seq" "\ +Count the number of items satisfying PREDICATE in SEQ. + +Keywords supported: :key :start :end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote count-if-not) "cl-seq" "\ +Count the number of items not satisfying PREDICATE in SEQ. + +Keywords supported: :key :start :end + +\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) + +(autoload (quote mismatch) "cl-seq" "\ +Compare SEQ1 with SEQ2, return index of first mismatching element. +Return nil if the sequences match. If one sequence is a prefix of the +other, the return value indicates the end of the shorter sequence. + +Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end + +\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote search) "cl-seq" "\ +Search for SEQ1 as a subsequence of SEQ2. +Return the index of the leftmost element of the first match found; +return nil if there are no matches. + +Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end + +\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote sort*) "cl-seq" "\ +Sort the argument SEQ according to PREDICATE. +This is a destructive function; it reuses the storage of SEQ if possible. + +Keywords supported: :key + +\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote stable-sort) "cl-seq" "\ +Sort the argument SEQ stably according to PREDICATE. +This is a destructive function; it reuses the storage of SEQ if possible. + +Keywords supported: :key + +\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote merge) "cl-seq" "\ +Destructively merge the two sequences to produce a new sequence. +TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument +sequences, and PREDICATE is a `less-than' predicate on the elements. + +Keywords supported: :key + +\(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote member*) "cl-seq" "\ +Find the first occurrence of ITEM in LIST. +Return the sublist of LIST whose car is ITEM. + +Keywords supported: :test :test-not :key + +\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote member-if) "cl-seq" "\ +Find the first item satisfying PREDICATE in LIST. +Return the sublist of LIST whose car matches. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote member-if-not) "cl-seq" "\ +Find the first item not satisfying PREDICATE in LIST. +Return the sublist of LIST whose car matches. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote cl-adjoin) "cl-seq" "\ +Not documented + +\(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil) + +(autoload (quote assoc*) "cl-seq" "\ +Find the first item whose car matches ITEM in LIST. + +Keywords supported: :test :test-not :key + +\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote assoc-if) "cl-seq" "\ +Find the first item whose car satisfies PREDICATE in LIST. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote assoc-if-not) "cl-seq" "\ +Find the first item whose car does not satisfy PREDICATE in LIST. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote rassoc*) "cl-seq" "\ +Find the first item whose cdr matches ITEM in LIST. + +Keywords supported: :test :test-not :key + +\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote rassoc-if) "cl-seq" "\ +Find the first item whose cdr satisfies PREDICATE in LIST. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote rassoc-if-not) "cl-seq" "\ +Find the first item whose cdr does not satisfy PREDICATE in LIST. + +Keywords supported: :key + +\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) + +(autoload (quote union) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nunion) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-union operation. +The result list contains all items that appear in either LIST1 or LIST2. +This is a destructive function; it reuses the storage of LIST1 and LIST2 +whenever possible. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote intersection) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-intersection operation. +The result list contains all items that appear in both LIST1 and LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nintersection) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-intersection operation. +The result list contains all items that appear in both LIST1 and LIST2. +This is a destructive function; it reuses the storage of LIST1 and LIST2 +whenever possible. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote set-difference) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-difference operation. +The result list contains all items that appear in LIST1 but not LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nset-difference) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-difference operation. +The result list contains all items that appear in LIST1 but not LIST2. +This is a destructive function; it reuses the storage of LIST1 and LIST2 +whenever possible. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote set-exclusive-or) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-exclusive-or operation. +The result list contains all items that appear in exactly one of LIST1, LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nset-exclusive-or) "cl-seq" "\ +Combine LIST1 and LIST2 using a set-exclusive-or operation. +The result list contains all items that appear in exactly one of LIST1, LIST2. +This is a destructive function; it reuses the storage of LIST1 and LIST2 +whenever possible. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote subsetp) "cl-seq" "\ +Return true if LIST1 is a subset of LIST2. +I.e., if every element of LIST1 also appears in LIST2. + +Keywords supported: :test :test-not :key + +\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) + +(autoload (quote subst-if) "cl-seq" "\ +Substitute NEW for elements matching PREDICATE in TREE (non-destructively). +Return a copy of TREE with all matching elements replaced by NEW. + +Keywords supported: :key + +\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote subst-if-not) "cl-seq" "\ +Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). +Return a copy of TREE with all non-matching elements replaced by NEW. + +Keywords supported: :key + +\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubst) "cl-seq" "\ +Substitute NEW for OLD everywhere in TREE (destructively). +Any element of TREE which is `eql' to OLD is changed to NEW (via a call +to `setcar'). + +Keywords supported: :test :test-not :key + +\(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubst-if) "cl-seq" "\ +Substitute NEW for elements matching PREDICATE in TREE (destructively). +Any element of TREE which matches is changed to NEW (via a call to `setcar'). + +Keywords supported: :key + +\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsubst-if-not) "cl-seq" "\ +Substitute NEW for elements not matching PREDICATE in TREE (destructively). +Any element of TREE which matches is changed to NEW (via a call to `setcar'). + +Keywords supported: :key + +\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote sublis) "cl-seq" "\ +Perform substitutions indicated by ALIST in TREE (non-destructively). +Return a copy of TREE with all matching elements replaced. + +Keywords supported: :test :test-not :key + +\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote nsublis) "cl-seq" "\ +Perform substitutions indicated by ALIST in TREE (destructively). +Any matching element of TREE is changed via a call to `setcar'. + +Keywords supported: :test :test-not :key + +\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil) + +(autoload (quote tree-equal) "cl-seq" "\ +Return t if trees TREE1 and TREE2 have `eql' leaves. +Atoms are compared by `eql'; cons cells are compared recursively. + +Keywords supported: :test :test-not :key + +\(fn TREE1 TREE2 [KEYWORD VALUE]...)" nil nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: + +;; arch-tag: 08cc5aab-e992-47f6-992e-12a7428c1a0e +;;; cl-loaddefs.el ends here diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index a28e11055ed..49ec3273635 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -58,8 +58,8 @@ (defvar cl-optimize-speed) -;;; This kludge allows macros which use cl-transform-function-property -;;; to be called at compile-time. +;; This kludge allows macros which use cl-transform-function-property +;; to be called at compile-time. (require (progn @@ -75,6 +75,7 @@ (defvar cl-old-bc-file-form nil) +;;;###autoload (defun cl-compile-time-init () (run-hooks 'cl-hack-bytecomp-hook)) @@ -165,6 +166,7 @@ ;;; Symbols. (defvar *gensym-counter*) +;;;###autoload (defun gensym (&optional prefix) "Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\"." @@ -174,6 +176,7 @@ The name is made by appending a number to PREFIX, default \"G\"." (setq *gensym-counter* (1+ *gensym-counter*)))))) (make-symbol (format "%s%d" pfix num)))) +;;;###autoload (defun gentemp (&optional prefix) "Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\"." @@ -186,6 +189,7 @@ The name is made by appending a number to PREFIX, default \"G\"." ;;; Program structure. +;;;###autoload (defmacro defun* (name args &rest body) "Define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, @@ -196,6 +200,7 @@ and BODY is implicitly surrounded by (block NAME ...). (form (list* 'defun name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) +;;;###autoload (defmacro defmacro* (name args &rest body) "Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, @@ -206,6 +211,7 @@ and BODY is implicitly surrounded by (block NAME ...). (form (list* 'defmacro name (cdr res)))) (if (car res) (list 'progn (car res) form) form))) +;;;###autoload (defmacro function* (func) "Introduce a function. Like normal `function', except that if argument is a lambda form, @@ -422,6 +428,7 @@ its argument list allows full Common Lisp conventions." (setq res (nconc res (cl-arglist-args arg)))))) (nconc res (and args (list args)))))) +;;;###autoload (defmacro destructuring-bind (args expr &rest body) (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) (bind-defs nil) (bind-block 'cl-none)) @@ -435,6 +442,7 @@ its argument list allows full Common Lisp conventions." (defvar cl-not-toplevel nil) +;;;###autoload (defmacro eval-when (when &rest body) "Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. @@ -466,6 +474,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. form))) (t (eval form) form))) +;;;###autoload (defmacro load-time-value (form &optional read-only) "Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant." @@ -488,6 +497,7 @@ The result of the body appears to the compiler as a quoted constant." ;;; Conditional control structures. +;;;###autoload (defmacro case (expr &rest clauses) "Eval EXPR and choose among clauses on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared @@ -522,12 +532,14 @@ Key values are compared by `eql'. (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) +;;;###autoload (defmacro ecase (expr &rest clauses) "Like `case', but error if no case fits. `otherwise'-clauses are not allowed. \n(fn EXPR (KEYLIST BODY...)...)" (list* 'case expr (append clauses '((ecase-error-flag))))) +;;;###autoload (defmacro typecase (expr &rest clauses) "Evals EXPR, chooses among clauses on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it @@ -554,6 +566,7 @@ final clause, and matches if no other keys match. (if (eq temp expr) body (list 'let (list (list temp expr)) body)))) +;;;###autoload (defmacro etypecase (expr &rest clauses) "Like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. @@ -563,6 +576,7 @@ final clause, and matches if no other keys match. ;;; Blocks and exits. +;;;###autoload (defmacro block (name &rest body) "Define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' @@ -598,11 +612,13 @@ called from BODY." (if cl-found (setcdr cl-found t))) (byte-compile-normal-call (cons 'throw (cdr cl-form)))) +;;;###autoload (defmacro return (&optional result) "Return from the block named nil. This is equivalent to `(return-from nil RESULT)'." (list 'return-from nil result)) +;;;###autoload (defmacro return-from (name &optional result) "Return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, @@ -622,6 +638,7 @@ This is compatible with Common Lisp, but note that `defun' and (defvar loop-result) (defvar loop-result-explicit) (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) +;;;###autoload (defmacro loop (&rest args) "The Common Lisp `loop' macro. Valid clauses are: @@ -1181,12 +1198,14 @@ Valid clauses are: ;;; Other iteration control structures. +;;;###autoload (defmacro do (steps endtest &rest body) "The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (cl-expand-do-loop steps endtest body nil)) +;;;###autoload (defmacro do* (steps endtest &rest body) "The Common Lisp `do*' loop. @@ -1214,6 +1233,7 @@ Valid clauses are: (apply 'append sets))))))) (or (cdr endtest) '(nil))))) +;;;###autoload (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. @@ -1230,6 +1250,7 @@ Then evaluate RESULT to get return value, default nil. (cons (list 'setq (car spec) nil) (cdr (cdr spec))) '(nil)))))) +;;;###autoload (defmacro dotimes (spec &rest body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, @@ -1244,6 +1265,7 @@ nil. (append body (list (list 'incf (car spec))))) (or (cdr (cdr spec)) '(nil)))))) +;;;###autoload (defmacro do-symbols (spec &rest body) "Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol @@ -1258,12 +1280,14 @@ from OBARRAY. (and (cadr spec) (list (cadr spec)))) (caddr spec)))) +;;;###autoload (defmacro do-all-symbols (spec &rest body) (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) ;;; Assignments. +;;;###autoload (defmacro psetq (&rest args) "Set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) @@ -1275,6 +1299,7 @@ before assigning any symbols SYM to the corresponding values. ;;; Binding control structures. +;;;###autoload (defmacro progv (symbols values &rest body) "Bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. @@ -1288,6 +1313,7 @@ a `let' form, except that the list of symbols can be computed at run-time." '(cl-progv-after)))) ;;; This should really have some way to shadow 'byte-compile properties, etc. +;;;###autoload (defmacro flet (bindings &rest body) "Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC @@ -1315,6 +1341,7 @@ go back to their previous definitions, or lack thereof). bindings) body)) +;;;###autoload (defmacro labels (bindings &rest body) "Make temporary function bindings. This is like `flet', except the bindings are lexical instead of dynamic. @@ -1339,6 +1366,7 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. ;; The following ought to have a better definition for use with newer ;; byte compilers. +;;;###autoload (defmacro macrolet (bindings &rest body) "Make temporary macro definitions. This is like `flet', but for macros instead of functions. @@ -1355,6 +1383,7 @@ This is like `flet', but for macros instead of functions. (cons (list* name 'lambda (cdr res)) cl-macro-environment)))))) +;;;###autoload (defmacro symbol-macrolet (bindings &rest body) "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced @@ -1371,6 +1400,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). cl-macro-environment))))) (defvar cl-closure-vars nil) +;;;###autoload (defmacro lexical-let (bindings &rest body) "Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create @@ -1414,6 +1444,7 @@ lexical closures as in Common Lisp. vars)) ebody)))) +;;;###autoload (defmacro lexical-let* (bindings &rest body) "Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create @@ -1434,6 +1465,7 @@ lexical closures as in Common Lisp. ;;; Multiple values. +;;;###autoload (defmacro multiple-value-bind (vars form &rest body) "Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements @@ -1451,6 +1483,7 @@ a synonym for (list A B C). vars)) body))) +;;;###autoload (defmacro multiple-value-setq (vars form) "Collect multiple return values. FORM must return a list; the first N elements of this list are stored in @@ -1477,7 +1510,9 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). ;;; Declarations. +;;;###autoload (defmacro locally (&rest body) (cons 'progn body)) +;;;###autoload (defmacro the (type form) form) (defvar cl-proclaim-history t) ; for future compilers @@ -1532,6 +1567,7 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). (while p (cl-do-proclaim (pop p) t)) (setq cl-proclaims-deferred nil)) +;;;###autoload (defmacro declare (&rest specs) (if (cl-compiling-file) (while specs @@ -1543,6 +1579,7 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). ;;; Generalized variables. +;;;###autoload (defmacro define-setf-method (func args &rest body) "Define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). @@ -1561,8 +1598,9 @@ form. See `defsetf' for a simpler way to define most setf-methods. func 'setf-method (cons args body))))) (defalias 'define-setf-expander 'define-setf-method) +;;;###autoload (defmacro defsetf (func arg1 &rest args) - "(defsetf NAME FUNC): define a `setf' method. + "Define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of the form (setf (NAME ARGS...) VAL) are transformed to function or macro @@ -1836,6 +1874,7 @@ Example: (list 'substring (nth 4 method) from-temp to-temp)))) ;;; Getting and optimizing setf-methods. +;;;###autoload (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to @@ -1903,6 +1942,7 @@ a macro like `setf' or `incf'." (not (eq (car-safe (symbol-function (car form))) 'macro)))) ;;; The standard modify macros. +;;;###autoload (defmacro setf (&rest args) "Set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic @@ -1921,6 +1961,7 @@ The return value is the last VAL in the list. (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) (if (car method) (list 'let* (car method) store) store))))) +;;;###autoload (defmacro psetf (&rest args) "Set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) @@ -1944,6 +1985,7 @@ before assigning any PLACEs to the corresponding values. (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) (list 'progn expr nil))))) +;;;###autoload (defun cl-do-pop (place) (if (cl-simple-expr-p place) (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) @@ -1956,6 +1998,7 @@ before assigning any PLACEs to the corresponding values. (list 'car temp) (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) +;;;###autoload (defmacro remf (place tag) "Remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. @@ -1976,6 +2019,7 @@ The form returns true if TAG was found and removed, nil otherwise." t) (list 'cl-do-remf tval ttag))))) +;;;###autoload (defmacro shiftf (place &rest args) "Shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. @@ -1991,6 +2035,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (prog1 ,(nth 2 method) ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args)))))))) +;;;###autoload (defmacro rotatef (&rest args) "Rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. @@ -2016,6 +2061,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (list 'let* (append (car method) (list (list temp (nth 2 method)))) (cl-setf-do-store (nth 1 method) form) nil))))) +;;;###autoload (defmacro letf (bindings &rest body) "Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the @@ -2072,6 +2118,7 @@ the PLACE is not modified before executing BODY. rev (cdr rev)))) (list* 'let* lets body)))) +;;;###autoload (defmacro letf* (bindings &rest body) "Temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the @@ -2090,6 +2137,7 @@ the PLACE is not modified before executing BODY. (setq body (list (list* 'letf (list (pop bindings)) body)))) (car body))) +;;;###autoload (defmacro callf (func place &rest args) "Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, @@ -2104,6 +2152,7 @@ or any generalized variable allowed by `setf'. (list* 'funcall (list 'function func) rargs)))))) +;;;###autoload (defmacro callf2 (func arg1 place &rest args) "Set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. @@ -2120,6 +2169,7 @@ Like `callf', but PLACE is the second argument of FUNC, not the first. (list* 'funcall (list 'function func) rargs))))))) +;;;###autoload (defmacro define-modify-macro (name arglist func &optional doc) "Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments @@ -2134,6 +2184,7 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" ;;; Structures. +;;;###autoload (defmacro defstruct (struct &rest descs) "Define a struct type. This macro defines a new Lisp data type called NAME, which contains data @@ -2358,6 +2409,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. forms) (cons 'progn (nreverse (cons (list 'quote name) forms))))) +;;;###autoload (defun cl-struct-setf-expander (x name accessor pred-form pos) (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--"))) (list (list temp) (list x) (list store) @@ -2426,11 +2478,13 @@ The type name can then be used in `typecase', `check-type', etc." ((eq (car type) 'satisfies) (list (cadr type) val)) (t (error "Bad type spec: %s" type))))) +;;;###autoload (defun typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." (eval (cl-make-type-test 'object type))) +;;;###autoload (defmacro check-type (form type &optional string) "Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type." @@ -2445,6 +2499,7 @@ STRING is an optional description of the desired type." (if (eq temp form) (list 'progn body nil) (list 'let (list (list temp form)) body nil))))) +;;;###autoload (defmacro assert (form &optional show-args string &rest args) "Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. @@ -2466,6 +2521,7 @@ omitted, a default message listing FORM itself is used." (list* 'list (list 'quote form) sargs)))) nil)))) +;;;###autoload (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. Otherwise, return result of last form in BODY." @@ -2474,6 +2530,7 @@ Otherwise, return result of last form in BODY." ;;; Compiler macros. +;;;###autoload (defmacro define-compiler-macro (func args &rest body) "Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to @@ -2497,6 +2554,7 @@ and then returning foo." (list 'put (list 'quote func) '(quote byte-compile) '(quote cl-byte-compile-compiler-macro))))) +;;;###autoload (defun compiler-macroexpand (form) (while (let ((func (car-safe form)) (handler nil)) @@ -2552,9 +2610,9 @@ surrounded by (block NAME ...). (if lets (list 'let lets body) body)))) -;;; Compile-time optimizations for some functions defined in this package. -;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, -;;; mainly to make sure these macros will be present. +;; Compile-time optimizations for some functions defined in this package. +;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, +;; mainly to make sure these macros will be present. (put 'eql 'byte-compile nil) (define-compiler-macro eql (&whole form a b) @@ -2665,9 +2723,10 @@ surrounded by (block NAME ...). (run-hooks 'cl-macs-load-hook) -;;; Local variables: -;;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime) -;;; End: +;; Local variables: +;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime) +;; 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/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 0027da1f9d2..742d2af2397 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -125,6 +125,7 @@ (defvar cl-key) +;;;###autoload (defun reduce (cl-func cl-seq &rest cl-keys) "Reduce two-argument FUNCTION across SEQ. \nKeywords supported: :start :end :from-end :initial-value :key @@ -145,6 +146,7 @@ (cl-check-key (pop cl-seq)))))) cl-accum))) +;;;###autoload (defun fill (seq item &rest cl-keys) "Fill the elements of SEQ with ITEM. \nKeywords supported: :start :end @@ -164,6 +166,7 @@ (setq cl-start (1+ cl-start))))) seq)) +;;;###autoload (defun replace (cl-seq1 cl-seq2 &rest cl-keys) "Replace the elements of SEQ1 with the elements of SEQ2. SEQ1 is destructively modified, then returned. @@ -206,6 +209,7 @@ SEQ1 is destructively modified, then returned. (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) cl-seq1)) +;;;###autoload (defun remove* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -251,6 +255,7 @@ to avoid corrupting the original SEQ. cl-seq)) cl-seq))))) +;;;###autoload (defun remove-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -259,6 +264,7 @@ to avoid corrupting the original SEQ. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'remove* nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun remove-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -267,6 +273,7 @@ to avoid corrupting the original SEQ. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun delete* (cl-item cl-seq &rest cl-keys) "Remove all occurrences of ITEM in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -310,6 +317,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. cl-seq) (apply 'remove* cl-item cl-seq cl-keys))))) +;;;###autoload (defun delete-if (cl-pred cl-list &rest cl-keys) "Remove all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -317,6 +325,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'delete* nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun delete-if-not (cl-pred cl-list &rest cl-keys) "Remove all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -324,12 +333,14 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun remove-duplicates (cl-seq &rest cl-keys) "Return a copy of SEQ with all duplicate elements removed. \nKeywords supported: :test :test-not :key :start :end :from-end \n(fn SEQ [KEYWORD VALUE]...)" (cl-delete-duplicates cl-seq cl-keys t)) +;;;###autoload (defun delete-duplicates (cl-seq &rest cl-keys) "Remove all duplicate elements from SEQ (destructively). \nKeywords supported: :test :test-not :key :start :end :from-end @@ -376,6 +387,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) +;;;###autoload (defun substitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -397,6 +409,7 @@ to avoid corrupting the original SEQ. (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) +;;;###autoload (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -405,6 +418,7 @@ to avoid corrupting the original SEQ. \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a non-destructive function; it makes a copy of SEQ if necessary @@ -413,6 +427,7 @@ to avoid corrupting the original SEQ. \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) "Substitute NEW for OLD in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -446,6 +461,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (setq cl-start (1+ cl-start)))))) cl-seq)) +;;;###autoload (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -453,6 +469,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) "Substitute NEW for all items not satisfying PREDICATE in SEQ. This is a destructive function; it reuses the storage of SEQ whenever possible. @@ -460,6 +477,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun find (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in SEQ. Return the matching ITEM, or nil if not found. @@ -468,6 +486,7 @@ Return the matching ITEM, or nil if not found. (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) (and cl-pos (elt cl-seq cl-pos)))) +;;;###autoload (defun find-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in SEQ. Return the matching item, or nil if not found. @@ -475,6 +494,7 @@ Return the matching item, or nil if not found. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'find nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun find-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in SEQ. Return the matching item, or nil if not found. @@ -482,6 +502,7 @@ Return the matching item, or nil if not found. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'find nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun position (cl-item cl-seq &rest cl-keys) "Find the first occurrence of ITEM in SEQ. Return the index of the matching item, or nil if not found. @@ -512,6 +533,7 @@ Return the index of the matching item, or nil if not found. (setq cl-start (1+ cl-start))) (and (< cl-start cl-end) cl-start)))) +;;;###autoload (defun position-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in SEQ. Return the index of the matching item, or nil if not found. @@ -519,6 +541,7 @@ Return the index of the matching item, or nil if not found. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'position nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun position-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in SEQ. Return the index of the matching item, or nil if not found. @@ -526,6 +549,7 @@ Return the index of the matching item, or nil if not found. \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'position nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun count (cl-item cl-seq &rest cl-keys) "Count the number of occurrences of ITEM in SEQ. \nKeywords supported: :test :test-not :key :start :end @@ -540,18 +564,21 @@ Return the index of the matching item, or nil if not found. (setq cl-start (1+ cl-start))) cl-count))) +;;;###autoload (defun count-if (cl-pred cl-list &rest cl-keys) "Count the number of items satisfying PREDICATE in SEQ. \nKeywords supported: :key :start :end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'count nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun count-if-not (cl-pred cl-list &rest cl-keys) "Count the number of items not satisfying PREDICATE in SEQ. \nKeywords supported: :key :start :end \n(fn PREDICATE SEQ [KEYWORD VALUE]...)" (apply 'count nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) "Compare SEQ1 with SEQ2, return index of first mismatching element. Return nil if the sequences match. If one sequence is a prefix of the @@ -582,6 +609,7 @@ other, the return value indicates the end of the shorter sequence. (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) cl-start1))))) +;;;###autoload (defun search (cl-seq1 cl-seq2 &rest cl-keys) "Search for SEQ1 as a subsequence of SEQ2. Return the index of the leftmost element of the first match found; @@ -608,6 +636,7 @@ return nil if there are no matches. (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) (and (< cl-start2 cl-end2) cl-pos))))) +;;;###autoload (defun sort* (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQ according to PREDICATE. This is a destructive function; it reuses the storage of SEQ if possible. @@ -622,6 +651,7 @@ This is a destructive function; it reuses the storage of SEQ if possible. (funcall cl-pred (funcall cl-key cl-x) (funcall cl-key cl-y))))))))) +;;;###autoload (defun stable-sort (cl-seq cl-pred &rest cl-keys) "Sort the argument SEQ stably according to PREDICATE. This is a destructive function; it reuses the storage of SEQ if possible. @@ -629,6 +659,7 @@ This is a destructive function; it reuses the storage of SEQ if possible. \n(fn SEQ PREDICATE [KEYWORD VALUE]...)" (apply 'sort* cl-seq cl-pred cl-keys)) +;;;###autoload (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) "Destructively merge the two sequences to produce a new sequence. TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument @@ -647,6 +678,7 @@ sequences, and PREDICATE is a `less-than' predicate on the elements. (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) ;;; See compiler macro in cl-macs.el +;;;###autoload (defun member* (cl-item cl-list &rest cl-keys) "Find the first occurrence of ITEM in LIST. Return the sublist of LIST whose car is ITEM. @@ -661,6 +693,7 @@ Return the sublist of LIST whose car is ITEM. (member cl-item cl-list) (memq cl-item cl-list)))) +;;;###autoload (defun member-if (cl-pred cl-list &rest cl-keys) "Find the first item satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. @@ -668,6 +701,7 @@ Return the sublist of LIST whose car matches. \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'member* nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun member-if-not (cl-pred cl-list &rest cl-keys) "Find the first item not satisfying PREDICATE in LIST. Return the sublist of LIST whose car matches. @@ -675,6 +709,7 @@ Return the sublist of LIST whose car matches. \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'member* nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun cl-adjoin (cl-item cl-list &rest cl-keys) (if (cl-parsing-keywords (:key) t (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) @@ -682,6 +717,7 @@ Return the sublist of LIST whose car matches. (cons cl-item cl-list))) ;;; See compiler macro in cl-macs.el +;;;###autoload (defun assoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose car matches ITEM in LIST. \nKeywords supported: :test :test-not :key @@ -697,18 +733,21 @@ Return the sublist of LIST whose car matches. (assoc cl-item cl-alist) (assq cl-item cl-alist)))) +;;;###autoload (defun assoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose car satisfies PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'assoc* nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun assoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose car does not satisfy PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun rassoc* (cl-item cl-alist &rest cl-keys) "Find the first item whose cdr matches ITEM in LIST. \nKeywords supported: :test :test-not :key @@ -722,18 +761,21 @@ Return the sublist of LIST whose car matches. (and cl-alist (car cl-alist))) (rassq cl-item cl-alist))) +;;;###autoload (defun rassoc-if (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr satisfies PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) +;;;###autoload (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) "Find the first item whose cdr does not satisfy PREDICATE in LIST. \nKeywords supported: :key \n(fn PREDICATE LIST [KEYWORD VALUE]...)" (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) +;;;###autoload (defun union (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. @@ -754,6 +796,7 @@ to avoid corrupting the original LIST1 and LIST2. (pop cl-list2)) cl-list1))) +;;;###autoload (defun nunion (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. The result list contains all items that appear in either LIST1 or LIST2. @@ -764,6 +807,7 @@ whenever possible. (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) (t (apply 'union cl-list1 cl-list2 cl-keys)))) +;;;###autoload (defun intersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. @@ -786,6 +830,7 @@ to avoid corrupting the original LIST1 and LIST2. (pop cl-list2)) cl-res))))) +;;;###autoload (defun nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. The result list contains all items that appear in both LIST1 and LIST2. @@ -795,6 +840,7 @@ whenever possible. \n(fn LIST1 LIST2 [KEYWORD VALUE]...)" (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) +;;;###autoload (defun set-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. @@ -814,6 +860,7 @@ to avoid corrupting the original LIST1 and LIST2. (pop cl-list1)) cl-res)))) +;;;###autoload (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. The result list contains all items that appear in LIST1 but not LIST2. @@ -824,6 +871,7 @@ whenever possible. (if (or (null cl-list1) (null cl-list2)) cl-list1 (apply 'set-difference cl-list1 cl-list2 cl-keys))) +;;;###autoload (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. @@ -836,6 +884,7 @@ to avoid corrupting the original LIST1 and LIST2. (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) (apply 'set-difference cl-list2 cl-list1 cl-keys))))) +;;;###autoload (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. The result list contains all items that appear in exactly one of LIST1, LIST2. @@ -848,6 +897,7 @@ whenever possible. (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) +;;;###autoload (defun subsetp (cl-list1 cl-list2 &rest cl-keys) "Return true if LIST1 is a subset of LIST2. I.e., if every element of LIST1 also appears in LIST2. @@ -862,6 +912,7 @@ I.e., if every element of LIST1 also appears in LIST2. (pop cl-list1)) (null cl-list1))))) +;;;###autoload (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all matching elements replaced by NEW. @@ -869,6 +920,7 @@ Return a copy of TREE with all matching elements replaced by NEW. \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) +;;;###autoload (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). Return a copy of TREE with all non-matching elements replaced by NEW. @@ -876,6 +928,7 @@ Return a copy of TREE with all non-matching elements replaced by NEW. \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) +;;;###autoload (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) "Substitute NEW for OLD everywhere in TREE (destructively). Any element of TREE which is `eql' to OLD is changed to NEW (via a call @@ -884,6 +937,7 @@ to `setcar'). \n(fn NEW OLD TREE [KEYWORD VALUE]...)" (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) +;;;###autoload (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). @@ -891,6 +945,7 @@ Any element of TREE which matches is changed to NEW (via a call to `setcar'). \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) +;;;###autoload (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) "Substitute NEW for elements not matching PREDICATE in TREE (destructively). Any element of TREE which matches is changed to NEW (via a call to `setcar'). @@ -898,6 +953,7 @@ Any element of TREE which matches is changed to NEW (via a call to `setcar'). \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) +;;;###autoload (defun sublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (non-destructively). Return a copy of TREE with all matching elements replaced. @@ -920,6 +976,7 @@ Return a copy of TREE with all matching elements replaced. (cons cl-a cl-d))) cl-tree)))) +;;;###autoload (defun nsublis (cl-alist cl-tree &rest cl-keys) "Perform substitutions indicated by ALIST in TREE (destructively). Any matching element of TREE is changed via a call to `setcar'. @@ -944,6 +1001,7 @@ Any matching element of TREE is changed via a call to `setcar'. (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) (setq cl-tree (cdr cl-tree)))))) +;;;###autoload (defun tree-equal (cl-x cl-y &rest cl-keys) "Return t if trees TREE1 and TREE2 have `eql' leaves. Atoms are compared by `eql'; cons cells are compared recursively. @@ -961,5 +1019,9 @@ Atoms are compared by `eql'; cons cells are compared recursively. (run-hooks 'cl-seq-load-hook) -;;; arch-tag: ec1cc072-9006-4225-b6ba-d6b07ed1710c +;; Local variables: +;; generated-autoload-file: "cl-loaddefs.el" +;; End: + +;; arch-tag: ec1cc072-9006-4225-b6ba-d6b07ed1710c ;;; cl-seq.el ends here diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 83dffb41b2d..233df65ac91 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -113,8 +113,9 @@ a future Emacs interpreter will be able to use it.") (defun cl-cannot-unload () (error "Cannot unload the feature `cl'")) -;;; Generalized variables. These macros are defined here so that they -;;; can safely be used in .emacs files. +;;; Generalized variables. +;; These macros are defined here so that they +;; can safely be used in .emacs files. (defmacro incf (place &optional x) "Increment PLACE by X (1 by default). @@ -185,8 +186,8 @@ an element already on the list. ;;; Control structures. -;;; These macros are so simple and so often-used that it's better to have -;;; them all the time than to load them from cl-macs.el. +;; These macros are so simple and so often-used that it's better to have +;; them all the time than to load them from cl-macs.el. (defun cl-map-extents (&rest cl-args) (apply 'cl-map-overlays cl-args)) @@ -198,9 +199,10 @@ an element already on the list. (defalias 'cl-block-throw 'throw) -;;; Multiple values. True multiple values are not supported, or even -;;; simulated. Instead, multiple-value-bind and friends simply expect -;;; the target form to return the values as a list. +;;; Multiple values. +;; True multiple values are not supported, or even +;; simulated. Instead, multiple-value-bind and friends simply expect +;; the target form to return the values as a list. (defsubst values (&rest values) "Return multiple values, Common Lisp style. @@ -321,7 +323,7 @@ always returns nil." (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) -;;; The following are actually set by cl-float-limits. +;; The following are actually set by cl-float-limits. (defconst most-positive-float nil) (defconst most-negative-float nil) (defconst least-positive-float nil) @@ -585,105 +587,55 @@ If ALIST is non-nil, the new pairs are prepended to it." ;;; Miscellaneous. -(defvar cl-fake-autoloads nil - "Non-nil means don't make CL functions autoload.") - -;;; Autoload the other portions of the package. +;; Define data for indentation and edebug. +(dolist (entry + '(((defun* defmacro*) 2) + ((function*) nil + (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) + ((eval-when) 1 (sexp &rest form)) + ((declare) nil (&rest sexp)) + ((the) 1 (sexp &rest form)) + ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) + ((block return-from) 1 (sexp &rest form)) + ((return) nil (&optional form)) + ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) + (form &rest form) + &rest form)) + ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) + ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) + ((psetq setf psetf) nil edebug-setq-form) + ((progv) 2 (&rest form)) + ((flet labels macrolet) 1 + ((&rest (sexp sexp &rest form)) &rest form)) + ((symbol-macrolet lexical-let lexical-let*) 1 + ((&rest &or symbolp (symbolp form)) &rest form)) + ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) + ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) + ((incf decf remf pushnew shiftf rotatef) nil (&rest form)) + ((letf letf*) 1 ((&rest (&rest form)) &rest form)) + ((callf destructuring-bind) 2 (sexp form &rest form)) + ((callf2) 3 (sexp form form &rest form)) + ((loop) nil (&rest &or symbolp form)) + ((ignore-errors) 0 (&rest form)))) + (dolist (func (car entry)) + (put func 'lisp-indent-function (nth 1 entry)) + (put func 'lisp-indent-hook (nth 1 entry)) + (or (get func 'edebug-form-spec) + (put func 'edebug-form-spec (nth 2 entry))))) + +;; Autoload the other portions of the package. ;; We want to replace the basic versions of dolist, dotimes, declare below. (fmakunbound 'dolist) (fmakunbound 'dotimes) (fmakunbound 'declare) -(mapcar (function - (lambda (set) - (let ((file (if cl-fake-autoloads "<none>" (car set)))) - (mapcar (function - (lambda (func) - (autoload func (car set) nil nil (nth 1 set)))) - (cddr set))))) - '(("cl-extra" nil - coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon - cl-map-keymap cl-map-keymap-recursively cl-map-intervals - cl-map-overlays cl-set-frame-visible-p cl-float-limits - gcd lcm isqrt floor* ceiling* truncate* round* - mod* rem* signum random* make-random-state random-state-p - subseq concatenate cl-mapcar-many map some every notany - notevery revappend nreconc list-length tailp copy-tree get* getf - cl-set-getf cl-do-remf remprop cl-make-hash-table cl-hash-lookup - cl-gethash cl-puthash cl-remhash cl-clrhash cl-maphash cl-hash-table-p - cl-hash-table-count cl-progv-before cl-prettyexpand - cl-macroexpand-all) - ("cl-seq" nil - reduce fill replace remove* remove-if remove-if-not - delete* delete-if delete-if-not remove-duplicates - delete-duplicates substitute substitute-if substitute-if-not - nsubstitute nsubstitute-if nsubstitute-if-not find find-if - find-if-not position position-if position-if-not count count-if - count-if-not mismatch search sort* stable-sort merge member* - member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not - rassoc* rassoc-if rassoc-if-not union nunion intersection - nintersection set-difference nset-difference set-exclusive-or - nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if - nsubst-if-not sublis nsublis tree-equal) - ("cl-macs" nil - gensym gentemp typep cl-do-pop get-setf-method - cl-struct-setf-expander compiler-macroexpand cl-compile-time-init) - ("cl-macs" t - defun* defmacro* function* destructuring-bind eval-when - load-time-value case ecase typecase etypecase - block return return-from loop do do* dolist dotimes do-symbols - do-all-symbols psetq progv flet labels macrolet symbol-macrolet - lexical-let lexical-let* multiple-value-bind multiple-value-setq - locally the declare define-setf-method defsetf define-modify-macro - setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct - check-type assert ignore-errors define-compiler-macro))) - -;;; Define data for indentation and edebug. -(mapcar (function - (lambda (entry) - (mapcar (function - (lambda (func) - (put func 'lisp-indent-function (nth 1 entry)) - (put func 'lisp-indent-hook (nth 1 entry)) - (or (get func 'edebug-form-spec) - (put func 'edebug-form-spec (nth 2 entry))))) - (car entry)))) - '(((defun* defmacro*) 2) - ((function*) nil - (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) - ((eval-when) 1 (sexp &rest form)) - ((declare) nil (&rest sexp)) - ((the) 1 (sexp &rest form)) - ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) - ((block return-from) 1 (sexp &rest form)) - ((return) nil (&optional form)) - ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) - (form &rest form) - &rest form)) - ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) - ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) - ((psetq setf psetf) nil edebug-setq-form) - ((progv) 2 (&rest form)) - ((flet labels macrolet) 1 - ((&rest (sexp sexp &rest form)) &rest form)) - ((symbol-macrolet lexical-let lexical-let*) 1 - ((&rest &or symbolp (symbolp form)) &rest form)) - ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) - ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) - ((incf decf remf pushnew shiftf rotatef) nil (&rest form)) - ((letf letf*) 1 ((&rest (&rest form)) &rest form)) - ((callf destructuring-bind) 2 (sexp form &rest form)) - ((callf2) 3 (sexp form form &rest form)) - ((loop) nil (&rest &or symbolp form)) - ((ignore-errors) 0 (&rest form)))) - - -;;; This goes here so that cl-macs can find it if it loads right now. -(provide 'cl-19) ; usage: (require 'cl-19 "cl") +(load "cl-loaddefs") +;; This goes here so that cl-macs can find it if it loads right now. +(provide 'cl-19) ; usage: (require 'cl-19 "cl") -;;; Things to do after byte-compiler is loaded. -;;; As a side effect, we cause cl-macs to be loaded when compiling, so -;;; that the compiler-macros defined there will be present. +;; Things to do after byte-compiler is loaded. +;; As a side effect, we cause cl-macs to be loaded when compiling, so +;; that the compiler-macros defined there will be present. (defvar cl-hacked-flag nil) (defun cl-hack-byte-compiler () @@ -692,15 +644,15 @@ If ALIST is non-nil, the new pairs are prepended to it." (setq cl-hacked-flag t) ; Do it first, to prevent recursion. (cl-compile-time-init)))) ; In cl-macs.el. -;;; Try it now in case the compiler has already been loaded. +;; Try it now in case the compiler has already been loaded. (cl-hack-byte-compiler) -;;; Also make a hook in case compiler is loaded after this file. +;; Also make a hook in case compiler is loaded after this file. (add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler) -;;; The following ensures that packages which expect the old-style cl.el -;;; will be happy with this one. +;; The following ensures that packages which expect the old-style cl.el +;; will be happy with this one. (provide 'cl) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 164756dfdc3..73379a816d7 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -628,13 +628,13 @@ this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) (eval-last-sexp-1 eval-last-sexp-arg-internal) - (let ((old-value eval-last-sexp-fake-value) new-value value) - (let ((debug-on-error old-value)) - (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal)) - (setq new-value debug-on-error)) - (unless (eq old-value new-value) - (setq debug-on-error new-value)) - value))) + (let ((value + (let ((debug-on-error eval-last-sexp-fake-value)) + (cons (eval-last-sexp-1 eval-last-sexp-arg-internal) + debug-on-error)))) + (unless (eq (cdr value) eval-last-sexp-fake-value) + (setq debug-on-error (cdr value))) + (car value)))) (defun eval-defun-1 (form) "Treat some expressions specially. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 54f88ba3ea5..6caa77220bb 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -120,7 +120,7 @@ (| . or) ; SRE (not-newline . ".") (nonl . not-newline) ; SRE - (anything . ".\\|\n") + (anything . "\\(?:.\\|\n\\)") (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE (in . any) (char . any) ; sregex diff --git a/lisp/ffap.el b/lisp/ffap.el index 5bba729fce3..314d48e9ca8 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1793,7 +1793,11 @@ ffap most of the time." ;; Extra complication for the temporary highlighting. (unwind-protect (ffap-read-file-or-url - (if ffap-url-regexp "Dired file or URL: " "Dired file: ") + (cond + ((eq ffap-directory-finder 'list-directory) + "List directory (brief): ") + (ffap-url-regexp "Dired file or URL: ") + (t "Dired file: ")) (prog1 (setq guess (or guess (let ((guess (ffap-guesser))) diff --git a/lisp/files.el b/lisp/files.el index 952736f06d7..69ed54c5633 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1051,6 +1051,12 @@ Recursive uses of the minibuffer will not be affected." ,@body) (remove-hook 'minibuffer-setup-hook ,hook))))) +(defcustom find-file-confirm-nonexistent-file nil + "If non-nil, `find-file' requires confirmation before visiting a new file." + :group 'find-file + :version "23.1" + :type 'boolean) + (defun find-file-read-args (prompt mustmatch) (list (let ((find-file-default (and buffer-file-name @@ -1074,7 +1080,9 @@ suppress wildcard expansion by setting `find-file-wildcards' to nil. To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." - (interactive (find-file-read-args "Find file: " nil)) + (interactive + (find-file-read-args "Find file: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (mapcar 'switch-to-buffer (nreverse value)) @@ -1091,7 +1099,9 @@ type M-n to pull it into the minibuffer. Interactively, or if WILDCARDS is non-nil in a call from Lisp, expand wildcards (if any) and visit multiple files." - (interactive (find-file-read-args "Find file in other window: " nil)) + (interactive + (find-file-read-args "Find file in other window: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (progn @@ -1111,7 +1121,9 @@ type M-n to pull it into the minibuffer. Interactively, or if WILDCARDS is non-nil in a call from Lisp, expand wildcards (if any) and visit multiple files." - (interactive (find-file-read-args "Find file in other frame: " nil)) + (interactive + (find-file-read-args "Find file in other frame: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (progn @@ -1134,7 +1146,9 @@ file names with wildcards." "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only: " nil)) + (interactive + (find-file-read-args "Find file read-only: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -1149,7 +1163,9 @@ Use \\[toggle-read-only] to permit editing." "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other window: " nil)) + (interactive + (find-file-read-args "Find file read-only other window: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -1164,7 +1180,9 @@ Use \\[toggle-read-only] to permit editing." "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other frame: " nil)) + (interactive + (find-file-read-args "Find file read-only other frame: " + (if find-file-confirm-nonexistent-file 'confirm-only))) (unless (or (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) @@ -4021,6 +4039,8 @@ or multiple mail buffers, etc." (defun make-directory (dir &optional parents) "Create the directory DIR and any nonexistent parent dirs. +If DIR already exists as a directory, do nothing. + Interactively, the default choice of directory to create is the current default directory for file names. That is useful when you have visited a file in a nonexistent directory. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index bf01532c2e4..6f25ed9624d 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2288,7 +2288,7 @@ other modes in which C preprocessor directives are used. e.g. `asm-mode' and ;; that do not occur in strings. The associated regexp matches one ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to ;; avoid highlighting, for example, `\\(' in `\\\\('. - (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?:\\)?\\|[|)]\\)\\)" bound t) + (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t) (unless (match-beginning 2) (let ((face (get-text-property (1- (point)) 'face))) (when (or (and (listp face) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 3136889c250..b60c59c0f70 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -26,7 +26,7 @@ ;;; Commentary: ;; -;; This file contains a collection generic modes. +;; This file contains a collection of generic modes. ;; ;; INSTALLATION: ;; @@ -244,7 +244,7 @@ This hook will be installed if the variable (memq system-type '(windows-nt ms-dos)) "*Non-nil means the modes in `generic-mswindows-modes' will be defined. This is a list of MS-Windows specific generic modes. This variable -only effects the default value of `generic-extras-enable-list'." +only affects the default value of `generic-extras-enable-list'." :group 'generic-x :type 'boolean :version "22.1") @@ -254,7 +254,7 @@ only effects the default value of `generic-extras-enable-list'." (not (memq system-type '(windows-nt ms-dos))) "*Non-nil means the modes in `generic-unix-modes' will be defined. This is a list of Unix specific generic modes. This variable only -effects the default value of `generic-extras-enable-list'." +affects the default value of `generic-extras-enable-list'." :group 'generic-x :type 'boolean :version "22.1") @@ -317,7 +317,7 @@ your changes into effect." (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Mode for Apache log files")) + "Mode for Apache log files.")) ;;; Samba (when (memq 'samba-generic-mode generic-extras-enable-list) @@ -522,7 +522,7 @@ like an INI file. You can add this hook to `find-file-hook'." "Syntax table in use in `bat-generic-mode' buffers.") (defvar bat-generic-mode-keymap (make-sparse-keymap) - "Keymap for bet-generic-mode.") + "Keymap for `bat-generic-mode'.") (defun bat-generic-mode-compile () "Run the current BAT file in a compilation buffer." @@ -784,7 +784,7 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Mode for Java Manifest files")) + "Mode for Java Manifest files.")) ;; Java properties files (when (memq 'java-properties-generic-mode generic-extras-enable-list) @@ -1776,7 +1776,7 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces")) + "Generic mode to show tabs and trailing spaces.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes diff --git a/lisp/help-mode.el b/lisp/help-mode.el index f7c33d85286..075b893ad6f 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -487,7 +487,7 @@ that." ;; Skip a single blank line. (and (eolp) (forward-line)) (end-of-line) - (skip-chars-backward "^\t\n") + (skip-chars-backward "^ \t\n") (if (and (>= (current-column) col) (looking-at "\\(\\sw\\|-\\)+$")) (let ((sym (intern-soft (match-string 0)))) @@ -500,16 +500,19 @@ that." (while (and (not (bobp)) (bolp)) (delete-char -1)) (insert "\n") + (when (or help-xref-stack help-xref-forward-stack) + (insert "\n")) ;; Make a back-reference in this buffer if appropriate. (when help-xref-stack - (insert "\n") (help-insert-xref-button help-back-label 'help-back - (current-buffer)) - (insert "\t")) + (current-buffer))) ;; Make a forward-reference in this buffer if appropriate. (when help-xref-forward-stack + (when help-xref-stack + (insert "\t")) (help-insert-xref-button help-forward-label 'help-forward - (current-buffer)) + (current-buffer))) + (when (or help-xref-stack help-xref-forward-stack) (insert "\n"))) ;; View mode steals RET from us. (set (make-local-variable 'minor-mode-overriding-map-alist) diff --git a/lisp/ido.el b/lisp/ido.el index 5a7be3e5ae6..0808075b495 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3994,8 +3994,7 @@ For details of keybindings, see `ido-switch-buffer'." (defun ido-find-file-in-dir (dir) "Switch to another file starting from DIR." (interactive "DDir: ") - (if (not (equal (substring dir -1) "/")) - (setq dir (concat dir "/"))) + (setq dir (file-name-as-directory dir)) (ido-file-internal ido-default-file-method nil dir nil nil nil 'ignore)) ;;;###autoload diff --git a/lisp/log-edit.el b/lisp/log-edit.el index 8f63635ee49..b59a6a61a9b 100644 --- a/lisp/log-edit.el +++ b/lisp/log-edit.el @@ -590,25 +590,23 @@ The return value looks like this: (LOGBUFFER (ENTRYSTART . ENTRYEND) ...) where LOGBUFFER is the name of the ChangeLog buffer, and each \(ENTRYSTART . ENTRYEND\) pair is a buffer region." - (save-excursion - (let ((changelog-file-name - (let ((default-directory - (file-name-directory (expand-file-name file))) - (visiting-buffer (find-buffer-visiting file))) - ;; If there is a buffer visiting FILE, and it has a local - ;; value for `change-log-default-name', use that. - (if (and visiting-buffer - (local-variable-p 'change-log-default-name - visiting-buffer)) - (save-excursion - (set-buffer visiting-buffer) - change-log-default-name) - ;; `find-change-log' uses `change-log-default-name' if set - ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here - (setq change-log-default-name nil) - (find-change-log))))) - (set-buffer (find-file-noselect changelog-file-name)) + (let ((changelog-file-name + (let ((default-directory + (file-name-directory (expand-file-name file))) + (visiting-buffer (find-buffer-visiting file))) + ;; If there is a buffer visiting FILE, and it has a local + ;; value for `change-log-default-name', use that. + (if (and visiting-buffer + (local-variable-p 'change-log-default-name + visiting-buffer)) + (with-current-buffer visiting-buffer + change-log-default-name) + ;; `find-change-log' uses `change-log-default-name' if set + ;; and sets it before exiting, so we need to work around + ;; that memoizing which is undesired here + (setq change-log-default-name nil) + (find-change-log))))) + (with-current-buffer (find-file-noselect changelog-file-name) (unless (eq major-mode 'change-log-mode) (change-log-mode)) (goto-char (point-min)) (if (looking-at "\\s-*\n") (goto-char (match-end 0))) diff --git a/lisp/log-view.el b/lisp/log-view.el index bf029045a8c..0f2b8d77e13 100644 --- a/lisp/log-view.el +++ b/lisp/log-view.el @@ -105,6 +105,20 @@ ;; or a minor-mode-map with lower precedence than the local map. :inherit (if (boundp 'cvs-mode-map) cvs-mode-map)) +(easy-menu-define log-view-mode-menu log-view-mode-map + "Log-View Display Menu" + `("Log-View" + ;; XXX Do we need menu entries for these? + ;; ["Quit" quit-window] + ;; ["Kill This Buffer" kill-this-buffer] + ["Mark Log Entry for Diff" set-mark-command] + ["Diff Revisions" log-view-diff] + ["Visit Version" log-view-find-version] + ["Next Log Entry" log-view-msg-next] + ["Previous Log Entry" log-view-msg-prev] + ["Next File" log-view-file-next] + ["Previous File" log-view-file-prev])) + (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") @@ -128,13 +142,15 @@ (put 'log-view-message-face 'face-alias 'log-view-message) (defvar log-view-message-face 'log-view-message) -(defconst log-view-file-re +(defvar log-view-file-re (concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS. ;; Subversion has no such thing?? "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs. - "\\)\n")) ;Include the \n for font-lock reasons. + "\\)\n") ;Include the \n for font-lock reasons. + "Regexp matching the text identifying the file. +The match group number 1 should match the file name itself.") -(defconst log-view-message-re +(defvar log-view-message-re (concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS. "\\|r\\(?1:[0-9]+\\) | .* | .*" ; Subversion. "\\|D \\(?1:[.0-9]+\\) .*" ; SCCS. @@ -147,13 +163,17 @@ (concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]" ;;Email of user and finally Msg, used as revision name. " .*@.*\n\\(?: \\* \\(?1:.*\\)\\)?") - "\\)$")) - -(defconst log-view-font-lock-keywords - `((,log-view-file-re - (1 (if (boundp 'cvs-filename-face) cvs-filename-face)) - (0 log-view-file-face append)) - (,log-view-message-re . log-view-message-face))) + "\\)$") + "Regexp matching the text identifying a revision. +The match group number 1 should match the revision number itself.") + +(defvar log-view-font-lock-keywords + ;; We use `eval' so as to use the buffer-local value of log-view-file-re + ;; and log-view-message-re, if applicable. + '((eval . `(,log-view-file-re + (1 (if (boundp 'cvs-filename-face) cvs-filename-face)) + (0 log-view-file-face append))) + (eval . `(,log-view-message-re . log-view-message-face)))) (defconst log-view-font-lock-defaults '(log-view-font-lock-keywords t nil nil nil)) diff --git a/lisp/lpr.el b/lisp/lpr.el index c4eec3fa62b..9775abc74f9 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -140,9 +140,10 @@ See definition of `print-region-1' for calling conventions." ;; Berkeley systems support -F, and GNU pr supports both -f and -F, ;; So it looks like -F is a better default. -(defcustom lpr-page-header-switches '("-h %s" "-F") +(defcustom lpr-page-header-switches '("-h" "%s" "-F") "*List of strings to use as options for the page-header-generating program. -If `%s' appears in one of the strings, it is substituted by the page title. +If `%s' appears in any of the strings, it is substituted by the page title. +Note that for correct quoting, `%s' should normally be a separate element. The variable `lpr-page-header-program' specifies the program to use." :type '(repeat string) :group 'lpr) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 94c8004ff5e..b4cd485d7a0 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -216,6 +216,7 @@ that work are: A a c i r S s t u U X g G B C R and F partly." ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory)) + (orig-file file) wildcard-regexp) (if handler (funcall handler 'insert-directory file switches @@ -229,7 +230,10 @@ that work are: A a c i r S s t u U X g G B C R and F partly." ;; `ls' don't mind, we certainly do, because it makes us think ;; there is no wildcard, only a directory name. (if (and ls-lisp-support-shell-wildcards - (string-match "[[?*]" file)) + (string-match "[[?*]" file) + ;; Prefer an existing file to wildcards, like + ;; dired-noselect does. + (not (file-exists-p file))) (progn (or (not (eq (aref file (1- (length file))) ?/)) (setq file (substring file 0 (1- (length file))))) @@ -241,9 +245,21 @@ that work are: A a c i r S s t u U X g G B C R and F partly." (file-name-nondirectory file)) file (file-name-directory file)) (if (memq ?B switches) (setq wildcard-regexp "[^~]\\'"))) - (ls-lisp-insert-directory - file switches (ls-lisp-time-index switches) - wildcard-regexp full-directory-p) + (condition-case err + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + wildcard-regexp full-directory-p) + (invalid-regexp + ;; Maybe they wanted a literal file that just happens to + ;; use characters special to shell wildcards. + (if (equal (cadr err) "Unmatched [ or [^") + (progn + (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") + file (file-relative-name orig-file)) + (ls-lisp-insert-directory + file switches (ls-lisp-time-index switches) + nil full-directory-p)) + (signal (car err) (cdr err))))) ;; Try to insert the amount of free space. (save-excursion (goto-char (point-min)) diff --git a/lisp/mouse.el b/lisp/mouse.el index 94d19d99a21..5577b94d01a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -433,9 +433,8 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ;; - there is a scroll-bar-movement event ;; (same as mouse movement for our purposes) ;; quit if - ;; - there is a keyboard event or some other unknown event - ;; unknown event. - (cond ((integerp event) + ;; - there is a keyboard event or some other unknown event. + (cond ((not (consp event)) (setq done t)) ((memq (car event) '(switch-frame select-window)) @@ -443,7 +442,11 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." ((not (memq (car event) '(mouse-movement scroll-bar-movement))) (when (consp event) - (push event unread-command-events)) + ;; Do not unread a drag-mouse-1 event since it will cause the + ;; selection of the window above when dragging the modeline + ;; above the selected window. + (unless (eq (car event) 'drag-mouse-1) + (push event unread-command-events))) (setq done t)) ((not (eq (car mouse) start-event-frame)) @@ -498,7 +501,10 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line." (and (not should-enlarge-minibuffer) (> growth 0) mode-line-p - (/= top (nth 1 (window-edges))))) + (/= top + (nth 1 (window-edges + ;; Choose right window. + start-event-window))))) (set-window-configuration wconfig))))))))) (defun mouse-drag-mode-line (start-event) @@ -1007,6 +1013,11 @@ should only be used by mouse-drag-region." (overlay-start mouse-drag-overlay)) region-termination)) last-command this-command) + (when (eq transient-mark-mode 'identity) + ;; Reset `transient-mark-mode' to avoid expanding the region + ;; while scrolling (compare thread on "Erroneous selection + ;; extension ..." on bug-gnu-emacs from 2007-06-10). + (setq transient-mark-mode nil)) (push-mark region-commencement t t) (goto-char region-termination) (if (not do-mouse-drag-region-post-process) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index ec76279c642..898f9a23515 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4360,7 +4360,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; This returns nil for any file name as argument. (put 'vc-registered 'ange-ftp 'null) -(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process) +(put 'process-file 'ange-ftp 'ange-ftp-process-file) (put 'shell-command 'ange-ftp 'ange-ftp-shell-command) ;;; Define ways of getting at unmodified Emacs primitives, @@ -4523,8 +4523,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; default-directory is in ange-ftp syntax for remote file names. (ange-ftp-real-shell-command command output-buffer error-buffer)))) -;;; This is the handler for call-process. -(defun ange-ftp-dired-call-process (program discard &rest arguments) +;;; This is the handler for process-file. +(defun ange-ftp-process-file (program infile buffer display &rest arguments) ;; PROGRAM is always one of those below in the cond in dired.el. ;; The ARGUMENTS are (nearly) always files. (if (ange-ftp-ftp-name default-directory) @@ -4544,7 +4544,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") 1) (error (insert (format "%s\n" (nth 1 oops))) 1)) - (apply 'call-process program nil (not discard) nil arguments))) + (apply 'call-process program infile buffer display arguments))) ;; Handle an attempt to run chmod on a remote file ;; by using the ftp chmod command. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 04f3fa45ceb..a72dc2fd303 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -55,7 +55,7 @@ :link '(custom-manual "(rcirc)") :group 'applications) -(defcustom rcirc-connections +(defcustom rcirc-server-alist '(("irc.freenode.net" :channels ("#rcirc"))) "An alist of IRC connections to establish when running `rcirc'. Each element looks like (SERVER-NAME PARAMETERS). @@ -63,11 +63,36 @@ Each element looks like (SERVER-NAME PARAMETERS). SERVER-NAME is a string describing the server to connect to. -PARAMETERS is a plist of optional connection parameters. Valid -properties are: nick (a string), port (number or string), -user-name (string), full-name (string), and channels (list of -strings)." - :type '(alist :key-type string +The optional PARAMETERS come in pairs PARAMETER VALUE. + +The following parameters are recognized: + +`:nick' + +VALUE must be a string. If absent, `rcirc-default-nick' is used +for this connection. + +`:port' + +VALUE must be a number or string. If absent, +`rcirc-default-port' is used. + +`:user-name' + +VALUE must be a string. If absent, `rcirc-default-user-name' is +used. + +`:full-name' + +VALUE must be a string. If absent, `rcirc-default-full-name' is +used. + +`:channels' + +VALUE must be a list of strings describing which channels to join +when connecting to this server. If absent, no channels will be +connected to automatically." + :type '(alist :key-type string :value-type (plist :options ((nick string) (port integer) (user-name string) @@ -90,9 +115,9 @@ strings)." :type 'string :group 'rcirc) -(defcustom rcirc-default-user-full-name (if (string= (user-full-name) "") - rcirc-default-user-name - (user-full-name)) +(defcustom rcirc-default-full-name (if (string= (user-full-name) "") + rcirc-default-user-name + (user-full-name)) "The full name sent to the server when connecting." :type 'string :group 'rcirc) @@ -335,19 +360,19 @@ and the cdr part is used for encoding." ;;;###autoload (defun rcirc (arg) - "Connect to all servers in `rcirc-connections'. + "Connect to all servers in `rcirc-server-alist'. Do not connect to a server if it is already connected. If ARG is non-nil, instead prompt for connection parameters." (interactive "P") (if arg - (let* ((server (completing-read "IRC Server: " - rcirc-connections + (let* ((server (completing-read "IRC Server: " + rcirc-server-alist nil nil - (caar rcirc-connections))) - (server-plist (cdr (assoc-string server rcirc-connections))) - (port (read-string "IRC Port: " + (caar rcirc-server-alist))) + (server-plist (cdr (assoc-string server rcirc-server-alist))) + (port (read-string "IRC Port: " (number-to-string (or (plist-get server-plist 'port) rcirc-default-port)))) @@ -356,25 +381,25 @@ If ARG is non-nil, instead prompt for connection parameters." rcirc-default-nick))) (channels (split-string (read-string "IRC Channels: " - (mapconcat 'identity + (mapconcat 'identity (plist-get server-plist 'channels) " ")) "[, ]+" t))) (rcirc-connect server port nick rcirc-default-user-name - rcirc-default-user-full-name + rcirc-default-full-name channels)) - ;; connect to servers in `rcirc-connections' + ;; connect to servers in `rcirc-server-alist' (let (connected-servers) - (dolist (c rcirc-connections) + (dolist (c rcirc-server-alist) (let ((server (car c)) - (port (or (plist-get (cdr c) 'port) rcirc-default-port)) - (nick (or (plist-get (cdr c) 'nick) rcirc-default-nick)) - (user-name (or (plist-get (cdr c) 'user-name) + (nick (or (plist-get (cdr c) :nick) rcirc-default-nick)) + (port (or (plist-get (cdr c) :port) rcirc-default-port)) + (user-name (or (plist-get (cdr c) :user-name) rcirc-default-user-name)) - (full-name (or (plist-get (cdr c) 'full-name) - rcirc-default-user-full-name)) - (channels (plist-get (cdr c) 'channels))) + (full-name (or (plist-get (cdr c) :full-name) + rcirc-default-full-name)) + (channels (plist-get (cdr c) :channels))) (when server (let (connected) (dolist (p (rcirc-process-list)) @@ -382,9 +407,9 @@ If ARG is non-nil, instead prompt for connection parameters." (setq connected p))) (if (not connected) (condition-case e - (rcirc-connect server port nick user-name + (rcirc-connect server port nick user-name full-name channels) - (quit (message "Quit connecting to %s" server))) + (quit (message "Quit connecting to %s" server))) (with-current-buffer (process-buffer connected) (setq connected-servers (cons (process-contact (get-buffer-process @@ -411,7 +436,7 @@ If ARG is non-nil, instead prompt for connection parameters." (defvar rcirc-process nil) ;;;###autoload -(defun rcirc-connect (server &optional port nick user-name full-name +(defun rcirc-connect (server &optional port nick user-name full-name startup-channels) (save-excursion (message "Connecting to %s..." server) @@ -423,7 +448,7 @@ If ARG is non-nil, instead prompt for connection parameters." rcirc-default-port)) (nick (or nick rcirc-default-nick)) (user-name (or user-name rcirc-default-user-name)) - (full-name (or full-name rcirc-default-user-full-name)) + (full-name (or full-name rcirc-default-full-name)) (startup-channels startup-channels) (process (make-network-process :name server :host server :service port-number))) ;; set up process @@ -494,7 +519,7 @@ last ping." (mapc (lambda (process) (with-rcirc-process-buffer process (when (not rcirc-connecting) - (rcirc-send-string process + (rcirc-send-string process (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a" rcirc-nick (time-to-seconds @@ -550,7 +575,7 @@ Functions are called with PROCESS and SENTINEL arguments.") ;; set rcirc-target to nil for each channel so cleanup ;; doesnt happen when we reconnect (setq rcirc-target nil) - (setq mode-line-process ":disconnected"))) + (setq mode-line-process ":disconnected"))) (defun rcirc-process-list () "Return a list of rcirc processes." @@ -590,7 +615,6 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") process)))))) (defun rcirc-delete-process (process) - (message "delete process %S" process) (delete-process process)) (defvar rcirc-trap-errors-flag t) @@ -1162,7 +1186,7 @@ the of the following escape sequences replaced by the described values: :value-type string) :group 'rcirc) -(defcustom rcirc-omit-responses +(defcustom rcirc-omit-responses '("JOIN" "PART" "QUIT") "Responses which will be hidden when `rcirc-omit-mode' is enabled." :type '(repeat string) @@ -1202,7 +1226,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (cond ((string= sender my-nick) 'rcirc-my-nick) ((and rcirc-bright-nicks - (string-match + (string-match (regexp-opt rcirc-bright-nicks 'words) sender)) @@ -1262,11 +1286,12 @@ Logfiles are kept in `rcirc-log-directory'." Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, record activity." (or text (setq text "")) - (unless (or (member sender rcirc-ignore-list) - (member (with-syntax-table rcirc-nick-syntax-table - (when (string-match "^\\([^/]\\w*\\)[:,]" text) - (match-string 1 text))) - rcirc-ignore-list)) + (unless (and (or (member sender rcirc-ignore-list) + (member (with-syntax-table rcirc-nick-syntax-table + (when (string-match "^\\([^/]\\w*\\)[:,]" text) + (match-string 1 text))) + rcirc-ignore-list)) + (not (string= sender (rcirc-nick process)))) (let* ((buffer (rcirc-target-buffer process sender response target text)) (inhibit-read-only t)) (with-current-buffer buffer @@ -1291,12 +1316,12 @@ record activity." (set-marker-insertion-type rcirc-prompt-end-marker t) (let ((start (point))) - (insert (rcirc-format-response-string process sender response nil + (insert (rcirc-format-response-string process sender response nil text) (propertize "\n" 'hard t)) ;; squeeze spaces out of text before rcirc-text - (fill-region fill-start + (fill-region fill-start (1- (or (next-single-property-change fill-start 'rcirc-text) rcirc-prompt-end-marker))) @@ -1549,7 +1574,7 @@ if NICK is also on `rcirc-ignore-list-automatic'." (defun rcirc-omit-mode () "Toggle the Rcirc-Omit mode. -If enabled, \"uninteresting\" lines are not shown. +If enabled, \"uninteresting\" lines are not shown. Uninteresting lines are those whose responses are listed in `rcirc-omit-responses'." (interactive) @@ -1635,7 +1660,7 @@ activity. Only run if the buffer is not visible and (defun rcirc-clear-activity (buffer) "Clear the BUFFER activity." - (setq rcirc-activity (delete buffer rcirc-activity)) + (setq rcirc-activity (remove buffer rcirc-activity)) (with-current-buffer buffer (setq rcirc-activity-types nil))) @@ -2065,7 +2090,7 @@ keywords when no KEYWORD is given." rcirc-markup-keywords rcirc-markup-bright-nicks rcirc-markup-fill) - + "List of functions used to manipulate text before it is printed. Each function takes two arguments, SENDER, RESPONSE. The buffer @@ -2074,7 +2099,7 @@ beginning of the `rcirc-text' propertized text.") (defun rcirc-markup-timestamp (sender response) (goto-char (point-min)) - (insert (rcirc-facify (format-time-string rcirc-time-format) + (insert (rcirc-facify (format-time-string rcirc-time-format) 'rcirc-timestamp))) (defun rcirc-markup-attributes (sender response) @@ -2095,15 +2120,15 @@ beginning of the `rcirc-text' propertized text.") (defun rcirc-markup-my-nick (sender response) (with-syntax-table rcirc-nick-syntax-table - (while (re-search-forward (concat "\\b" - (regexp-quote (rcirc-nick + (while (re-search-forward (concat "\\b" + (regexp-quote (rcirc-nick (rcirc-buffer-process))) "\\b") nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-nick-in-message) (when (string= response "PRIVMSG") - (rcirc-add-face (point-min) (point-max) + (rcirc-add-face (point-min) (point-max) 'rcirc-nick-in-message-full-line) (rcirc-record-activity (current-buffer) 'nick))))) diff --git a/lisp/novice.el b/lisp/novice.el index f5c3019dfc2..346877dcdda 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -88,8 +88,9 @@ n to cancel--don't try the command, and it remains disabled. SPC to try the command just this once, but leave it disabled. ! to try it, and enable all disabled commands for this session only.") (save-excursion - (set-buffer standard-output) - (help-mode))) + (set-buffer standard-output) + (help-mode))) + (fit-window-to-buffer (get-buffer-window "*Disabled Command*")) (message "Type y, n, ! or SPC (the space bar): ") (let ((cursor-in-echo-area t)) (while (progn (setq char (read-event)) diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 3945d7ba67c..58c605a19d2 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -186,35 +186,6 @@ arguments. If ARGS is not a list, no argument will be passed." "Tell whether STR1 is a prefix of STR2." (eq t (compare-strings str2 nil (length str1) str1 nil nil))) -;; (string->strings (strings->string X)) == X -(defun cvs-strings->string (strings &optional separator) - "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). -This tries to quote the strings to avoid ambiguity such that - (cvs-string->strings (cvs-strings->string strs)) == strs -Only some SEPARATORs will work properly." - (let ((sep (or separator " "))) - (mapconcat - (lambda (str) - (if (string-match "[\\\"]" str) - (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") - str)) - strings sep))) - -;; (string->strings (strings->string X)) == X -(defun cvs-string->strings (string &optional separator) - "Split the STRING into a list of strings. -It understands elisp style quoting within STRING such that - (cvs-string->strings (cvs-strings->string strs)) == strs -The SEPARATOR regexp defaults to \"\\s-+\"." - (let ((sep (or separator "\\s-+")) - (i (string-match "[\"]" string))) - (if (null i) (split-string string sep t) ; no quoting: easy - (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) - (let ((rfs (read-from-string string i))) - (cons (car rfs) - (cvs-string->strings (substring string (cdr rfs)) - sep))))))) - ;;;; ;;;; file names ;;;; @@ -240,7 +211,7 @@ The SEPARATOR regexp defaults to \"\\s-+\"." (defconst cvs-qtypedesc-string1 (cvs-qtypedesc-create 'identity 'identity t)) (defconst cvs-qtypedesc-string (cvs-qtypedesc-create 'identity 'identity)) (defconst cvs-qtypedesc-strings - (cvs-qtypedesc-create 'cvs-string->strings 'cvs-strings->string nil)) + (cvs-qtypedesc-create 'string->strings 'strings->string nil)) (defun cvs-query-read (default prompt qtypedesc &optional hist-sym) (let* ((qtypedesc (or qtypedesc cvs-qtypedesc-strings)) diff --git a/lisp/pcvs.el b/lisp/pcvs.el index eb6e88e7f2f..006b2cd905b 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -182,7 +182,7 @@ (when (re-search-forward (concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t) (let* ((sym (intern (concat "cvs-" cmd "-flags"))) - (val (cvs-string->strings (or (match-string 2) "")))) + (val (string->strings (or (match-string 2) "")))) (cvs-flags-set sym 0 val)))) ;; ensure that cvs doesn't have -q or -Q (cvs-flags-set 'cvs-cvs-flags 0 @@ -607,7 +607,7 @@ If non-nil, NEW means to create a new buffer no matter what." (t arg))) args))) (concat cvs-program " " - (cvs-strings->string + (strings->string (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery) (if cvs-cvsroot (list "-d" cvs-cvsroot)) args @@ -936,7 +936,7 @@ With a prefix argument, prompt for cvs FLAGS to use." (let ((root (cvs-get-cvsroot))) (if (or (null root) current-prefix-arg) (setq root (read-string "CVS Root: "))) - (list (cvs-string->strings (read-string "Module(s): " (cvs-get-module))) + (list (string->strings (read-string "Module(s): " (cvs-get-module))) (read-directory-name "CVS Checkout Directory: " nil default-directory nil) (cvs-add-branch-prefix @@ -959,7 +959,7 @@ The files are stored to DIR." (if branch (format " (branch: %s)" branch) "")))) (list (read-directory-name prompt nil default-directory nil)))) - (let ((modules (cvs-string->strings (cvs-get-module))) + (let ((modules (string->strings (cvs-get-module))) (flags (cvs-add-branch-prefix (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))) (cvs-cvsroot (cvs-get-cvsroot))) @@ -2244,7 +2244,7 @@ With prefix argument, prompt for cvs flags." (let* ((args (append constant-args arg-list))) (insert (format "=== %s %s\n\n" - program (cvs-strings->string args))) + program (strings->string args))) ;; FIXME: return the exit status? (apply 'call-process program nil t t args) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 390d49eaea4..dcbcc618dca 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -790,7 +790,8 @@ compatible with old code; callers should always specify it." ;; If the buffer specifies `mode' or `eval' in its File Local Variable list ;; or on the first line, remove all occurrences. See ;; `c-postprocess-file-styles' for justification. There is no need to save - ;; point here, or even bother too much about the buffer contents. + ;; point here, or even bother too much about the buffer contents. However, + ;; DON'T mess up the kill-ring. ;; ;; Most of the code here is derived from Emacs 21.3's `hack-local-variables' ;; in files.el. @@ -819,8 +820,8 @@ compatible with old code; callers should always specify it." (regexp-quote suffix) "$") nil t) - (beginning-of-line) - (delete-region (point) (progn (end-of-line) (point))))) + (forward-line 0) + (delete-region (point) (progn (forward-line) (point))))) ;; Delete the first line, if we've got one, in case it contains a mode spec. (unless (and lv-point @@ -828,7 +829,8 @@ compatible with old code; callers should always specify it." (forward-line 0) (bobp))) (goto-char (point-min)) - (delete-region (point) (progn (end-of-line) (point)))))) + (unless (eobp) + (delete-region (point) (progn (forward-line) (point))))))) (defun c-postprocess-file-styles () "Function that post processes relevant file local variables in CC Mode. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e557fdef843..aa382d4e185 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2462,7 +2462,7 @@ comint mode, which see." ;; for local variables in the debugger buffer. (defun gud-common-init (command-line massage-args marker-filter &optional find-file) - (let* ((words (split-string command-line)) + (let* ((words (string->strings command-line)) (program (car words)) (dir default-directory) ;; Extract the file name from WORDS diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 9f01787b336..7720b441700 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -508,8 +508,8 @@ Original match data is restored upon return." (defun hs-hide-comment-region (beg end &optional repos-end) "Hide a region from BEG to END, marking it as a comment. Optional arg REPOS-END means reposition at end." - (let ((beg-eol (progn (goto-char beg) (end-of-line) (point))) - (end-eol (progn (goto-char end) (end-of-line) (point)))) + (let ((beg-eol (progn (goto-char beg) (line-end-position))) + (end-eol (progn (goto-char end) (line-end-position)))) (hs-discard-overlays beg-eol end-eol) (hs-make-overlay beg-eol end-eol 'comment beg end)) (goto-char (if repos-end end beg))) @@ -536,8 +536,7 @@ and then further adjusted to be at the end of the line." 'identity) pure-p)) ;; whatever the adjustment, we move to eol - (end-of-line) - (point))) + (line-end-position))) (q ;; `q' is the point at the end of the block (progn (hs-forward-sexp mdata 1) @@ -705,7 +704,7 @@ and `case-fold-search' are both t." (if (and c-reg (nth 0 c-reg)) ;; point is inside a comment, and that comment is hidable (goto-char (nth 0 c-reg)) - (end-of-line) + (end-of-line) (when (and (not c-reg) (hs-find-block-beginning) (looking-at hs-block-start-regexp)) @@ -734,12 +733,12 @@ Move point to the beginning of the line, and run the normal hook If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (interactive) (hs-life-goes-on - (message "Hiding all blocks ...") (save-excursion (unless hs-allow-nesting (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) - (let ((count 0) + (let ((spew (make-progress-reporter "Hiding all blocks..." + (point-min) (point-max))) (re (concat "\\(" hs-block-start-regexp "\\)" @@ -765,9 +764,9 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) (hs-hide-block-at-point t c-reg) (goto-char (nth 1 c-reg)))))) - (message "Hiding ... %d" (setq count (1+ count)))))) + (progress-reporter-update spew (point))) + (progress-reporter-done spew))) (beginning-of-line) - (message "Hiding all blocks ... done") (run-hooks 'hs-hide-hook))) (defun hs-show-all () @@ -806,7 +805,7 @@ See documentation for functions `hs-hide-block' and `run-hooks'." (hs-life-goes-on (or ;; first see if we have something at the end of the line - (let ((ov (hs-overlay-at (save-excursion (end-of-line) (point)))) + (let ((ov (hs-overlay-at (line-end-position))) (here (point))) (when ov (goto-char @@ -906,9 +905,9 @@ Key bindings: (progn (hs-grok-mode-type) ;; Turn off this mode if we change major modes. - (add-hook 'change-major-mode-hook - 'turn-off-hideshow - nil t) + (add-hook 'change-major-mode-hook + 'turn-off-hideshow + nil t) (easy-menu-add hs-minor-mode-menu) (set (make-local-variable 'line-move-ignore-invisible) t) (add-to-invisibility-spec '(hs . t))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 106b7eceb06..f93aa6f1415 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -171,10 +171,6 @@ ;; disadvantages: ;; 1. We need to scan the buffer to find which ")" symbols belong to a ;; case alternative, to find any here documents, and handle "$#". -;; 2. Setting the text property makes the buffer modified. If the -;; buffer is read-only buffer we have to cheat and bypass the read-only -;; status. This is for cases where the buffer started read-only buffer -;; but the user issued `toggle-read-only'. ;; ;; Bugs ;; ---- @@ -183,6 +179,16 @@ ;; ;; - `sh-learn-buffer-indent' is extremely slow. ;; +;; - "case $x in y) echo ;; esac)" the last ) is mis-identified as being +;; part of a case-pattern. You need to add a semi-colon after "esac" to +;; coerce sh-script into doing the right thing. +;; +;; - "echo $z in ps | head)" the last ) is mis-identified as being part of +;; a case-pattern. You need to put the "in" between quotes to coerce +;; sh-script into doing the right thing. +;; +;; - A line starting with "}>foo" is not indented like "} >foo". +;; ;; Richard Sharman <rsharman@pobox.com> June 1999. ;;; Code: @@ -1052,7 +1058,18 @@ subshells can nest." (backward-char 1)) (when (eq (char-before) ?|) (backward-char 1) t))) - (when (save-excursion (backward-char 2) (looking-at ";;\\|in")) + ;; FIXME: ";; esac )" is a case that looks like a case-pattern but it's + ;; really just a close paren after a case statement. I.e. if we skipped + ;; over `esac' just now, we're not looking at a case-pattern. + (when (progn (backward-char 2) + (if (> start (line-end-position)) + (put-text-property (point) (1+ start) + 'font-lock-multiline t)) + ;; FIXME: The `in' may just be a random argument to + ;; a normal command rather than the real `in' keyword. + ;; I.e. we should look back to try and find the + ;; corresponding `case'. + (looking-at ";;\\|in")) sh-st-punc))) (defun sh-font-lock-backslash-quote () diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el new file mode 100644 index 00000000000..7117ffd15e8 --- /dev/null +++ b/lisp/progmodes/vera-mode.el @@ -0,0 +1,1487 @@ +;;; vera-mode.el --- major mode for editing Vera files. + +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007 Free Software Foundation, Inc. + +;; Author: Reto Zimmermann <reto@gnu.org> +;; Maintainer: Reto Zimmermann <reto@gnu.org> +;; Version: 2.28 +;; Keywords: languages vera +;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html + +(defconst vera-version "2.18" + "Vera Mode version number.") + +(defconst vera-time-stamp "2007-06-21" + "Vera Mode time stamp for last update.") + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Commentary: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This package provides a simple Emacs major mode for editing Vera code. +;; It includes the following features: + +;; - Syntax highlighting +;; - Indentation +;; - Word/keyword completion +;; - Block commenting +;; - Works under GNU Emacs and XEmacs + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Documentation + +;; See comment string of function `vera-mode' or type `C-c C-h' in Emacs. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Installation + +;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X + +;; Put `vera-mode.el' into the `site-lisp' directory of your Emacs installation +;; or into an arbitrary directory that is added to the load path by the +;; following line in your Emacs start-up file (`.emacs'): + +;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) + +;; If you already have the compiled `vera-mode.elc' file, put it in the same +;; directory. Otherwise, byte-compile the source file: +;; Emacs: M-x byte-compile-file -> vera-mode.el +;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vera-mode.el + +;; Add the following lines to the `site-start.el' file in the `site-lisp' +;; directory of your Emacs installation or to your Emacs start-up file +;; (`.emacs'): + +;; (autoload 'vera-mode "vera-mode" "Vera Mode" t) +;; (setq auto-mode-alist (cons '("\\.vr[hi]?\\'" . vera-mode) auto-mode-alist)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + +;; XEmacs handling +(defconst vera-xemacs (string-match "XEmacs" emacs-version) + "Non-nil if XEmacs is used.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup vera nil + "Customizations for Vera Mode." + :prefix "vera-" + :version "22.2" + :group 'languages) + +(defcustom vera-basic-offset 2 + "*Amount of basic offset used for indentation." + :type 'integer + :group 'vera) + +(defcustom vera-underscore-is-part-of-word nil + "*Non-nil means consider the underscore character `_' as part of word. +An identifier containing underscores is then treated as a single word in +select and move operations. All parts of an identifier separated by underscore +are treated as single words otherwise." + :type 'boolean + :group 'vera) + +(defcustom vera-intelligent-tab t + "*Non-nil means `TAB' does indentation, word completion and tab insertion. +That is, if preceding character is part of a word then complete word, +else if not at beginning of line then insert tab, +else if last command was a `TAB' or `RET' then dedent one step, +else indent current line. +If nil, TAB always indents current line." + :type 'boolean + :group 'vera) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Key bindings + +(defvar vera-mode-map () + "Keymap for Vera Mode.") + +(setq vera-mode-map (make-sparse-keymap)) +;; backspace/delete key bindings +(define-key vera-mode-map [backspace] 'backward-delete-char-untabify) +(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable + (define-key vera-mode-map [delete] 'delete-char) + (define-key vera-mode-map [(meta delete)] 'kill-word)) +;; standard key bindings +(define-key vera-mode-map "\M-e" 'vera-forward-statement) +(define-key vera-mode-map "\M-a" 'vera-backward-statement) +(define-key vera-mode-map "\M-\C-e" 'vera-forward-same-indent) +(define-key vera-mode-map "\M-\C-a" 'vera-backward-same-indent) +;; mode specific key bindings +(define-key vera-mode-map "\C-c\t" 'indent-according-to-mode) +(define-key vera-mode-map "\M-\C-\\" 'vera-indent-region) +(define-key vera-mode-map "\C-c\C-c" 'vera-comment-uncomment-region) +(define-key vera-mode-map "\C-c\C-f" 'vera-fontify-buffer) +(define-key vera-mode-map "\C-c\C-v" 'vera-version) +(define-key vera-mode-map "\M-\t" 'tab-to-tab-stop) +;; electric key bindings +(define-key vera-mode-map "\t" 'vera-electric-tab) +(define-key vera-mode-map "\r" 'vera-electric-return) +(define-key vera-mode-map " " 'vera-electric-space) +(define-key vera-mode-map "{" 'vera-electric-opening-brace) +(define-key vera-mode-map "}" 'vera-electric-closing-brace) +(define-key vera-mode-map "#" 'vera-electric-pound) +(define-key vera-mode-map "*" 'vera-electric-star) +(define-key vera-mode-map "/" 'vera-electric-slash) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Menu + +(require 'easymenu) + +(easy-menu-define vera-mode-menu vera-mode-map + "Menu keymap for Vera Mode." + '("Vera" + ["(Un)Comment Out Region" vera-comment-uncomment-region (mark)] + "--" + ["Move Forward Statement" vera-forward-statement t] + ["Move Backward Statement" vera-backward-statement t] + ["Move Forward Same Indent" vera-forward-same-indent t] + ["Move Backward Same Indent" vera-backward-same-indent t] + "--" + ["Indent Line" indent-according-to-mode t] + ["Indent Region" vera-indent-region (mark)] + ["Indent Buffer" vera-indent-buffer t] + "--" + ["Fontify Buffer" vera-fontify-buffer t] + "--" + ["Documentation" describe-mode] + ["Version" vera-version t] + ["Bug Report..." vera-submit-bug-report t] + "--" + ("Options" + ["Indentation Offset..." (customize-option 'vera-basic-offset) t] + ["Underscore is Part of Word" + (customize-set-variable 'vera-underscore-is-part-of-word + (not vera-underscore-is-part-of-word)) + :style toggle :selected vera-underscore-is-part-of-word] + ["Use Intelligent Tab" + (customize-set-variable 'vera-intelligent-tab + (not vera-intelligent-tab)) + :style toggle :selected vera-intelligent-tab] + "--" + ["Save Options" customize-save-customized t] + "--" + ["Customize..." vera-customize t]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Syntax table + +(defvar vera-mode-syntax-table + (let ((syntax-table (make-syntax-table))) + ;; punctuation + (modify-syntax-entry ?\# "." syntax-table) + (modify-syntax-entry ?\$ "." syntax-table) + (modify-syntax-entry ?\% "." syntax-table) + (modify-syntax-entry ?\& "." syntax-table) + (modify-syntax-entry ?\' "." syntax-table) + (modify-syntax-entry ?\* "." syntax-table) + (modify-syntax-entry ?\- "." syntax-table) + (modify-syntax-entry ?\+ "." syntax-table) + (modify-syntax-entry ?\. "." syntax-table) + (modify-syntax-entry ?\/ "." syntax-table) + (modify-syntax-entry ?\: "." syntax-table) + (modify-syntax-entry ?\; "." syntax-table) + (modify-syntax-entry ?\< "." syntax-table) + (modify-syntax-entry ?\= "." syntax-table) + (modify-syntax-entry ?\> "." syntax-table) + (modify-syntax-entry ?\\ "." syntax-table) + (modify-syntax-entry ?\| "." syntax-table) + ;; string + (modify-syntax-entry ?\" "\"" syntax-table) + ;; underscore + (when vera-underscore-is-part-of-word + (modify-syntax-entry ?\_ "w" syntax-table)) + ;; escape + (modify-syntax-entry ?\\ "\\" syntax-table) + ;; parentheses to match + (modify-syntax-entry ?\( "()" syntax-table) + (modify-syntax-entry ?\) ")(" syntax-table) + (modify-syntax-entry ?\[ "(]" syntax-table) + (modify-syntax-entry ?\] ")[" syntax-table) + (modify-syntax-entry ?\{ "(}" syntax-table) + (modify-syntax-entry ?\} "){" syntax-table) + ;; comment + (if vera-xemacs + (modify-syntax-entry ?\/ ". 1456" syntax-table) ; XEmacs + (modify-syntax-entry ?\/ ". 124b" syntax-table)) ; Emacs + (modify-syntax-entry ?\* ". 23" syntax-table) + ;; newline and CR + (modify-syntax-entry ?\n "> b" syntax-table) + (modify-syntax-entry ?\^M "> b" syntax-table) + syntax-table) + "Syntax table used in `vera-mode' buffers.") + +(defvar vera-mode-ext-syntax-table + (let ((syntax-table (copy-syntax-table vera-mode-syntax-table))) + ;; extended syntax table including '_' (for simpler search regexps) + (modify-syntax-entry ?_ "w" syntax-table) + syntax-table) + "Syntax table extended by `_' used in `vera-mode' buffers.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mode definition + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.vr[hi]?\\'" . vera-mode)) + +;;;###autoload +(defun vera-mode () + "Major mode for editing Vera code. + +Usage: +------ + + INDENTATION: Typing `TAB' at the beginning of a line indents the line. + The amount of indentation is specified by option `vera-basic-offset'. + Indentation can be done for an entire region \(`M-C-\\') or buffer (menu). + `TAB' always indents the line if option `vera-intelligent-tab' is nil. + + WORD/COMMAND COMPLETION: Typing `TAB' after a (not completed) word looks + for a word in the buffer or a Vera keyword that starts alike, inserts it + and adjusts case. Re-typing `TAB' toggles through alternative word + completions. + + Typing `TAB' after a non-word character inserts a tabulator stop (if not + at the beginning of a line). `M-TAB' always inserts a tabulator stop. + + COMMENTS: `C-c C-c' comments out a region if not commented out, and + uncomments a region if already commented out. + + HIGHLIGHTING (fontification): Vera keywords, predefined types and + constants, function names, declaration names, directives, as well as + comments and strings are highlighted using different colors. + + VERA VERSION: OpenVera 1.4 and Vera version 6.2.8. + + +Maintenance: +------------ + +To submit a bug report, use the corresponding menu entry within Vera Mode. +Add a description of the problem and include a reproducible test case. + +Feel free to send questions and enhancement requests to <reto@gnu.org>. + +Official distribution is at +<http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html>. + + + The Vera Mode Maintainer + Reto Zimmermann <reto@gnu.org> + +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) "//") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'comment-column) 40) + (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|//+ *") + (set (make-local-variable 'comment-end-skip) " *\\*+/\\| *\n") + (set (make-local-variable 'comment-indent-function) 'c-comment-indent) + (set (make-local-variable 'paragraph-start) "^$") + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'require-final-newline) t) + (set (make-local-variable 'indent-tabs-mode) nil) + (set (make-local-variable 'indent-line-function) 'vera-indent-line) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + ;; initialize font locking + (set (make-local-variable 'font-lock-defaults) + '(vera-font-lock-keywords nil nil ((?\_ . "w")))) + ;; 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)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Vera definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Keywords + +(defconst vera-keywords + '( + "after" "all" "any" "around" "assoc_index" "assoc_size" "async" + "bad_state" "bad_trans" "before" "begin" "big_endian" "bind" + "bin_activation" "bit_normal" "bit_reverse" "break" "breakpoint" + "case" "casex" "casez" "class" "constraint" "continue" + "coverage" "coverage_block" "coverage_def" "coverage_depth" + "coverage_goal" "coverage_group" "coverage_option" "coverage_val" + "cross_num_print_missing" "cross_auto_bin_max" "cov_comment" + "default" "depth" "dist" "do" + "else" "end" "enum" "exhaustive" "export" "extends" "extern" + "for" "foreach" "fork" "function" + "hdl_task" "hdl_node" "hide" + "if" "illegal_self_transition" "illegal_state" "illegal_transition" + "in" "interface" "invisible" + "join" + "little_endian" "local" + "m_bad_state" "m_bad_trans" "m_state" "m_trans" + "negedge" "new" "newcov" "non_rand" "none" "not" "null" + "or" "ordered" + "packed" "port" "posedge" "proceed" "prod" "prodget" "prodset" + "program" "protected" "public" + "rand" "randc" "randcase" "randseq" "repeat" "return" "rules" + "sample" "sample_event" "shadow" "soft" "state" "static" "super" + "task" "terminate" "this" "trans" "typedef" + "unpacked" + "var" "vca" "vector" "verilog_node" "verilog_task" + "vhdl_node" "vhdl_task" "virtual" "virtuals" "visible" "void" + "while" "wildcard" "with" + ) + "List of Vera keywords.") + +(defconst vera-types + '( + "integer" "bit" "reg" "string" "bind_var" "event" + "inout" "input" "output" + "ASYNC" "CLOCK" + "NDRIVE" "NHOLD" "NRX" "NRZ" "NR0" "NR1" "NSAMPLE" + "PDRIVE" "PHOLD" "PRX" "PRZ" "PR0" "PR1" "PSAMPLE" + ) + "List of Vera predefined types.") + +(defconst vera-q-values + '( + "gnr" "grx" "grz" "gr0" "gr1" + "nr" "rx" "rz" "r0" "r1" + "snr" "srx" "srz" "sr0" "sr1" + ) + "List of Vera predefined VCA q_values.") + +(defconst vera-functions + '( + ;; system functions and tasks + "alloc" + "call_func" "call_task" "cast_assign" "close_conn" "cm_coverage" + "cm_get_coverage" "cm_get_limit" + "coverage_backup_database_file" "coverage_save_database" + "delay" + "error" "error_mode" "error_wait" "exit" + "fclose" "feof" "ferror" "fflush" "flag" "fopen" "fprintf" "freadb" + "freadb" "freadh" "freadstr" + "get_bind" "get_bind_id" "get_conn_err" "get_cycle" "get_env" + "get_memsize" "get_plus_arg" "get_systime" "get_time" "get_time_unit" + "getstate" + "initstate" + "lock_file" + "mailbox_get" "mailbox_put" "mailbox_receive" "mailbox_send" + "make_client" "make_server" + "os_command" + "printf" "psprintf" + "query" "query_str" "query_x" + "rand48" "random" "region_enter" "region_exit" "rewind" + "semaphore_get" "semaphore_put" "setstate" "signal_connect" "simwave_plot" + "srandom" "sprintf" "sscanf" "stop" "suspend_thread" "sync" + "timeout" "trace" "trigger" + "unit_delay" "unlock_file" "up_connections" + "urand48" "urandom" "urandom_range" + "vera_bit_reverse" "vera_crc" "vera_pack" "vera_pack_big_endian" + "vera_plot" "vera_report_profile" "vera_unpack" "vera_unpack_big_endian" + "vsv_call_func" "vsv_call_task" "vsv_close_conn" "vsv_get_conn_err" + "vsv_make_client" "vsv_make_server" "vsv_up_connections" + "vsv_wait_for_done" "vsv_wait_for_input" + "wait_child" "wait_var" + ;; class methods + "Configure" "DisableTrigger" "DoAction" "EnableCount" "EnableTrigger" + "Event" "GetAssert" "GetCount" "GetFirstAssert" "GetName" "GetNextAssert" + "Wait" + "atobin" "atohex" "atoi" "atooct" + "backref" "bittostr" "capacity" "compare" "constraint_mode" + "delete" + "empty" + "find" "find_index" "first" "first_index" + "get_at_least" "get_auto_bin" "get_cov_weight" "get_coverage_goal" + "get_cross_bin_max" "get_status" "get_status_msg" "getc" + "hash" + "icompare" "insert" "inst_get_at_least" "inst_get_auto_bin_max" + "inst_get_collect" "inst_get_cov_weight" "inst_get_coverage_goal" + "inst_getcross_bin_max" "inst_query" "inst_set_at_least" + "inst_set_auto_bin_max" "inst_set_bin_activiation" "inst_set_collect" + "inst_set_cov_weight" "inst_set_coverage_goal" "inst_set_cross_bin_max" + "itoa" + "last" "last_index" "len" "load" + "match" "max" "max_index" "min" "min_index" + "object_compare" "object_copy" "object_print" + "pack" "pick_index" "pop_back" "pop_front" "post_pack" "post_randomize" + "post_unpack" "postmatch" "pre_pack" "pre_randomize" "prematch" "push_back" + "push_front" "putc" + "query" "query_str" + "rand_mode" "randomize" "reserve" "reverse" "rsort" + "search" "set_at_least" "set_auto_bin_max" "set_bin_activiation" + "set_cov_weight" "set_coverage_goal" "set_cross_bin_max" "set_name" "size" + "sort" "substr" "sum" + "thismatch" "tolower" "toupper" + "unique_index" "unpack" + ;; empty methods + "new" "object_compare" + "post_boundary" "post_pack" "post_randomize" "post_unpack" "pre-randomize" + "pre_boundary" "pre_pack" "pre_unpack" + ) + "List of Vera predefined system functions, tasks and class methods.") + +(defconst vera-constants + '( + "ALL" "ANY" + "BAD_STATE" "BAD_TRANS" + "CALL" "CHECK" "CHGEDGE" "CLEAR" "COPY_NO_WAIT" "COPY_WAIT" + "CROSS" "CROSS_TRANS" + "DEBUG" "DELETE" + "EC_ARRAYX" "EC_CODE_END" "EC_CONFLICT" "EC_EVNTIMOUT" "EC_EXPECT" + "EC_FULLEXPECT" "EC_MBXTMOUT" "EC_NEXPECT" "EC_RETURN" "EC_RGNTMOUT" + "EC_SCONFLICT" "EC_SEMTMOUT" "EC_SEXPECT" "EC_SFULLEXPECT" "EC_SNEXTPECT" + "EC_USERSET" "EQ" "EVENT" + "FAIL" "FIRST" "FORK" + "GE" "GOAL" "GT" "HAND_SHAKE" "HI" "HIGH" "HNUM" + "LE" "LIC_EXIT" "LIC_PRERR" "LIC_PRWARN" "LIC_WAIT" "LO" "LOAD" "LOW" "LT" + "MAILBOX" "MAX_COM" + "NAME" "NE" "NEGEDGE" "NEXT" "NO_OVERLAP" "NO_OVERLAP_STATE" + "NO_OVERLAP_TRANS" "NO_VARS" "NO_WAIT" "NUM" "NUM_BIN" "NUM_DET" + "OFF" "OK" "OK_LAST" "ON" "ONE_BLAST" "ONE_SHOT" "ORDER" + "PAST_IT" "PERCENT" "POSEDGE" "PROGRAM" + "RAWIN" "REGION" "REPORT" + "SAMPLE" "SAVE" "SEMAPHORE" "SET" "SILENT" "STATE" "STR" + "STR_ERR_OUT_OF_RANGE" "STR_ERR_REGEXP_SYNTAX" "SUM" + "TRANS" + "VERBOSE" + "WAIT" + "stderr" "stdin" "stdout" + ) + "List of Vera predefined constants.") + +(defconst vera-rvm-types + '( + "VeraListIterator_VeraListIterator_rvm_log" + "VeraListIterator_rvm_data" "VeraListIterator_rvm_log" + "VeraListNodeVeraListIterator_rvm_log" "VeraListNodervm_data" + "VeraListNodervm_log" "VeraList_VeraListIterator_rvm_log" + "VeraList_rvm_data" "VeraList_rvm_log" + "rvm_broadcast" "rvm_channel_class" "rvm_data" "rvm_data" "rvm_env" + "rvm_log" "rvm_log_modifier" "rvm_log_msg" "rvm_log_msg" "rvm_log_msg_info" + "rvm_log_watchpoint" "rvm_notify" "rvm_notify_event" + "rvm_notify_event_config" "rvm_scheduler" "rvm_scheduler_election" + "rvm_watchdog" "rvm_watchdog_port" "rvm_xactor" "rvm_xactor_callbacks" + ) + "List of Vera-RVM keywords.") + +(defconst vera-rvm-functions + '( + "extern_rvm_atomic_gen" "extern_rvm_channel" "extern_rvm_scenario_gen" + "rvm_OO_callback" "rvm_atomic_gen" "rvm_atomic_gen_callbacks_decl" + "rvm_atomic_gen_decl" "rvm_atomic_scenario_decl" "rvm_channel" + "rvm_channel_" "rvm_channel_decl" "rvm_command" "rvm_cycle" "rvm_debug" + "rvm_error" "rvm_fatal" "rvm_note" "rvm_protocol" "rvm_report" + "rvm_scenario_decl" "rvm_scenario_election_decl" "rvm_scenario_gen" + "rvm_scenario_gen_callbacks_decl" "rvm_scenario_gen_decl" + "rvm_trace" "rvm_transaction" "rvm_user" "rvm_verbose" "rvm_warning" + ) + "List of Vera-RVM functions.") + +(defconst vera-rvm-constants + '( + "RVM_NUMERIC_VERSION_MACROS" "RVM_VERSION" "RVM_MINOR" "RVM_PATCH" + "rvm_channel__SOURCE" "rvm_channel__SINK" "rvm_channel__NO_ACTIVE" + "rvm_channel__ACT_PENDING" "rvm_channel__ACT_STARTED" + "rvm_channel__ACT_COMPLETED" "rvm_channel__FULL" "rvm_channel__EMPTY" + "rvm_channel__PUT" "rvm_channel__GOT" "rvm_channel__PEEKED" + "rvm_channel__ACTIVATED" "rvm_channel__STARTED" "rvm_channel__COMPLETED" + "rvm_channel__REMOVED" "rvm_channel__LOCKED" "rvm_channel__UNLOCKED" + "rvm_data__EXECUTE" "rvm_data__STARTED" "rvm_data__ENDED" + "rvm_env__CFG_GENED" "rvm_env__BUILT" "rvm_env__DUT_CFGED" + "rvm_env__STARTED" "rvm_env__RESTARTED" "rvm_env__ENDED" "rvm_env__STOPPED" + "rvm_env__CLEANED" "rvm_env__DONE" "rvm_log__DEFAULT" "rvm_log__UNCHANGED" + "rvm_log__FAILURE_TYP" "rvm_log__NOTE_TYP" "rvm_log__DEBUG_TYP" + "rvm_log__REPORT_TYP" "rvm_log__NOTIFY_TYP" "rvm_log__TIMING_TYP" + "rvm_log__XHANDLING_TYP" "rvm_log__PROTOCOL_TYP" "rvm_log__TRANSACTION_TYP" + "rvm_log__COMMAND_TYP" "rvm_log__CYCLE_TYP" "rvm_log__USER_TYP_0" + "rvm_log__USER_TYP_1" "rvm_log__USER_TYP_2" "rvm_log__USER_TYP_3" + "rvm_log__DEFAULT_TYP" "rvm_log__ALL_TYPES" "rvm_log__FATAL_SEV" + "rvm_log__ERROR_SEV" "rvm_log__WARNING_SEV" "rvm_log__NORMAL_SEV" + "rvm_log__TRACE_SEV" "rvm_log__DEBUG_SEV" "rvm_log__VERBOSE_SEV" + "rvm_log__HIDDEN_SEV" "rvm_log__IGNORE_SEV" "rvm_log__DEFAULT_SEV" + "rvm_log__ALL_SEVERITIES" "rvm_log__CONTINUE" "rvm_log__COUNT_AS_ERROR" + "rvm_log__DEBUGGER" "rvm_log__DUMP" "rvm_log__STOP" "rvm_log__ABORT" + "rvm_notify__ONE_SHOT_TRIGGER" "rvm_notify__ONE_BLAST_TRIGGER" + "rvm_notify__HAND_SHAKE_TRIGGER" "rvm_notify__ON_OFF_TRIGGER" + "rvm_xactor__XACTOR_IDLE" "rvm_xactor__XACTOR_BUSY" + "rvm_xactor__XACTOR_STARTED" "rvm_xactor__XACTOR_STOPPED" + "rvm_xactor__XACTOR_RESET" "rvm_xactor__XACTOR_SOFT_RST" + "rvm_xactor__XACTOR_FIRM_RST" "rvm_xactor__XACTOR_HARD_RST" + "rvm_xactor__XACTOR_PROTOCOL_RST" "rvm_broadcast__AFAP" + "rvm_broadcast__ALAP" "rvm_watchdog__TIMEOUT" + "rvm_env__DUT_RESET" "rvm_log__INTERNAL_TYP" + "RVM_SCHEDULER_IS_XACTOR" "RVM_BROADCAST_IS_XACTOR" + ) + "List of Vera-RVM predefined constants.") + +;; `regexp-opt' undefined (`xemacs-devel' not installed) +(unless (fboundp 'regexp-opt) + (defun regexp-opt (strings &optional paren) + (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) + (concat open (mapconcat 'regexp-quote strings "\\|") close)))) + +(defconst vera-keywords-regexp + (concat "\\<\\(" (regexp-opt vera-keywords) "\\)\\>") + "Regexp for Vera keywords.") + +(defconst vera-types-regexp + (concat "\\<\\(" (regexp-opt vera-types) "\\)\\>") + "Regexp for Vera predefined types.") + +(defconst vera-q-values-regexp + (concat "\\<\\(" (regexp-opt vera-q-values) "\\)\\>") + "Regexp for Vera predefined VCA q_values.") + +(defconst vera-functions-regexp + (concat "\\<\\(" (regexp-opt vera-functions) "\\)\\>") + "Regexp for Vera predefined system functions, tasks and class methods.") + +(defconst vera-constants-regexp + (concat "\\<\\(" (regexp-opt vera-constants) "\\)\\>") + "Regexp for Vera predefined constants.") + +(defconst vera-rvm-types-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-types) "\\)\\>") + "Regexp for Vera-RVM keywords.") + +(defconst vera-rvm-functions-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-functions) "\\)\\>") + "Regexp for Vera-RVM predefined system functions, tasks and class methods.") + +(defconst vera-rvm-constants-regexp + (concat "\\<\\(" (regexp-opt vera-rvm-constants) "\\)\\>") + "Regexp for Vera-RVM predefined constants.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Font locking +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; XEmacs compatibility +(when vera-xemacs + (require 'font-lock) + (copy-face 'font-lock-reference-face 'font-lock-constant-face) + (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) + +(defun vera-font-lock-match-item (limit) + "Match, and move over, any declaration item after point. +Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." + (condition-case nil + (save-restriction + (narrow-to-region (point-min) limit) + ;; match item + (when (looking-at "\\s-*\\(\\w+\\)") + (save-match-data + (goto-char (match-end 1)) + ;; move to next item + (if (looking-at "\\(\\s-*\\(\\[[^]]*\\]\\s-*\\)?,\\)") + (goto-char (match-end 1)) + (end-of-line) t)))) + (error t))) + +(defvar vera-font-lock-keywords + (list + ;; highlight keywords + (list vera-keywords-regexp 1 'font-lock-keyword-face) + ;; highlight types + (list vera-types-regexp 1 'font-lock-type-face) + ;; highlight RVM types + (list vera-rvm-types-regexp 1 'font-lock-type-face) + ;; highlight constants + (list vera-constants-regexp 1 'font-lock-constant-face) + ;; highlight RVM constants + (list vera-rvm-constants-regexp 1 'font-lock-constant-face) + ;; highlight q_values + (list vera-q-values-regexp 1 'font-lock-constant-face) + ;; highlight predefined functions, tasks and methods + (list vera-functions-regexp 1 'vera-font-lock-function) + ;; highlight predefined RVM functions + (list vera-rvm-functions-regexp 1 'vera-font-lock-function) + ;; highlight functions + '("\\<\\(\\w+\\)\\s-*(" 1 font-lock-function-name-face) + ;; highlight various declaration names + '("^\\s-*\\(port\\|program\\|task\\)\\s-+\\(\\w+\\)\\>" + 2 font-lock-function-name-face) + '("^\\s-*bind\\s-+\\(\\w+\\)\\s-+\\(\\w+\\)\\>" + (1 font-lock-function-name-face) (2 font-lock-function-name-face)) + ;; highlight interface declaration names + '("^\\s-*\\(class\\|interface\\)\\s-+\\(\\w+\\)\\>" + 2 vera-font-lock-interface) + ;; highlight variable name definitions + (list (concat "^\\s-*" vera-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") + '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) + (list (concat "^\\s-*" vera-rvm-types-regexp "\\s-*\\(\\[[^]]+\\]\\s-+\\)?") + '(vera-font-lock-match-item nil nil (1 font-lock-variable-name-face))) + ;; highlight numbers + '("\\([0-9]*'[bdoh][0-9a-fA-FxXzZ_]+\\)" 1 vera-font-lock-number) + ;; highlight filenames in #include directives + '("^#\\s-*include\\s-*\\(<[^>\"\n]*>?\\)" + 1 font-lock-string-face) + ;; highlight directives and directive names + '("^#\\s-*\\(\\w+\\)\\>[ \t!]*\\(\\w+\\)?" + (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t)) + ;; highlight `@', `$' and `#' + '("\\([@$#]\\)" 1 font-lock-keyword-face) + ;; highlight @ and # definitions + '("@\\s-*\\(\\w*\\)\\(\\s-*,\\s-*\\(\\w+\\)\\)?\\>[^.]" + (1 vera-font-lock-number) (3 vera-font-lock-number nil t)) + ;; highlight interface signal name + '("\\(\\w+\\)\\.\\w+" 1 vera-font-lock-interface) + ) + "Regular expressions to highlight in Vera Mode.") + +(defvar vera-font-lock-number 'vera-font-lock-number + "Face name to use for @ definitions.") + +(defvar vera-font-lock-function 'vera-font-lock-function + "Face name to use for predefined functions and tasks.") + +(defvar vera-font-lock-interface 'vera-font-lock-interface + "Face name to use for interface names.") + +(defface vera-font-lock-number + '((((class color) (background light)) (:foreground "Gold4")) + (((class color) (background dark)) (:foreground "BurlyWood1")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight @ definitions." + :group 'font-lock-highlighting-faces) + +(defface vera-font-lock-function + '((((class color) (background light)) (:foreground "DarkCyan")) + (((class color) (background dark)) (:foreground "Orchid1")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight predefined functions and tasks." + :group 'font-lock-highlighting-faces) + +(defface vera-font-lock-interface + '((((class color) (background light)) (:foreground "Grey40")) + (((class color) (background dark)) (:foreground "Grey80")) + (t (:italic t :bold t))) + "Font lock mode face used to highlight interface names." + :group 'font-lock-highlighting-faces) + +(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Indentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar vera-echo-syntactic-information-p nil + "If non-nil, syntactic info is echoed when the line is indented.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; offset functions + +(defconst vera-offsets-alist + '((comment . vera-lineup-C-comments) + (comment-intro . vera-lineup-comment) + (string . -1000) + (directive . -1000) + (block-open . 0) + (block-intro . +) + (block-close . 0) + (arglist-intro . +) + (arglist-cont . +) + (arglist-cont-nonempty . 0) + (arglist-close . 0) + (statement . 0) + (statement-cont . +) + (substatement . +) + (else-clause . 0)) + "Association list of syntactic element symbols and indentation offsets. +Adapted from `c-offsets-alist'.") + +(defun vera-evaluate-offset (offset langelem symbol) + "OFFSET can be a number, a function, a variable, a list, or one of +the symbols + or -." + (cond + ((eq offset '+) (setq offset vera-basic-offset)) + ((eq offset '-) (setq offset (- vera-basic-offset))) + ((eq offset '++) (setq offset (* 2 vera-basic-offset))) + ((eq offset '--) (setq offset (* 2 (- vera-basic-offset)))) + ((eq offset '*) (setq offset (/ vera-basic-offset 2))) + ((eq offset '/) (setq offset (/ (- vera-basic-offset) 2))) + ((functionp offset) (setq offset (funcall offset langelem))) + ((listp offset) + (setq offset + (let (done) + (while (and (not done) offset) + (setq done (vera-evaluate-offset (car offset) langelem symbol) + offset (cdr offset))) + (if (not done) + 0 + done)))) + ((not (numberp offset)) (setq offset (symbol-value offset)))) + offset) + +(defun vera-get-offset (langelem) + "Get offset from LANGELEM which is a cons cell of the form: +\(SYMBOL . RELPOS). The symbol is matched against +vera-offsets-alist and the offset found there is either returned, +or added to the indentation at RELPOS. If RELPOS is nil, then +the offset is simply returned." + (let* ((symbol (car langelem)) + (relpos (cdr langelem)) + (match (assq symbol vera-offsets-alist)) + (offset (cdr-safe match))) + (if (not match) + (setq offset 0 + relpos 0) + (setq offset (vera-evaluate-offset offset langelem symbol))) + (+ (if (and relpos + (< relpos (save-excursion (beginning-of-line) (point)))) + (save-excursion + (goto-char relpos) + (current-column)) + 0) + (vera-evaluate-offset offset langelem symbol)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; help functions + +(defsubst vera-point (position) + "Return the value of point at certain commonly referenced POSITIONs. +POSITION can be one of the following symbols: + bol -- beginning of line + eol -- end of line + boi -- back to indentation + ionl -- indentation of next line + iopl -- indentation of previous line + bonl -- beginning of next line + bopl -- beginning of previous line +This function does not modify point or mark." + (save-excursion + (cond + ((eq position 'bol) (beginning-of-line)) + ((eq position 'eol) (end-of-line)) + ((eq position 'boi) (back-to-indentation)) + ((eq position 'bonl) (forward-line 1)) + ((eq position 'bopl) (forward-line -1)) + ((eq position 'iopl) (forward-line -1) (back-to-indentation)) + ((eq position 'ionl) (forward-line 1) (back-to-indentation)) + (t (error "Unknown buffer position requested: %s" position))) + (point))) + +(defun vera-in-literal (&optional lim) + "Determine if point is in a Vera literal." + (save-excursion + (let ((state (parse-partial-sexp (or lim (point-min)) (point)))) + (cond + ((nth 3 state) 'string) + ((nth 4 state) 'comment) + (t nil))))) + +(defun vera-skip-forward-literal () + "Skip forward literal and return t if within one." + (let ((state (save-excursion + (if (fboundp 'syntax-ppss) + (syntax-ppss) + (parse-partial-sexp (point-min) (point)))))) + (when (nth 8 state) + ;; Inside a string or comment. + (goto-char (nth 8 state)) + (if (nth 3 state) + ;; A string. + (condition-case nil (forward-sexp 1) + ;; Can't find end of string: it extends til end of buffer. + (error (goto-char (point-max)))) + ;; A comment. + (forward-comment 1)) + t))) + +(defun vera-skip-backward-literal () + "Skip backward literal and return t if within one." + (let ((state (save-excursion + (if (fboundp 'syntax-ppss) + (syntax-ppss) + (parse-partial-sexp (point-min) (point)))))) + (when (nth 8 state) + ;; Inside a string or comment. + (goto-char (nth 8 state)) + t))) + +(defsubst vera-re-search-forward (regexp &optional bound noerror) + "Like `re-search-forward', but skips over matches in literals." + (store-match-data '(nil nil)) + (while (and (re-search-forward regexp bound noerror) + (vera-skip-forward-literal) + (progn (store-match-data '(nil nil)) + (if bound (< (point) bound) t)))) + (match-end 0)) + +(defsubst vera-re-search-backward (regexp &optional bound noerror) + "Like `re-search-backward', but skips over matches in literals." + (store-match-data '(nil nil)) + (while (and (re-search-backward regexp bound noerror) + (vera-skip-backward-literal) + (progn (store-match-data '(nil nil)) + (if bound (> (point) bound) t)))) + (match-end 0)) + +(defun vera-forward-syntactic-ws (&optional lim skip-directive) + "Forward skip of syntactic whitespace." + (save-restriction + (let* ((lim (or lim (point-max))) + (here lim) + (hugenum (point-max))) + (narrow-to-region (point) lim) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + (when (and skip-directive (looking-at "^\\s-*#")) + (end-of-line)))))) + +(defun vera-backward-syntactic-ws (&optional lim skip-directive) + "Backward skip over syntactic whitespace." + (save-restriction + (let* ((lim (or lim (point-min))) + (here lim) + (hugenum (- (point-max)))) + (when (< lim (point)) + (narrow-to-region lim (point)) + (while (/= here (point)) + (setq here (point)) + (forward-comment hugenum) + (when (and skip-directive + (save-excursion (back-to-indentation) + (= (following-char) ?\#))) + (beginning-of-line))))))) + +(defmacro vera-prepare-search (&rest body) + "Execute BODY with a syntax table that includes '_'." + `(with-syntax-table vera-mode-ext-syntax-table ,@body)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; comment indentation functions + +(defsubst vera-langelem-col (langelem &optional preserve-point) + "Convenience routine to return the column of LANGELEM's relpos. +Leaves point at the relpos unless PRESERVE-POINT is non-nil." + (let ((here (point))) + (goto-char (cdr langelem)) + (prog1 (current-column) + (if preserve-point + (goto-char here))))) + +(defun vera-lineup-C-comments (langelem) + "Line up C block comment continuation lines. +Nicked from `c-lineup-C-comments'." + (save-excursion + (let ((here (point)) + (stars (progn (back-to-indentation) + (skip-chars-forward "*"))) + (langelem-col (vera-langelem-col langelem))) + (back-to-indentation) + (if (not (re-search-forward "/\\([*]+\\)" (vera-point 'eol) t)) + (progn + (if (not (looking-at "[*]+")) + (progn + ;; we now have to figure out where this comment begins. + (goto-char here) + (back-to-indentation) + (if (looking-at "[*]+/") + (progn (goto-char (match-end 0)) + (forward-comment -1)) + (goto-char (cdr langelem)) + (back-to-indentation)))) + (- (current-column) langelem-col)) + (if (zerop stars) + (progn + (skip-chars-forward " \t") + (- (current-column) langelem-col)) + ;; how many stars on comment opening line? if greater than + ;; on current line, align left. if less than or equal, + ;; align right. this should also pick up Javadoc style + ;; comments. + (if (> (length (match-string 1)) stars) + (progn + (back-to-indentation) + (- (current-column) -1 langelem-col)) + (- (current-column) stars langelem-col))))))) + +(defun vera-lineup-comment (langelem) + "Line up a comment start." + (save-excursion + (back-to-indentation) + (if (bolp) + ;; not indent if at beginning of line + -1000 + ;; otherwise indent accordingly + (goto-char (cdr langelem)) + (current-column)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; move functions + +(defconst vera-beg-block-re "{\\|\\<\\(begin\\|fork\\)\\>") + +(defconst vera-end-block-re "}\\|\\<\\(end\\|join\\(\\s-+\\(all\\|any\\|none\\)\\)?\\)\\>") + +(defconst vera-beg-substatement-re "\\<\\(else\\|for\\|if\\|repeat\\|while\\)\\>") + +(defun vera-corresponding-begin (&optional recursive) + "Find corresponding block begin if cursor is at a block end." + (while (and (vera-re-search-backward + (concat "\\(" vera-end-block-re "\\)\\|" vera-beg-block-re) + nil t) + (match-string 1)) + (vera-corresponding-begin t)) + (unless recursive (vera-beginning-of-substatement))) + +(defun vera-corresponding-if () + "Find corresponding `if' if cursor is at `else'." + (while (and (vera-re-search-backward "}\\|\\<\\(if\\|else\\)\\>" nil t) + (not (equal (match-string 0) "if"))) + (if (equal (match-string 0) "else") + (vera-corresponding-if) + (forward-char) + (backward-sexp)))) + +(defun vera-beginning-of-statement () + "Go to beginning of current statement." + (let (pos) + (while + (progn + ;; search for end of previous statement + (while + (and (vera-re-search-backward + (concat "[);]\\|" vera-beg-block-re + "\\|" vera-end-block-re) nil t) + (equal (match-string 0) ")")) + (forward-char) + (backward-sexp)) + (setq pos (match-beginning 0)) + ;; go back to beginning of current statement + (goto-char (or (match-end 0) 0)) + (vera-forward-syntactic-ws nil t) + (when (looking-at "(") + (forward-sexp) + (vera-forward-syntactic-ws nil t)) + ;; if "else" found, go to "if" and search again + (when (looking-at "\\<else\\>") + (vera-corresponding-if) + (setq pos (point)) + t)) + ;; if search is repeated, go to beginning of last search + (goto-char pos)))) + +(defun vera-beginning-of-substatement () + "Go to beginning of current substatement." + (let ((lim (point)) + pos) + ;; go to beginning of statement + (vera-beginning-of-statement) + (setq pos (point)) + ;; go forward all substatement opening statements until at LIM + (while (and (< (point) lim) + (vera-re-search-forward vera-beg-substatement-re lim t)) + (setq pos (match-beginning 0))) + (vera-forward-syntactic-ws nil t) + (when (looking-at "(") + (forward-sexp) + (vera-forward-syntactic-ws nil t)) + (when (< (point) lim) + (setq pos (point))) + (goto-char pos))) + +(defun vera-forward-statement () + "Move forward one statement." + (interactive) + (vera-prepare-search + (while (and (vera-re-search-forward + (concat "[(;]\\|" vera-beg-block-re "\\|" vera-end-block-re) + nil t) + (equal (match-string 0) "(")) + (backward-char) + (forward-sexp)) + (vera-beginning-of-substatement))) + +(defun vera-backward-statement () + "Move backward one statement." + (interactive) + (vera-prepare-search + (vera-backward-syntactic-ws nil t) + (unless (= (preceding-char) ?\)) + (backward-char)) + (vera-beginning-of-substatement))) + +(defun vera-forward-same-indent () + "Move forward to next line with same indent." + (interactive) + (let ((pos (point)) + (indent (current-indentation))) + (beginning-of-line 2) + (while (and (not (eobp)) + (or (looking-at "^\\s-*$") + (> (current-indentation) indent))) + (beginning-of-line 2)) + (if (= (current-indentation) indent) + (back-to-indentation) + (message "No following line with same indent found in this block") + (goto-char pos)))) + +(defun vera-backward-same-indent () + "Move backward to previous line with same indent." + (interactive) + (let ((pos (point)) + (indent (current-indentation))) + (beginning-of-line -0) + (while (and (not (bobp)) + (or (looking-at "^\\s-*$") + (> (current-indentation) indent))) + (beginning-of-line -0)) + (if (= (current-indentation) indent) + (back-to-indentation) + (message "No preceding line with same indent found in this block") + (goto-char pos)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; syntax analysis + +(defmacro vera-add-syntax (symbol &optional relpos) + "A simple macro to append the syntax in SYMBOL to the syntax list. +try to increase performance by using this macro." + `(setq syntax (cons (cons ,symbol ,(or relpos 0)) syntax))) + +(defun vera-guess-basic-syntax () + "Determine syntactic context of current line of code." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + syntax state placeholder pos) + ;; determine syntax state + (setq state (parse-partial-sexp (point-min) (point))) + (cond + ;; CASE 1: in a comment? + ((nth 4 state) + ;; skip empty lines + (while (and (zerop (forward-line -1)) + (looking-at "^\\s-*$"))) + (vera-add-syntax 'comment (vera-point 'boi))) + ;; CASE 2: in a string? + ((nth 3 state) + (vera-add-syntax 'string)) + ;; CASE 3: at a directive? + ((save-excursion (back-to-indentation) (= (following-char) ?\#)) + (vera-add-syntax 'directive (point))) + ;; CASE 4: after an opening parenthesis (argument list continuation)? + ((and (nth 1 state) + (or (= (char-after (nth 1 state)) ?\() + ;; also for concatenation (opening '{' and ',' on eol/eopl) + (and (= (char-after (nth 1 state)) ?\{) + (or (save-excursion + (vera-backward-syntactic-ws) (= (char-before) ?,)) + (save-excursion + (end-of-line) (= (char-before) ?,)))))) + (goto-char (1+ (nth 1 state))) + ;; is there code after the opening parenthesis on the same line? + (if (looking-at "\\s-*$") + (vera-add-syntax 'arglist-cont (vera-point 'boi)) + (vera-add-syntax 'arglist-cont-nonempty (point)))) + ;; CASE 5: at a block closing? + ((save-excursion (back-to-indentation) (looking-at vera-end-block-re)) + ;; look for the corresponding begin + (vera-corresponding-begin) + (vera-add-syntax 'block-close (vera-point 'boi))) + ;; CASE 6: at a block intro (the first line after a block opening)? + ((and (save-excursion + (vera-backward-syntactic-ws nil t) + ;; previous line ends with a block opening? + (or (/= (skip-chars-backward "{") 0) (backward-word 1)) + (when (looking-at vera-beg-block-re) + ;; go to beginning of substatement + (vera-beginning-of-substatement) + (setq placeholder (point)))) + ;; not if "fork" is followed by "{" + (save-excursion + (not (and (progn (back-to-indentation) (looking-at "{")) + (progn (goto-char placeholder) + (looking-at "\\<fork\\>")))))) + (goto-char placeholder) + (vera-add-syntax 'block-intro (vera-point 'boi))) + ;; CASE 7: at the beginning of an else clause? + ((save-excursion (back-to-indentation) (looking-at "\\<else\\>")) + ;; find corresponding if + (vera-corresponding-if) + (vera-add-syntax 'else-clause (vera-point 'boi))) + ;; CASE 8: at the beginning of a statement? + ;; is the previous command completed? + ((or (save-excursion + (vera-backward-syntactic-ws nil t) + (setq placeholder (point)) + ;; at the beginning of the buffer? + (or (bobp) + ;; previous line ends with a semicolon or + ;; is a block opening or closing? + (when (or (/= (skip-chars-backward "{};") 0) + (progn (back-to-indentation) + (looking-at (concat vera-beg-block-re "\\|" + vera-end-block-re)))) + ;; if at a block closing, go to beginning + (when (looking-at vera-end-block-re) + (vera-corresponding-begin)) + ;; go to beginning of the statement + (vera-beginning-of-statement) + (setq placeholder (point))) + ;; at a directive? + (when (progn (back-to-indentation) (looking-at "#")) + ;; go to previous statement + (vera-beginning-of-statement) + (setq placeholder (point))))) + ;; at a block opening? + (when (save-excursion (back-to-indentation) + (looking-at vera-beg-block-re)) + ;; go to beginning of the substatement + (vera-beginning-of-substatement) + (setq placeholder (point)))) + (goto-char placeholder) + (vera-add-syntax 'statement (vera-point 'boi))) + ;; CASE 9: at the beginning of a substatement? + ;; is this line preceded by a substatement opening statement? + ((save-excursion (vera-backward-syntactic-ws nil t) + (when (= (preceding-char) ?\)) (backward-sexp)) + (backward-word 1) + (setq placeholder (point)) + (looking-at vera-beg-substatement-re)) + (goto-char placeholder) + (vera-add-syntax 'substatement (vera-point 'boi))) + ;; CASE 10: it must be a statement continuation! + (t + ;; go to beginning of statement + (vera-beginning-of-substatement) + (vera-add-syntax 'statement-cont (vera-point 'boi)))) + ;; special case: look for a comment start + (goto-char indent-point) + (skip-chars-forward " \t") + (when (looking-at comment-start) + (vera-add-syntax 'comment-intro)) + ;; return syntax + syntax))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; indentation functions + +(defun vera-indent-line () + "Indent the current line as Vera code. +Return the amount of indentation change (in columns)." + (interactive) + (vera-prepare-search + (let* ((syntax (vera-guess-basic-syntax)) + (pos (- (point-max) (point))) + (indent (apply '+ (mapcar 'vera-get-offset syntax))) + (shift-amt (- (current-indentation) indent))) + (when vera-echo-syntactic-information-p + (message "syntax: %s, indent= %d" syntax indent)) + (unless (zerop shift-amt) + (beginning-of-line) + (delete-region (point) (vera-point 'boi)) + (indent-to indent)) + (if (< (point) (vera-point 'boi)) + (back-to-indentation) + ;; If initial point was within line's indentation, position after + ;; the indentation. Else stay at same point in text. + (when (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt))) + +(defun vera-indent-buffer () + "Indent whole buffer as Vera code. +Calls `indent-region' for whole buffer." + (interactive) + (message "Indenting buffer...") + (indent-region (point-min) (point-max) nil) + (message "Indenting buffer...done")) + +(defun vera-indent-region (start end column) + "Indent region as Vera code." + (interactive "r\nP") + (message "Indenting region...") + (indent-region start end column) + (message "Indenting region...done")) + +(defsubst vera-indent-block-closing () + "If previous word is a block closing or `else', indent line again." + (when (= (char-syntax (preceding-char)) ?w) + (save-excursion + (backward-word 1) + (when (and (not (vera-in-literal)) + (looking-at (concat vera-end-block-re "\\|\\<else\\>"))) + (indent-according-to-mode))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; electrifications + +(defun vera-electric-tab (&optional prefix-arg) + "Do what I mean (indent, expand, tab, change indent, etc..). +If preceding character is part of a word or a paren then `hippie-expand', +else if right of non whitespace on line then `tab-to-tab-stop', +else if last command was a tab or return then dedent one step or if a comment +toggle between normal indent and inline comment indent, +else indent `correctly'. +If `vera-intelligent-tab' is nil, always indent line." + (interactive "*P") + (if vera-intelligent-tab + (progn + (cond ((memq (char-syntax (preceding-char)) '(?w ?_)) + (let ((case-fold-search t) + (case-replace nil) + (hippie-expand-only-buffers + (or (and (boundp 'hippie-expand-only-buffers) + hippie-expand-only-buffers) + '(vera-mode)))) + (vera-expand-abbrev prefix-arg))) + ((> (current-column) (current-indentation)) + (tab-to-tab-stop)) + ((and (or (eq last-command 'vera-electric-tab) + (eq last-command 'vera-electric-return)) + (/= 0 (current-indentation))) + (backward-delete-char-untabify vera-basic-offset nil)) + (t (indent-according-to-mode))) + (setq this-command 'vera-electric-tab)) + (indent-according-to-mode))) + +(defun vera-electric-return () + "Insert newline and indent. Indent current line if it is a block closing." + (interactive) + (vera-indent-block-closing) + (newline-and-indent)) + +(defun vera-electric-space (arg) + "Insert a space. Indent current line if it is a block closing." + (interactive "*P") + (unless arg + (vera-indent-block-closing)) + (self-insert-command (prefix-numeric-value arg))) + +(defun vera-electric-opening-brace (arg) + "Outdent opening brace." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (indent-according-to-mode))) + +(defun vera-electric-closing-brace (arg) + "Outdent closing brace." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (indent-according-to-mode))) + +(defun vera-electric-pound (arg) + "Insert `#' and indent as directive it first character of line." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (unless arg + (save-excursion + (backward-char) + (skip-chars-backward " \t") + (when (bolp) + (delete-horizontal-space))))) + +(defun vera-electric-star (arg) + "Insert a star character. Nicked from `c-electric-star'." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (if (and (not arg) + (memq (vera-in-literal) '(comment)) + (eq (char-before) ?*) + (save-excursion + (forward-char -1) + (skip-chars-backward "*") + (if (eq (char-before) ?/) + (forward-char -1)) + (skip-chars-backward " \t") + (bolp))) + (indent-according-to-mode))) + +(defun vera-electric-slash (arg) + "Insert a slash character. Nicked from `c-electric-slash'." + (interactive "*P") + (let* ((ch (char-before)) + (indentp (and (not arg) + (eq last-command-char ?/) + (or (and (eq ch ?/) + (not (vera-in-literal))) + (and (eq ch ?*) + (vera-in-literal)))))) + (self-insert-command (prefix-numeric-value arg)) + (when indentp + (indent-according-to-mode)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Miscellaneous +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hippie expand customization (for expansion of Vera commands) + +(defvar vera-abbrev-list + (append (list nil) vera-keywords + (list nil) vera-types + (list nil) vera-functions + (list nil) vera-constants + (list nil) vera-rvm-types + (list nil) vera-rvm-functions + (list nil) vera-rvm-constants) + "Predefined abbreviations for Vera.") + +(defvar vera-expand-upper-case nil) + +(eval-when-compile (require 'hippie-exp)) + +(defun vera-try-expand-abbrev (old) + "Try expanding abbreviations from `vera-abbrev-list'." + (unless old + (he-init-string (he-dabbrev-beg) (point)) + (setq he-expand-list + (let ((abbrev-list vera-abbrev-list) + (sel-abbrev-list '())) + (while abbrev-list + (when (or (not (stringp (car abbrev-list))) + (string-match + (concat "^" he-search-string) (car abbrev-list))) + (setq sel-abbrev-list + (cons (car abbrev-list) sel-abbrev-list))) + (setq abbrev-list (cdr abbrev-list))) + (nreverse sel-abbrev-list)))) + (while (and he-expand-list + (or (not (stringp (car he-expand-list))) + (he-string-member (car he-expand-list) he-tried-table t))) + (unless (stringp (car he-expand-list)) + (setq vera-expand-upper-case (car he-expand-list))) + (setq he-expand-list (cdr he-expand-list))) + (if (null he-expand-list) + (progn (when old (he-reset-string)) + nil) + (he-substitute-string + (if vera-expand-upper-case + (upcase (car he-expand-list)) + (car he-expand-list)) + t) + (setq he-expand-list (cdr he-expand-list)) + t)) + +;; function for expanding abbrevs and dabbrevs +(defalias 'vera-expand-abbrev + (make-hippie-expand-function '(try-expand-dabbrev + try-expand-dabbrev-all-buffers + vera-try-expand-abbrev))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Comments + +(defun vera-comment-uncomment-region (beg end &optional arg) + "Comment region if not commented, uncomment region if already commented." + (interactive "r\nP") + (goto-char beg) + (if (looking-at comment-start-skip) + (comment-region beg end '(4)) + (comment-region beg end))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Help functions + +(defun vera-customize () + "Call the customize function with `vera' as argument." + (interactive) + (customize-group 'vera)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Other + +;; remove ".vr" from `completion-ignored-extensions' +(setq completion-ignored-extensions + (delete ".vr" completion-ignored-extensions)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Bug reports +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst vera-mode-help-address "Reto Zimmermann <reto@gnu.org>" + "Address for Vera Mode bug reports.") + +;; get reporter-submit-bug-report when byte-compiling +(eval-when-compile + (require 'reporter)) + +(defun vera-submit-bug-report () + "Submit via mail a bug report on Vera Mode." + (interactive) + ;; load in reporter + (and + (y-or-n-p "Do you want to submit a report on Vera Mode? ") + (require 'reporter) + (let ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report + vera-mode-help-address + (concat "Vera Mode " vera-version) + (list + ;; report all important variables + 'vera-basic-offset + 'vera-underscore-is-part-of-word + 'vera-intelligent-tab + ) + nil nil + "Hi Reto,")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Documentation +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun vera-version () + "Echo the current version of Vera Mode in the minibuffer." + (interactive) + (message "Vera Mode %s (%s)" vera-version vera-time-stamp)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(provide 'vera-mode) + +;; arch-tag: 22eae722-7ac5-47ac-a713-c4db1cf623a9 +;;; vera-mode.el ends here diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 04eb19a6bca..a99e1843513 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1233,5 +1233,9 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (provide 'ps-mule) -;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe +;; Local Variables: +;; generated-autoload-file: "ps-print.el" +;; End: + +;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe ;;; ps-mule.el ends here diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 3cc887fd40f..b059d56b9c4 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3638,7 +3638,7 @@ The table depends on the current ps-print setup." ;; ps-page-dimensions-database ;; ps-font-info-database -;;; ps-print - end of settings\n") +\;;; ps-print - end of settings\n") "\n"))) @@ -6466,24 +6466,129 @@ If FACE is not a valid face name, use default face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. + +;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-encode-header-string +;;;;;; ps-mule-initialize ps-mule-plot-composition ps-mule-plot-string +;;;;;; ps-mule-set-ascii-font ps-mule-prepare-ascii-font ps-multibyte-buffer) +;;;;;; "ps-mule" "ps-mule.el" "464a9fb9d59f7561a46bcd5ca87d85db") +;;; Generated autoloads from ps-mule.el + +(defvar ps-multibyte-buffer nil "\ +*Specifies the multi-byte buffer handling. + +Valid values are: + + nil This is the value to use the default settings which + is by default for printing buffer with only ASCII + and Latin characters. The default setting can be + changed by setting the variable + `ps-mule-font-info-database-default' differently. + The initial value of this variable is + `ps-mule-font-info-database-latin' (see + documentation). + + `non-latin-printer' This is the value to use when you have a Japanese + or Korean PostScript printer and want to print + buffer with ASCII, Latin-1, Japanese (JISX0208 and + JISX0201-Kana) and Korean characters. At present, + it was not tested the Korean characters printing. + If you have a korean PostScript printer, please, + test it. + + `bdf-font' This is the value to use when you want to print + buffer with BDF fonts. BDF fonts include both latin + and non-latin fonts. BDF (Bitmap Distribution + Format) is a format used for distributing X's font + source file. BDF fonts are included in + `intlfonts-1.2' which is a collection of X11 fonts + for all characters supported by Emacs. In order to + use this value, be sure to have installed + `intlfonts-1.2' and set the variable + `bdf-directory-list' appropriately (see ps-bdf.el for + documentation of this variable). + + `bdf-font-except-latin' This is like `bdf-font' except that it is used + PostScript default fonts to print ASCII and Latin-1 + characters. This is convenient when you want or + need to use both latin and non-latin characters on + the same buffer. See `ps-font-family', + `ps-header-font-family' and `ps-font-info-database'. + +Any other value is treated as nil.") + +(custom-autoload (quote ps-multibyte-buffer) "ps-mule" t) + +(autoload (quote ps-mule-prepare-ascii-font) "ps-mule" "\ +Setup special ASCII font for STRING. +STRING should contain only ASCII characters. + +\(fn STRING)" nil nil) + +(autoload (quote ps-mule-set-ascii-font) "ps-mule" "\ +Not documented + +\(fn)" nil nil) + +(autoload (quote ps-mule-plot-string) "ps-mule" "\ +Generate PostScript code for plotting characters in the region FROM and TO. + +It is assumed that all characters in this region belong to the same charset. + +Optional argument BG-COLOR specifies background color. + +Returns the value: + + (ENDPOS . RUN-WIDTH) + +Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of +the sequence. + +\(fn FROM TO &optional BG-COLOR)" nil nil) + +(autoload (quote ps-mule-plot-composition) "ps-mule" "\ +Generate PostScript code for plotting composition in the region FROM and TO. + +It is assumed that all characters in this region belong to the same +composition. + +Optional argument BG-COLOR specifies background color. + +Returns the value: + + (ENDPOS . RUN-WIDTH) + +Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of +the sequence. + +\(fn FROM TO &optional BG-COLOR)" nil nil) + +(autoload (quote ps-mule-initialize) "ps-mule" "\ +Initialize global data for printing multi-byte characters. + +\(fn)" nil nil) + +(autoload (quote ps-mule-encode-header-string) "ps-mule" "\ +Generate PostScript code for ploting STRING by font FONTTAG. +FONTTAG should be a string \"/h0\" or \"/h1\". + +\(fn STRING FONTTAG)" nil nil) -(autoload 'ps-mule-initialize "ps-mule" - "Initialize global data for printing multi-byte characters.") +(autoload (quote ps-mule-begin-job) "ps-mule" "\ +Start printing job for multi-byte chars between FROM and TO. +This checks if all multi-byte characters in the region are printable or not. -(autoload 'ps-mule-begin-job "ps-mule" - "Start printing job for multi-byte chars between FROM and TO. -This checks if all multi-byte characters in the region are printable or not.") +\(fn FROM TO)" nil nil) -(autoload 'ps-mule-begin-page "ps-mule" - "Initialize multi-byte charset for printing current page.") +(autoload (quote ps-mule-begin-page) "ps-mule" "\ +Not documented -(autoload 'ps-mule-end-job "ps-mule" - "Finish printing job for multi-byte chars.") +\(fn)" nil nil) +;;;*** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'ps-print) -;;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579 +;; arch-tag: fb06a585-1112-4206-885d-a57d95d50579 ;;; ps-print.el ends here diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 037638e8d43..4438cb7e30b 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -29,7 +29,7 @@ ;;; Commentary: ;; This library provides a minor mode to display a ruler in the header -;; line. It works only on Emacs 21. +;; line. It works from Emacs 21 onwards. ;; ;; You can use the mouse to change the `fill-column' `comment-column', ;; `goal-column', `window-margins' and `tab-stop-list' settings: @@ -561,7 +561,8 @@ Call `ruler-mode-ruler-function' to compute the ruler value.") (progn ;; When `ruler-mode' is on save previous header line format ;; and install the ruler header line format. - (when (local-variable-p 'header-line-format) + (when (and (local-variable-p 'header-line-format) + (not (local-variable-p 'ruler-mode-header-line-format-old))) (set (make-local-variable 'ruler-mode-header-line-format-old) header-line-format)) (setq header-line-format ruler-mode-header-line-format) diff --git a/lisp/shell.el b/lisp/shell.el index 9e07540d9d8..7171fbbe0f0 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -5,7 +5,7 @@ ;; Author: Olin Shivers <shivers@cs.cmu.edu> ;; Simon Marshall <simon@gnu.org> -;; Maintainer: FSF +;; Maintainer: FSF <emacs-devel@gnu.org> ;; Keywords: processes ;; This file is part of GNU Emacs. @@ -27,11 +27,6 @@ ;;; Commentary: -;; Please send me bug reports, bug fixes, and extensions, so that I can -;; merge them into the master source. -;; - Olin Shivers (shivers@cs.cmu.edu) -;; - Simon Marshall (simon@gnu.org) - ;; This file defines a shell-in-a-buffer package (shell mode) built on ;; top of comint mode. This is actually cmushell with things renamed ;; to replace its counterpart in Emacs 18. cmushell is more diff --git a/lisp/simple.el b/lisp/simple.el index 4cabd0cad69..3bda23ebd1f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -156,6 +156,15 @@ If `fringe-arrow', indicate the locus by the fringe arrow." :group 'next-error :version "22.1") +(defcustom next-error-recenter nil + "*Display the line in the visited source file recentered as specified. +If non-nil, the value is passed directly to `recenter'." + :type '(choice (integer :tag "Line to recenter to") + (const :tag "Center of window" (4)) + (const :tag "No recentering" nil)) + :group 'next-error + :version "23.1") + (defcustom next-error-hook nil "*List of hook functions run by `next-error' after visiting source file." :type 'hook @@ -305,6 +314,8 @@ See variables `compilation-parse-errors-function' and ;; we know here that next-error-function is a valid symbol we can funcall (with-current-buffer next-error-last-buffer (funcall next-error-function (prefix-numeric-value arg) reset) + (when next-error-recenter + (recenter next-error-recenter)) (run-hooks 'next-error-hook)))) (defun next-error-internal () @@ -313,6 +324,8 @@ See variables `compilation-parse-errors-function' and ;; we know here that next-error-function is a valid symbol we can funcall (with-current-buffer next-error-last-buffer (funcall next-error-function 0 nil) + (when next-error-recenter + (recenter next-error-recenter)) (run-hooks 'next-error-hook))) (defalias 'goto-next-locus 'next-error) @@ -2189,6 +2202,18 @@ value passed." (when stderr-file (delete-file stderr-file)) (when lc (delete-file lc))))) +(defun start-file-process (name buffer program &rest program-args) + "Start a program in a subprocess. Return the process object for it. +Similar to `start-process', but may invoke a file handler based on +`default-directory'. The current working directory of the +subprocess is `default-directory'. + +PROGRAM and PROGRAM-ARGS might be file names. They are not +objects of file handler invocation." + (let ((fh (find-file-name-handler default-directory 'start-file-process))) + (if fh (apply fh 'start-file-process name buffer program program-args) + (apply 'start-process name buffer program program-args)))) + (defvar universal-argument-map @@ -5246,10 +5271,10 @@ PREFIX is the string that represents this modifier in an event type symbol." ;;;; Keypad support. -;;; Make the keypad keys act like ordinary typing keys. If people add -;;; bindings for the function key symbols, then those bindings will -;;; override these, so this shouldn't interfere with any existing -;;; bindings. +;; Make the keypad keys act like ordinary typing keys. If people add +;; bindings for the function key symbols, then those bindings will +;; override these, so this shouldn't interfere with any existing +;; bindings. ;; Also tell read-char how to handle these keys. (mapc diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 87176d0c1c8..4ecb0ec7dd3 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -10,7 +10,7 @@ "The current version of speedbar.") (defvar speedbar-incompatible-version "0.14beta4" "This version of speedbar is incompatible with this version. -Due to massive API changes (removing the use of the word PATH) +Due to massive API changes (removing the use of the word PATH) this version is not backward compatible to 0.14 or earlier.") ;; This file is part of GNU Emacs. @@ -915,7 +915,7 @@ This basically creates a sparse keymap, and makes its parent be (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))] ) "Additional menu items while in file-mode.") - + (defvar speedbar-easymenu-definition-trailer (append (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) @@ -958,13 +958,13 @@ directories.") (defalias 'speedbar-make-overlay (if (featurep 'xemacs) 'make-extent 'make-overlay)) -(defalias 'speedbar-overlay-put +(defalias 'speedbar-overlay-put (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) -(defalias 'speedbar-delete-overlay +(defalias 'speedbar-delete-overlay (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) -(defalias 'speedbar-mode-line-update +(defalias 'speedbar-mode-line-update (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) ;;; Mode definitions/ user commands @@ -1053,10 +1053,10 @@ supported at a time. "Handle a delete frame event E. If the deleted frame is the frame SPEEDBAR is attached to, we need to delete speedbar also." - (let ((frame-to-be-deleted (car (car (cdr e))))) - (if (eq frame-to-be-deleted dframe-attached-frame) - (delete-frame speedbar-frame))) - ) + (when (and speedbar-frame + (eq (car (car (cdr e))) ;; frame to be deleted + dframe-attached-frame)) + (delete-frame speedbar-frame))) ;;;###autoload (defun speedbar-get-focus () @@ -1158,7 +1158,7 @@ return true without a query." ;; Backwards compatibility (defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer) (defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame) - + (defun speedbar-set-mode-line-format () "Set the format of the mode line based on the current speedbar environment. This gives visual indications of what is up. It EXPECTS the speedbar @@ -2055,7 +2055,7 @@ position to insert a new item, and that the new item will end with a CR." (if tag-button-function 'speedbar-highlight-face nil) tag-button-function tag-button-data)) )) - + (defun speedbar-change-expand-button-char (char) "Change the expansion button character to CHAR for the current line." (save-excursion @@ -2100,7 +2100,7 @@ cell of the form ( 'DIRLIST . 'FILELIST )." (defun speedbar-default-directory-list (directory index) "Insert files for DIRECTORY with level INDEX at point." - (speedbar-insert-files-at-point + (speedbar-insert-files-at-point (speedbar-file-lists directory) index) (speedbar-reset-scanners) (if (= index 0) @@ -2454,7 +2454,7 @@ name will have the function FIND-FUN and not token." (speedbar-insert-generic-list indent lst 'speedbar-tag-expand 'speedbar-tag-find)) - + (defun speedbar-insert-etags-list (indent lst) "At level INDENT, insert the etags generated LST." (speedbar-insert-generic-list indent lst @@ -2729,7 +2729,7 @@ If new functions are added, their state needs to be updated here." "Go to the line where FILE is." (set-buffer speedbar-buffer) - + (goto-char (point-min)) (let ((m nil)) (while (and (setq m (re-search-forward @@ -3220,7 +3220,7 @@ directory with these items. This function is replaceable in (widen) (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-directory))) (if rf (funcall rf depth) default-directory)))) - + (defun speedbar-files-line-directory (&optional depth) "Retrieve the directoryname associated with the current line. This may require traversing backwards from DEPTH and combining the default @@ -3305,12 +3305,12 @@ With universal argument ARG, flush cached data." (forward-char -2) (speedbar-do-function-pointer)) (error (speedbar-position-cursor-on-line))))) - + (defun speedbar-flush-expand-line () "Expand the line under the cursor and flush any cached information." (interactive) (speedbar-expand-line 1)) - + (defun speedbar-contract-line () "Contract the line under the cursor." (interactive) @@ -3559,11 +3559,11 @@ This assumes that the cursor is on a file, or tag of a file which the user is interested in." (save-selected-window - + (select-window (get-buffer-window speedbar-buffer t)) - + (set-buffer speedbar-buffer) - + (if (<= (count-lines (point-min) (point-max)) (1- (window-height (selected-window)))) ;; whole buffer fits diff --git a/lisp/startup.el b/lisp/startup.el index 5f4081277a0..9e2d211ea1e 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1056,7 +1056,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" (if (eq major-mode 'fundamental-mode) - (funcall initial-major-mode)))) + (funcall initial-major-mode)) + ;; Don't lose text that users type in *scratch*. + (setq buffer-offer-save t) + (auto-save-mode 1))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. diff --git a/lisp/subr.el b/lisp/subr.el index 42f2049ace2..ff43b9f9c7f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2768,6 +2768,36 @@ Modifies the match data; use `save-match-data' if necessary." (cons (substring string start) list))) (nreverse list))) + +;; (string->strings (strings->string X)) == X +(defun strings->string (strings &optional separator) + "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). +This tries to quote the strings to avoid ambiguity such that + (string->strings (strings->string strs)) == strs +Only some SEPARATORs will work properly." + (let ((sep (or separator " "))) + (mapconcat + (lambda (str) + (if (string-match "[\\\"]" str) + (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") + str)) + strings sep))) + +;; (string->strings (strings->string X)) == X +(defun string->strings (string &optional separator) + "Split the STRING into a list of strings. +It understands elisp style quoting within STRING such that + (string->strings (strings->string strs)) == strs +The SEPARATOR regexp defaults to \"\\s-+\"." + (let ((sep (or separator "\\s-+")) + (i (string-match "[\"]" string))) + (if (null i) (split-string string sep t) ; no quoting: easy + (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) + (let ((rfs (read-from-string string i))) + (cons (car rfs) + (string->strings (substring string (cdr rfs)) + sep))))))) + ;;;; Replacement in strings. diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 7cffa61930a..beae009d85e 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -1041,8 +1041,18 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;; make f10 activate the real menubar rather than the mini-buffer menu ;;; navigation feature. -(global-set-key [f10] (lambda () - (interactive) (w32-send-sys-command ?\xf100))) +(defun menu-bar-open (&optional frame) + "Start key navigation of the menu bar in FRAME. + +This initially activates the first menu-bar item, and you can then navigate +with the arrow keys, select a menu entry with the Return key or cancel with +the Escape key. If FRAME has no menu bar, this function does nothing. + +If FRAME is nil or not given, use the selected frame." + (interactive "i") + (w32-send-sys-command ?\xf100 frame)) +; +(global-set-key [f10] 'menu-bar-open) (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 0b413e3b7ab..377c90b7bed 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -34,7 +34,7 @@ ;; Major mode for editing and validating BibTeX files. ;; Usage: -;; See documentation for function bibtex-mode or type "\M-x describe-mode" +;; See documentation for `bibtex-mode' or type "M-x describe-mode" ;; when you are in BibTeX mode. ;; Todo: @@ -112,6 +112,7 @@ required-fields Signal an error if a required field is missing. numerical-fields Delete delimiters around numeral fields. page-dashes Change double dashes in page field to single dash (for scribe compatibility). +whitespace Delete whitespace at the beginning and end of fields. inherit-booktitle If entry contains a crossref field and the booktitle field is empty, set the booktitle field to the content of the title field of the crossreferenced entry. @@ -123,6 +124,10 @@ last-comma Add or delete comma on end of last field in entry, delimiters Change delimiters according to variables `bibtex-field-delimiters' and `bibtex-entry-delimiters'. unify-case Change case of entry and field names. +braces Enclose parts of field entries by braces according to + `bibtex-field-braces-alist'. +strings Replace parts of field entries by string constants + according to `bibtex-field-strings-alist'. The value t means do all of the above formatting actions. The value nil means do no formatting at all." @@ -134,11 +139,35 @@ The value nil means do no formatting at all." (const required-fields) (const numerical-fields) (const page-dashes) + (const whitespace) (const inherit-booktitle) (const realign) (const last-comma) (const delimiters) - (const unify-case)))) + (const unify-case) + (const braces) + (const strings)))) + +(defcustom bibtex-field-braces-alist nil + "Alist of field regexps that \\[bibtex-clean-entry] encloses by braces. +Each element has the form (FIELDS REGEXP), where FIELDS is a list +of BibTeX field names and REGEXP is a regexp. +Whitespace in REGEXP will be replaced by \"[ \\t\\n]+\"." + :group 'bibtex + :type '(repeat (list (repeat (string :tag "field name")) + (choice (regexp :tag "regexp") + (sexp :tag "sexp"))))) + +(defcustom bibtex-field-strings-alist nil + "Alist of regexps that \\[bibtex-clean-entry] replaces by string constants. +Each element has the form (FIELDS REGEXP TO-STR), where FIELDS is a list +of BibTeX field names. In FIELDS search for REGEXP, which are replaced +by the BibTeX string constant TO-STR. +Whitespace in REGEXP will be replaced by \"[ \\t\\n]+\"." + :group 'bibtex + :type '(repeat (list (repeat (string :tag "field name")) + (regexp :tag "From regexp") + (regexp :tag "To string constant")))) (defcustom bibtex-clean-entry-hook nil "List of functions to call when entry has been cleaned. @@ -899,6 +928,17 @@ The following is a complex example, see http://link.aps.org/linkfaq.html. (function :tag "Filter")))))))) (put 'bibtex-generate-url-list 'risky-local-variable t) +(defcustom bibtex-cite-matcher-alist + '(("\\\\cite[ \t\n]*{\\([^}]+\\)}" . 1)) + "Alist of rules to identify cited keys in a BibTeX entry. +Each rule should be of the form (REGEXP . SUBEXP), where SUBEXP +specifies which parenthesized expression in REGEXP is a cited key. +Case is significant. +Used by `bibtex-find-crossref' and for font-locking." + :group 'bibtex + :type '(repeat (cons (regexp :tag "Regexp") + (integer :tag "Number")))) + (defcustom bibtex-expand-strings nil "If non-nil, expand strings when extracting the content of a BibTeX field." :group 'bibtex @@ -1070,6 +1110,17 @@ The following is a complex example, see http://link.aps.org/linkfaq.html. ;; Internal Variables +(defvar bibtex-field-braces-opt nil + "Optimized value of `bibtex-field-braces-alist'. +Created by `bibtex-field-re-init'. +It is a an alist with elements (FIELD . REGEXP).") + +(defvar bibtex-field-strings-opt nil + "Optimized value of `bibtex-field-strings-alist'. +Created by `bibtex-field-re-init'. +It is a an alist with elements (FIELD RULE1 RULE2 ...), +where each RULE is (REGEXP . TO-STR).") + (defvar bibtex-pop-previous-search-point nil "Next point where `bibtex-pop-previous' starts looking for a similar entry.") @@ -1215,7 +1266,11 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=") 1 font-lock-variable-name-face) ;; url - (bibtex-font-lock-url) (bibtex-font-lock-crossref)) + (bibtex-font-lock-url) (bibtex-font-lock-crossref) + ;; cite + ,@(mapcar (lambda (matcher) + `((lambda (bound) (bibtex-font-lock-cite ',matcher bound)))) + bibtex-cite-matcher-alist)) "*Default expressions to highlight in BibTeX mode.") (defvar bibtex-font-lock-url-regexp @@ -1223,7 +1278,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (concat "^[ \t]*" (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t) "[ \t]*=[ \t]*") - "Regexp for `bibtex-font-lock-url'.") + "Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.") (defvar bibtex-string-empty-key nil "If non-nil, `bibtex-parse-string' accepts empty key.") @@ -1553,7 +1608,7 @@ If EMPTY-KEY is non-nil, key may be empty. Do not move point." bounds)))) (defun bibtex-reference-key-in-string (bounds) - "Return the key part of a BibTeX string defined via BOUNDS" + "Return the key part of a BibTeX string defined via BOUNDS." (buffer-substring-no-properties (nth 1 (car bounds)) (nth 2 (car bounds)))) @@ -1626,8 +1681,8 @@ of the entry, see regexp `bibtex-entry-head'." (if (save-excursion (goto-char (match-end bibtex-type-in-head)) (looking-at "[ \t]*(")) - ",?[ \t\n]*)" ;; entry opened with `(' - ",?[ \t\n]*}")) ;; entry opened with `{' + ",?[ \t\n]*)" ; entry opened with `(' + ",?[ \t\n]*}")) ; entry opened with `{' bounds) (skip-chars-forward " \t\n") ;; loop over all BibTeX fields @@ -1736,7 +1791,7 @@ If FLAG is nil, a message is echoed if point was incremented at least (< (point) pnt)) (goto-char (match-beginning bibtex-type-in-head)) (if (pos-visible-in-window-p (point)) - (sit-for 1) + (sit-for blink-matching-delay) (message "%s%s" prompt (buffer-substring-no-properties (point) (match-end bibtex-key-in-head)))))))) @@ -1801,21 +1856,19 @@ Optional arg BEG is beginning of entry." "Reinsert the Nth stretch of killed BibTeX text (field or entry). Optional arg COMMA is as in `bibtex-enclosing-field'." (unless bibtex-last-kill-command (error "BibTeX kill ring is empty")) - (let ((fun (lambda (kryp kr) ;; adapted from `current-kill' + (let ((fun (lambda (kryp kr) ; adapted from `current-kill' (car (set kryp (nthcdr (mod (- n (length (eval kryp))) (length kr)) kr)))))) (if (eq bibtex-last-kill-command 'field) (progn ;; insert past the current field (goto-char (bibtex-end-of-field (bibtex-enclosing-field comma))) - (set-mark (point)) - (message "Mark set") + (push-mark) (bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer bibtex-field-kill-ring) t nil t)) ;; insert past the current entry (bibtex-skip-to-valid-entry) - (set-mark (point)) - (message "Mark set") + (push-mark) (insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring))))) @@ -1835,6 +1888,15 @@ Formats current entry according to variable `bibtex-entry-format'." crossref-key bounds alternatives-there non-empty-alternative entry-list req-field-list field-list) + ;; Initialize `bibtex-field-braces-opt' and `bibtex-field-strings-opt' + ;; if necessary. + (unless bibtex-field-braces-opt + (setq bibtex-field-braces-opt + (bibtex-field-re-init bibtex-field-braces-alist 'braces))) + (unless bibtex-field-strings-opt + (setq bibtex-field-strings-opt + (bibtex-field-re-init bibtex-field-strings-alist 'strings))) + ;; identify entry type (goto-char (point-min)) (or (re-search-forward bibtex-entry-type nil t) @@ -1904,7 +1966,7 @@ Formats current entry according to variable `bibtex-entry-format'." deleted) ;; We have more elegant high-level functions for several - ;; tasks done by bibtex-format-entry. However, they contain + ;; tasks done by `bibtex-format-entry'. However, they contain ;; quite some redundancy compared with what we need to do ;; anyway. So for speed-up we avoid using them. @@ -1957,6 +2019,59 @@ Formats current entry according to variable `bibtex-entry-format'." "\\([\"{][0-9]+\\)[ \t\n]*--?[ \t\n]*\\([0-9]+[\"}]\\)"))) (replace-match "\\1-\\2")) + ;; remove whitespace at beginning and end of field + (when (memq 'whitespace format) + (goto-char beg-text) + (if (looking-at "\\([{\"]\\)[ \t\n]+") + (replace-match "\\1")) + (goto-char end-text) + (if (looking-back "[ \t\n]+\\([}\"]\\)" beg-text t) + (replace-match "\\1"))) + + ;; enclose field text by braces according to + ;; `bibtex-field-braces-alist'. + (let (case-fold-search temp) ; Case-sensitive search + (when (and (memq 'braces format) + (setq temp (cdr (assoc-string field-name + bibtex-field-braces-opt t)))) + (goto-char beg-text) + (while (re-search-forward temp end-text t) + (let ((beg (match-beginning 0)) + (bounds (bibtex-find-text-internal nil t))) + (unless (or (nth 4 bounds) ; string constant + ;; match already surrounded by braces + ;; (braces are inside field delimiters) + (and (< (point) (1- (nth 2 bounds))) + (< (1+ (nth 1 bounds)) beg) + (looking-at "}") + (save-excursion (goto-char (1- beg)) + (looking-at "{")))) + (insert "}") + (goto-char beg) + (insert "{"))))) + + ;; replace field text by BibTeX string constants according to + ;; `bibtex-field-strings-alist'. + (when (and (memq 'strings format) + (setq temp (cdr (assoc-string field-name + bibtex-field-strings-opt t)))) + (goto-char beg-text) + (dolist (re temp) + (while (re-search-forward (car re) end-text t) + (let ((bounds (save-match-data + (bibtex-find-text-internal nil t)))) + (unless (nth 4 bounds) + ;; if match not at right subfield boundary... + (if (< (match-end 0) (1- (nth 2 bounds))) + (insert " # " (bibtex-field-left-delimiter)) + (delete-char 1)) + (replace-match (cdr re)) + (goto-char (match-beginning 0)) + ;; if match not at left subfield boundary... + (if (< (1+ (nth 1 bounds)) (match-beginning 0)) + (insert (bibtex-field-right-delimiter) " # ") + (delete-backward-char 1)))))))) + ;; use book title of crossref'd entry (if (and (memq 'inherit-booktitle format) empty-field @@ -2047,6 +2162,31 @@ Formats current entry according to variable `bibtex-entry-format'." (if (memq 'realign format) (bibtex-fill-entry)))))) +(defun bibtex-field-re-init (regexp-alist type) + "Calculate optimized value for bibtex-regexp-TYPE-opt. +This value is based on bibtex-regexp-TYPE-alist. TYPE is 'braces or 'strings. +Return optimized value to be used by `bibtex-format-entry'." + (setq regexp-alist + (mapcar (lambda (e) + (list (car e) + (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" (nth 1 e)) + (nth 2 e))) ; nil for 'braces'. + regexp-alist)) + (let (opt-list) + ;; Loop over field names + (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist)))) + (let (rules) + ;; Collect all matches we have for this field name + (dolist (e regexp-alist) + (if (assoc-string field (car e) t) + (push (cons (nth 1 e) (nth 2 e)) rules))) + (if (eq type 'braces) + ;; concatenate all regexps to a single regexp + (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)"))) + ;; create list of replacement rules. + (push (cons field rules) opt-list))) + opt-list)) + (defun bibtex-autokey-abbrev (string len) "Return an abbreviation of STRING with at least LEN characters. @@ -2099,7 +2239,7 @@ and `bibtex-autokey-names-stretch'." (<= (length name-list) (+ bibtex-autokey-names bibtex-autokey-names-stretch))) - ;; Take bibtex-autokey-names elements from beginning of name-list + ;; Take `bibtex-autokey-names' elements from beginning of name-list (setq name-list (nreverse (nthcdr (- (length name-list) bibtex-autokey-names) (nreverse name-list))) @@ -2161,7 +2301,7 @@ Return the result as a string" (setq word (match-string 0 titlestring) titlestring (substring titlestring (match-end 0))) ;; Ignore words matched by one of the elements of - ;; bibtex-autokey-titleword-ignore + ;; `bibtex-autokey-titleword-ignore' (unless (let ((lst bibtex-autokey-titleword-ignore)) (while (and lst (not (string-match (concat "\\`\\(?:" (car lst) @@ -2173,9 +2313,9 @@ Return the result as a string" (<= counter bibtex-autokey-titlewords)) (push word titlewords) (push word titlewords-extra)))) - ;; Obey bibtex-autokey-titlewords-stretch: + ;; Obey `bibtex-autokey-titlewords-stretch': ;; If by now we have processed all words in titlestring, we include - ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. + ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. (unless (string-match "\\b\\w+" titlestring) (setq titlewords (append titlewords-extra titlewords))) (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords) @@ -2343,7 +2483,7 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil." (push (cons key t) ref-keys))))))) (let (;; ignore @String entries because they are handled - ;; separately by bibtex-parse-strings + ;; separately by `bibtex-parse-strings' (bibtex-sort-ignore-string-entries t) bounds) (bibtex-map-entries @@ -2399,7 +2539,7 @@ Return alist of strings if parsing was completed, `aborted' otherwise." (setq bibtex-strings strings)))))) (defun bibtex-strings () - "Return `bibtex-strings'. Initialize this variable if necessary." + "Return `bibtex-strings'. Initialize this variable if necessary." (if (listp bibtex-strings) bibtex-strings (bibtex-parse-strings (bibtex-string-files-init)))) @@ -2456,10 +2596,10 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'." bibtex-buffer-last-parsed-tick))) (save-restriction (widen) - ;; Output no progress messages in bibtex-parse-keys - ;; because when in y-or-n-p that can hide the question. + ;; Output no progress messages in `bibtex-parse-keys' + ;; because when in `y-or-n-p' that can hide the question. (if (and (listp (bibtex-parse-keys t)) - ;; update bibtex-strings + ;; update `bibtex-strings' (listp (bibtex-parse-strings strings-init t))) ;; remember that parsing was successful @@ -2519,28 +2659,35 @@ already set." COMPLETIONS is an alist of strings. If point is not after the part of a word, all strings are listed. Return completion." ;; Return value is used by cleanup functions. + ;; Code inspired by `lisp-complete-symbol'. (let* ((case-fold-search t) (beg (save-excursion (re-search-backward "[ \t{\"]") (forward-char) (point))) (end (point)) - (part-of-word (buffer-substring-no-properties beg end)) - (completion (try-completion part-of-word completions))) + (pattern (buffer-substring-no-properties beg end)) + (completion (try-completion pattern completions))) (cond ((not completion) - (error "Can't find completion for `%s'" part-of-word)) + (error "Can't find completion for `%s'" pattern)) ((eq completion t) - part-of-word) - ((not (string= part-of-word completion)) + pattern) + ((not (string= pattern completion)) (delete-region beg end) (insert completion) + ;; Don't leave around a completions buffer that's out of date. + (let ((win (get-buffer-window "*Completions*" 0))) + (if win (with-selected-window win (bury-buffer)))) completion) (t - (message "Making completion list...") - (with-output-to-temp-buffer "*Completions*" - (display-completion-list (all-completions part-of-word completions) - part-of-word)) - (message "Making completion list...done") + (let ((minibuf-is-in-use + (eq (minibuffer-window) (selected-window)))) + (unless minibuf-is-in-use (message "Making completion list...")) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list + (sort (all-completions pattern completions) 'string<) pattern)) + (unless minibuf-is-in-use + (message "Making completion list...done"))) nil)))) (defun bibtex-complete-string-cleanup (str compl) @@ -2562,20 +2709,25 @@ Use `bibtex-summary-function' to generate summary." (bibtex-find-entry key t)) (message "Ref: %s" (funcall bibtex-summary-function))))) -(defun bibtex-copy-summary-as-kill () +(defun bibtex-copy-summary-as-kill (&optional arg) "Push summery of current BibTeX entry to kill ring. -Use `bibtex-summary-function' to generate summary." - (interactive) - (save-excursion - (bibtex-beginning-of-entry) - (if (looking-at bibtex-entry-maybe-empty-head) - (kill-new (message "%s" (funcall bibtex-summary-function))) - (error "No entry found")))) +Use `bibtex-summary-function' to generate summary. +If prefix ARG is non-nil push BibTeX entry's URL to kill ring +that is generated by calling `bibtex-url'." + (interactive "P") + (if arg (let ((url (bibtex-url nil t))) + (if url (kill-new (message "%s" url)) + (message "No URL known"))) + (save-excursion + (bibtex-beginning-of-entry) + (if (looking-at bibtex-entry-maybe-empty-head) + (kill-new (message "%s" (funcall bibtex-summary-function))) + (error "No entry found"))))) (defun bibtex-summary () "Return summary of current BibTeX entry. Used as default value of `bibtex-summary-function'." - ;; It would be neat to customize this function. How? + ;; It would be neat to make this function customizable. How? (if (looking-at bibtex-entry-maybe-empty-head) (let* ((bibtex-autokey-name-case-convert-function 'identity) (bibtex-autokey-name-length 'infty) @@ -2664,16 +2816,17 @@ begins at the beginning of a line. We use this function for font-locking." (unless (looking-at field-reg) (re-search-backward field-reg nil t)))) -(defun bibtex-font-lock-url (bound) - "Font-lock for URLs. BOUND limits the search." +(defun bibtex-font-lock-url (bound &optional no-button) + "Font-lock for URLs. BOUND limits the search. +If NO-BUTTON is non-nil do not generate buttons." (let ((case-fold-search t) (pnt (point)) - field bounds start end found) + name bounds start end found) (bibtex-beginning-of-field) (while (and (not found) (<= (point) bound) (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t) - (setq field (match-string-no-properties 1))) + (setq name (match-string-no-properties 1))) (setq bounds (bibtex-parse-field-text)) (progn (setq start (car bounds) end (nth 1 bounds)) @@ -2682,17 +2835,18 @@ begins at the beginning of a line. We use this function for font-locking." (setq end (1- end))) (if (memq (char-after start) '(?\{ ?\")) (setq start (1+ start))) - (>= bound start))) - (let ((lst bibtex-generate-url-list) url) - (goto-char start) - (while (and (not found) - (setq url (car (pop lst)))) - (setq found (and (bibtex-string= field (car url)) - (re-search-forward (cdr url) end t) - (>= (match-beginning 0) pnt))))) - (goto-char end)) - (if found (bibtex-button (match-beginning 0) (match-end 0) - 'bibtex-url (match-beginning 0))) + (if (< start pnt) (setq start (min pnt end))) + (<= start bound))) + (if (<= pnt start) + (let ((lst bibtex-generate-url-list) url) + (while (and (not found) (setq url (car (pop lst)))) + (goto-char start) + (setq found (and (bibtex-string= name (car url)) + (re-search-forward (cdr url) end t)))))) + (unless found (goto-char end))) + (if (and found (not no-button)) + (bibtex-button (match-beginning 0) (match-end 0) + 'bibtex-url (match-beginning 0))) found)) (defun bibtex-font-lock-crossref (bound) @@ -2713,6 +2867,19 @@ begins at the beginning of a line. We use this function for font-locking." start t)) found)) +(defun bibtex-font-lock-cite (matcher bound) + "Font-lock for cited keys. +MATCHER identifies the cited key, see `bibtex-cite-matcher-alist'. +BOUND limits the search." + (let (case-fold-search) + (if (re-search-forward (car matcher) bound t) + (let ((start (match-beginning (cdr matcher))) + (end (match-end (cdr matcher)))) + (bibtex-button start end 'bibtex-find-crossref + (buffer-substring-no-properties start end) + start t t) + t)))) + (defun bibtex-button-action (button) "Call BUTTON's BibTeX function." (apply (button-get button 'bibtex-function) @@ -2831,7 +2998,7 @@ if that value is non-nil. (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t) (make-local-variable 'choose-completion-string-functions) - ;; XEmacs needs easy-menu-add, Emacs does not care + ;; XEmacs needs `easy-menu-add', Emacs does not care (easy-menu-add bibtex-edit-menu) (easy-menu-add bibtex-entry-menu) (run-mode-hooks 'bibtex-mode-hook)) @@ -3125,7 +3292,7 @@ Return the new location of point." (goto-char (bibtex-end-of-string bounds))) ((looking-at bibtex-any-valid-entry-type) ;; Parsing of entry failed - (error "Syntactically incorrect BibTeX entry starts here.")) + (error "Syntactically incorrect BibTeX entry starts here")) (t (if (interactive-p) (message "Not on a known BibTeX entry.")) (goto-char pnt))) (point))) @@ -3163,7 +3330,7 @@ Otherwise display the beginning of entry." (defun bibtex-mark-entry () "Put mark at beginning, point at end of current BibTeX entry." (interactive) - (set-mark (bibtex-beginning-of-entry)) + (push-mark (bibtex-beginning-of-entry)) (bibtex-end-of-entry)) (defun bibtex-count-entries (&optional count-string-entries) @@ -3227,6 +3394,7 @@ of the head of the entry found. Return nil if no entry found." (list key nil entry-name)))))) (defun bibtex-init-sort-entry-class-alist () + "Initialize `bibtex-sort-entry-class-alist' (buffer-local)." (unless (local-variable-p 'bibtex-sort-entry-class-alist) (set (make-local-variable 'bibtex-sort-entry-class-alist) (let ((i -1) alist) @@ -3283,27 +3451,49 @@ are ignored." nil ; ENDKEY function 'bibtex-lessp)) ; PREDICATE -(defun bibtex-find-crossref (crossref-key &optional pnt split) +(defun bibtex-find-crossref (crossref-key &optional pnt split noerror) "Move point to the beginning of BibTeX entry CROSSREF-KEY. If `bibtex-files' is non-nil, search all these files. Otherwise the search is limited to the current buffer. Return position of entry if CROSSREF-KEY is found or nil otherwise. If CROSSREF-KEY is in the same buffer like current entry but before it -an error is signaled. Optional arg PNT is the position of the referencing -entry. It defaults to position of point. If optional arg SPLIT is non-nil, -split window so that both the referencing and the crossrefed entry are -displayed. -If called interactively, CROSSREF-KEY defaults to crossref key of current -entry and SPLIT is t." +an error is signaled. If NOERRER is non-nil this error is suppressed. +Optional arg PNT is the position of the referencing entry. It defaults +to position of point. If optional arg SPLIT is non-nil, split window +so that both the referencing and the crossrefed entry are displayed. + +If called interactively, CROSSREF-KEY defaults to either the crossref key +of current entry or a key matched by `bibtex-cite-matcher-alist', +whatever is nearer to the position of point. SPLIT is t. NOERROR is nil +for a crossref key, t otherwise." (interactive - (let ((crossref-key - (save-excursion - (bibtex-beginning-of-entry) - (let ((bounds (bibtex-search-forward-field "crossref" t))) - (if bounds - (bibtex-text-in-field-bounds bounds t)))))) - (list (bibtex-read-key "Find crossref key: " crossref-key t) - (point) t))) + (save-excursion + (let* ((pnt (point)) + (_ (bibtex-beginning-of-entry)) + (end (cdr (bibtex-valid-entry t))) + (_ (unless end (error "Not inside valid entry"))) + (beg (match-end 0)) ; set by `bibtex-valid-entry' + (bounds (bibtex-search-forward-field "crossref" end)) + case-fold-search best temp crossref-key) + (if bounds + (setq crossref-key (bibtex-text-in-field-bounds bounds t) + best (cons (bibtex-dist pnt (bibtex-end-of-field bounds) + (bibtex-start-of-field bounds)) + crossref-key))) + (dolist (matcher bibtex-cite-matcher-alist) + (goto-char beg) + (while (re-search-forward (car matcher) end t) + (setq temp (bibtex-dist pnt (match-end (cdr matcher)) + (match-beginning (cdr matcher)))) + ;; Accept the key closest to the position of point. + (if (or (not best) (< temp (car best))) + (setq best (cons temp (match-string-no-properties + (cdr matcher))))))) + (goto-char pnt) + (setq temp (bibtex-read-key "Find crossref key: " (cdr best) t)) + (list temp (point) t (not (and crossref-key + (string= temp crossref-key))))))) + (let (buffer pos eqb) (save-excursion (setq pos (bibtex-find-entry crossref-key t) @@ -3314,13 +3504,15 @@ entry and SPLIT is t." (split ; called (quasi) interactively (unless pnt (setq pnt (point))) (goto-char pnt) - (if eqb (select-window (split-window)) - (pop-to-buffer buffer)) - (goto-char pos) - (bibtex-reposition-window) - (beginning-of-line) - (if (and eqb (> pnt pos)) - (error "The referencing entry must precede the crossrefed entry!"))) + (if (and eqb (= pos (save-excursion (bibtex-beginning-of-entry)))) + (message "Key `%s' is current entry" crossref-key) + (if eqb (select-window (split-window)) + (pop-to-buffer buffer)) + (goto-char pos) + (bibtex-reposition-window) + (beginning-of-line) + (if (and eqb (> pnt pos) (not noerror)) + (error "The referencing entry must precede the crossrefed entry!")))) ;; `bibtex-find-crossref' is called noninteractively during ;; clean-up of an entry. Then it is not possible to check ;; whether the current entry and the crossrefed entry have @@ -3329,6 +3521,12 @@ entry and SPLIT is t." (t (set-buffer buffer) (goto-char pos))) pos)) +(defun bibtex-dist (pos beg end) + "Return distance between POS and region delimited by BEG and END." + (cond ((and (<= beg pos) (<= pos end)) 0) + ((< pos beg) (- beg pos)) + (t (- pos end)))) + (defun bibtex-find-entry (key &optional global start display) "Move point to the beginning of BibTeX entry named KEY. Return position of entry if KEY is found or nil if not found. @@ -3394,7 +3592,7 @@ Return t if preparation was successful or nil if entry KEY already exists." ;; if key-exist is non-nil due to the previous cond clause ;; then point will be at beginning of entry named key. (key-exist) - (t ; bibtex-maintain-sorted-entries is non-nil + (t ; `bibtex-maintain-sorted-entries' is non-nil (let* ((case-fold-search t) (left (save-excursion (bibtex-beginning-of-first-entry))) (bounds (save-excursion (goto-char (point-max)) @@ -3576,7 +3774,7 @@ Return t if test was successful, nil otherwise." (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" + "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)))) @@ -3737,7 +3935,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." end-text (or (match-end bibtex-key-in-head) (match-end 0)) end end-text - no-sub t) ;; subfields do not make sense + no-sub t) ; subfields do not make sense (setq failure t))) (t (setq failure t))) (when (and subfield (not failure)) @@ -3926,8 +4124,8 @@ begin on separate lines prior to calling `bibtex-clean-entry' or if Don't call `bibtex-clean-entry' on @Preamble entries. At end of the cleaning process, the functions in `bibtex-clean-entry-hook' are called with region narrowed to entry." - ;; Opt. arg called-by-reformat is t if bibtex-clean-entry - ;; is called by bibtex-reformat + ;; Opt. arg CALLED-BY-REFORMAT is t if `bibtex-clean-entry' + ;; is called by `bibtex-reformat' (interactive "P") (let ((case-fold-search t) (start (bibtex-beginning-of-entry)) @@ -3946,7 +4144,7 @@ At end of the cleaning process, the functions in ;; set key (when (or new-key (not key)) (setq key (bibtex-generate-autokey)) - ;; Sometimes bibtex-generate-autokey returns an empty string + ;; Sometimes `bibtex-generate-autokey' returns an empty string (if (or bibtex-autokey-edit-before-use (string= "" key)) (setq key (if (eq entry-type 'string) (bibtex-read-string-key key) @@ -4027,7 +4225,7 @@ If optional arg MOVE is non-nil move point to end of field." (if (not justify) (goto-char (bibtex-start-of-text-in-field bounds)) (goto-char (bibtex-start-of-field bounds)) - (forward-char) ;; leading comma + (forward-char) ; leading comma (bibtex-delete-whitespace) (open-line 1) (forward-char) @@ -4045,7 +4243,7 @@ If optional arg MOVE is non-nil move point to end of field." (if bibtex-align-at-equal-sign (insert " ") (indent-to-column bibtex-text-indentation))) - ;; Paragraphs within fields are not preserved. Bother? + ;; Paragraphs within fields are not preserved. Bother? (fill-region-as-paragraph (line-beginning-position) end-field default-justification nil (point)) (if move (goto-char end-field)))) @@ -4130,15 +4328,19 @@ If mark is active reformat entries in region, if not in whole buffer." (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") " comma at end of entry? ") . 'last-comma) ("Replace double page dashes by single ones? " . 'page-dashes) + ("Delete whitespace at the beginning and end of fields? " . 'whitespace) ("Inherit booktitle? " . 'inherit-booktitle) ("Force delimiters? " . 'delimiters) - ("Unify case of entry types and field names? " . 'unify-case)))))) + ("Unify case of entry types and field names? " . 'unify-case) + ("Enclose parts of field entries by braces? " . 'braces) + ("Replace parts of field entries by string constants? " . 'strings)))))) ;; Do not include required-fields because `bibtex-reformat' ;; cannot handle the error messages of `bibtex-format-entry'. ;; Use `bibtex-validate' to check for required fields. ((eq t bibtex-entry-format) '(realign opts-or-alts numerical-fields delimiters - last-comma page-dashes unify-case inherit-booktitle)) + last-comma page-dashes unify-case inherit-booktitle + whitespace braces strings)) (t (remove 'required-fields (push 'realign bibtex-entry-format))))) (reformat-reference-keys @@ -4178,7 +4380,7 @@ entries from minibuffer." (message "Starting to validate buffer...") (sit-for 1 nil t) (bibtex-realign) - (deactivate-mark) ; So bibtex-validate works on the whole buffer. + (deactivate-mark) ; So `bibtex-validate' works on the whole buffer. (if (not (let (bibtex-maintain-sorted-entries) (bibtex-validate))) (message "Correct errors and call `bibtex-convert-alien' again") @@ -4186,7 +4388,7 @@ entries from minibuffer." (sit-for 2 nil t) (bibtex-reformat read-options) (goto-char (point-max)) - (message "Buffer is now parsable. Please save it."))) + (message "Buffer is now parsable. Please save it."))) (defun bibtex-complete () "Complete word fragment before point according to context. @@ -4249,7 +4451,7 @@ An error is signaled if point is outside key or BibTeX field." ;; ;; If we quit the *Completions* buffer without requesting ;; a completion, `choose-completion-string-functions' is still - ;; non-nil. Therefore, `choose-completion-string-functions' is + ;; non-nil. Therefore, `choose-completion-string-functions' is ;; always set (either to non-nil or nil) when a new completion ;; is requested. (let (completion-ignore-case) @@ -4276,7 +4478,7 @@ An error is signaled if point is outside key or BibTeX field." (setq choose-completion-string-functions nil) (choose-completion-string choice buffer base-size) (bibtex-complete-string-cleanup choice ',compl) - t)) ; needed by choose-completion-string-functions + t)) ; needed by `choose-completion-string-functions' (bibtex-complete-string-cleanup (bibtex-complete-internal compl) compl))) @@ -4391,44 +4593,94 @@ An error is signaled if point is outside key or BibTeX field." "Browse a URL for the BibTeX entry at point. Optional POS is the location of the BibTeX entry. The URL is generated using the schemes defined in `bibtex-generate-url-list' -\(see there\). Then the URL is passed to `browse-url' unless NO-BROWSE is nil. +\(see there\). If multiple schemes match for this entry, or the same scheme +matches more than once, use the one for which the first step's match is the +closest to POS. The URL is passed to `browse-url' unless NO-BROWSE is t. Return the URL or nil if none can be generated." (interactive) + (unless pos (setq pos (point))) (save-excursion - (if pos (goto-char pos)) + (goto-char pos) (bibtex-beginning-of-entry) - ;; Always remove field delimiters - (let ((fields-alist (bibtex-parse-entry t)) + (let ((end (save-excursion (bibtex-end-of-entry))) + (fields-alist (save-excursion (bibtex-parse-entry t))) ;; Always ignore case, (case-fold-search t) - (lst bibtex-generate-url-list) - field url scheme obj fmt) - (while (setq scheme (pop lst)) - (when (and (setq field (cdr (assoc-string (caar scheme) - fields-alist t))) - (string-match (cdar scheme) field)) - (setq lst nil - scheme (cdr scheme) - url (if (null scheme) (match-string 0 field) - (if (stringp (car scheme)) - (setq fmt (pop scheme))) - (dolist (step scheme) - (setq field (cdr (assoc-string (car step) fields-alist t))) - (if (string-match (nth 1 step) field) - (push (cond ((functionp (nth 2 step)) - (funcall (nth 2 step) field)) - ((numberp (nth 2 step)) - (match-string (nth 2 step) field)) - (t - (replace-match (nth 2 step) t nil field))) - obj) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (error "Match failed: %s" field))) - (if fmt (apply 'format fmt (nreverse obj)) - (apply 'concat (nreverse obj))))) - (if (interactive-p) (message "%s" url)) - (unless no-browse (browse-url url)))) + text url scheme obj fmt fl-match step) + ;; The return value of `bibtex-parse-entry' (i.e., FIELDS-ALIST) + ;; is always used to generate the URL. However, if the BibTeX + ;; entry contains more than one URL, we have multiple matches + ;; for the first step defining the generation of the URL. + ;; Therefore, we try to initiate the generation of the URL + ;; based on the match of `bibtex-font-lock-url' that is the + ;; closest to POS. If that fails (no match found) we try to + ;; initiate the generation of the URL based on the properly + ;; concatenated CONTENT of the field as returned by + ;; `bibtex-text-in-field-bounds'. The latter approach can + ;; differ from the former because `bibtex-font-lock-url' uses + ;; the buffer itself. + (while (bibtex-font-lock-url end t) + (push (list (bibtex-dist pos (match-beginning 0) (match-end 0)) + (match-beginning 0) + (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + fl-match) + ;; `bibtex-font-lock-url' moves point to end of match. + (forward-char)) + (when fl-match + (setq fl-match (car (sort fl-match (lambda (x y) (< (car x) (car y)))))) + (goto-char (nth 1 fl-match)) + (bibtex-beginning-of-field) (re-search-backward ",") + (let* ((bounds (bibtex-parse-field)) + (name (bibtex-name-in-field bounds)) + (content (bibtex-text-in-field-bounds bounds t)) + (lst bibtex-generate-url-list)) + ;; This match can fail when CONTENT differs from text in buffer. + (when (string-match (regexp-quote (nth 2 fl-match)) content) + ;; TEXT is the part of CONTENT that starts with the match + ;; of `bibtex-font-lock-url' we are looking for. + (setq text (substring content (match-beginning 0))) + (while (and (not url) (setq scheme (pop lst))) + ;; Verify the match of `bibtex-font-lock-url' by + ;; comparing with TEXT. + (when (and (bibtex-string= (caar scheme) name) + (string-match (cdar scheme) text)) + (setq url t scheme (cdr scheme))))))) + + ;; If the match of `bibtex-font-lock-url' was not approved + ;; parse FIELDS-ALIST, i.e., the output of `bibtex-parse-entry'. + (unless url + (let ((lst bibtex-generate-url-list)) + (while (and (not url) (setq scheme (pop lst))) + (when (and (setq text (cdr (assoc-string (caar scheme) + fields-alist t))) + (string-match (cdar scheme) text)) + (setq url t scheme (cdr scheme)))))) + + (when url + (setq url (if (null scheme) (match-string 0 text) + (if (stringp (car scheme)) + (setq fmt (pop scheme))) + (dotimes (i (length scheme)) + (setq step (nth i scheme)) + ;; The first step shall use TEXT as obtained earlier. + (unless (= i 0) + (setq text (cdr (assoc-string (car step) fields-alist t)))) + (if (string-match (nth 1 step) text) + (push (cond ((functionp (nth 2 step)) + (funcall (nth 2 step) text)) + ((numberp (nth 2 step)) + (match-string (nth 2 step) text)) + (t + (replace-match (nth 2 step) t nil text))) + obj) + ;; If SCHEME is set up correctly, + ;; we should never reach this point + (error "Match failed: %s" text))) + (if fmt (apply 'format fmt (nreverse obj)) + (apply 'concat (nreverse obj))))) + (if (interactive-p) (message "%s" url)) + (unless no-browse (browse-url url))) (if (and (not url) (interactive-p)) (message "No URL known.")) url))) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index ad0485fbb30..086f5156f28 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -66,6 +66,8 @@ ;; ' used otherwise). (modify-syntax-entry ?\" "\" 2" st) ;; Comments are delimited by \" and newline. + ;; And in groff also \# to newline. + (modify-syntax-entry ?# ". 2" st) (modify-syntax-entry ?\\ "\\ 1" st) (modify-syntax-entry ?\n ">" st) st) @@ -92,7 +94,7 @@ (mapconcat 'identity '("[f*n]*\\[.+?]" ; some groff extensions "(.." ; two chars after ( - "[^(\"]" ; single char escape + "[^(\"#]" ; single char escape ) "\\|") "\\)") ) @@ -127,7 +129,7 @@ closing requests for requests that are used in matched pairs." (concat "[.']\\|" paragraph-separate)) ;; comment syntax added by mit-erl!gildea 18 Apr 86 (set (make-local-variable 'comment-start) "\\\" ") - (set (make-local-variable 'comment-start-skip) "\\\\\"[ \t]*") + (set (make-local-variable 'comment-start-skip) "\\\\[\"#][ \t]*") (set (make-local-variable 'comment-column) 24) (set (make-local-variable 'comment-indent-function) 'nroff-comment-indent) (set (make-local-variable 'imenu-generic-expression) nroff-imenu-expression)) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index d669ebe586c..244f9bb0bce 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.77 +;; Version: 5.01 ;; ;; This file is part of GNU Emacs. ;; @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "4.77" +(defconst org-version "5.01" "The version number of the file org.el.") (defun org-version () (interactive) @@ -97,6 +97,29 @@ (get-text-property 0 'test (format "%s" x))) "Does format transport text properties?") +(defmacro org-unmodified (&rest body) + "Execute body without changing buffer-modified-p." + `(set-buffer-modified-p + (prog1 (buffer-modified-p) ,@body))) + +(defmacro org-re (s) + "Replace posix classes in regular expression." + (if (featurep 'xemacs) + (let ((ss s)) + (save-match-data + (while (string-match "\\[:alnum:\\]" ss) + (setq ss (replace-match "a-zA-Z0-9" t t ss))) + ss)) + s)) + +(defmacro org-preserve-lc (&rest body) + `(let ((_line (org-current-line)) + (_col (current-column))) + (unwind-protect + (progn ,@body) + (goto-line _line) + (move-to-column _col)))) + ;;; The custom variables (defgroup org nil @@ -251,6 +274,11 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defcustom org-archived-string "ARCHIVED:" + "String used as the prefix for timestamps logging archiving a TODO entry." + :group 'org-keywords + :type 'string) + (defcustom org-clock-string "CLOCK:" "String used as prefix for timestamps clocking work hours on an item." :group 'org-keywords @@ -388,6 +416,18 @@ contexts. See `org-show-hierarchy-above' for valid contexts." :tag "Org Cycle" :group 'org-structure) +(defcustom org-drawers '("PROPERTIES") + "Names of drawers. Drawers are not opened by cycling on the headline above. +Drawers only open with a TAB on the drawer line itself. A drawer looks like +this: + :DRAWERNAME: + ..... + :END: +The drawer \"PROPERTIES\" is special for capturing properties through +the property API." + :group 'org-structure + :type '(repeat (string :tag "Drawer Name"))) + (defcustom org-cycle-global-at-bob t "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or @@ -432,6 +472,7 @@ Special case: when 0, never leave empty lines in collapsed view." :type 'integer) (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-cycle-hide-drawers org-cycle-show-empty-lines org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. @@ -656,10 +697,7 @@ line like :type 'boolean) (defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to entries moved to an archive file. -The time stamp will be added directly after the TODO state keyword in the -first line, so it is probably best to use this in combinations with -`org-archive-mark-done'." + "Non-nil means, add a time stamp to entries moved to an archive file." :group 'org-archive :type 'boolean) @@ -880,8 +918,6 @@ from the `constants.el' package." :group 'org-table-calculation :type 'boolean) -;; FIXME this is also a variable that makes Org-mode files non-portable -;; Maybe I should have a #+ options for constants? (defcustom org-table-formula-constants nil "Alist with constant names and values, for use in table formulas. The car of each element is a name of a constant, without the `$' before it. @@ -890,12 +926,20 @@ speed of light in a formula, you would configure (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) -and then use it in an equation like `$1*$c'." +and then use it in an equation like `$1*$c'. + +Constants can also be defined on a per-file basis using a line like + +#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" :group 'org-table-calculation :type '(repeat (cons (string :tag "name") (string :tag "value")))) +(defvar org-table-formula-constants-local nil + "Local version of `org-table-formula-constants'.") +(make-variable-buffer-local 'org-table-formula-constants-local) + (defcustom org-table-allow-automatic-line-recalculation t "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. Automatically means, when TAB or RET or C-c C-c are pressed in the line." @@ -973,6 +1017,7 @@ Changing this variable requires a restart of Emacs to become effective." (const :tag "plain text links" plain) (const :tag "Radio target matches" radio) (const :tag "Tags" tag) + (const :tag "Tags" target) (const :tag "Timestamps" date))) (defgroup org-link-store nil @@ -1299,7 +1344,7 @@ When not nil, this is a list of 4-element lists. In each entry, the first element is a character, a unique key to select this template. The second element is the template. The third element is optional and can specify a destination file for remember items created with this template. -The default file is given by `org-default-notes-file'. An optional third +The default file is given by `org-default-notes-file'. An optional forth element can specify the headline in that file that should be offered first when the user is asked to file the entry. The default headline is given in the variable `org-remember-default-headline'. @@ -1580,7 +1625,8 @@ To turn this on on a per-file basis, insert anywhere in the file: '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american "Custom formats for time stamps. See `format-time-string' for the syntax. These are overlayed over the default ISO format if the variable -`org-display-custom-times' is set." +`org-display-custom-times' is set. Time like %H:%M should be at the +end of the second format." :group 'org-time :type 'sexp) @@ -1704,6 +1750,28 @@ make sure all corresponding TODO items find their way into the list." (defvar org-last-tags-completion-table nil "The last used completion table for tags.") +(defgroup org-properties nil + "Options concerning properties in Org-mode." + :tag "Org Properties" + :group 'org) + +(defcustom org-property-format "%-10s %s" + "How property key/value pairs should be formatted by `indent-line'. +When `indent-line' hits a property definition, it will format the line +according to this format, mainly to make sure that the values are +lined-up with respect to each other." + :group 'org-properties + :type 'string) + +(defcustom org-default-columns-format "%25ITEM %TODO %3PRIORITY %TAGS" + "The default column format, if no other format has been defined. +This variable can be set on the per-file basis by inserting a line + +#+COLUMNS: %25ITEM ....." + :group 'org-properties + :type 'string) + + (defgroup org-agenda nil "Options concerning agenda views in Org-mode." :tag "Org Agenda" @@ -2325,6 +2393,17 @@ the headline/diary entry." (const :tag "Never" nil) (const :tag "When at beginning of entry" beg))) + +(defcustom org-agenda-default-appointment-duration nil + "Default duration for appointments that only have a starting time. +When nil, no duration is specified in such cases. +When non-nil, this must be the number of minutes, e.g. 60 for one hour." + :group 'org-agenda-prefix + :type '(choice + (integer :tag "Minutes") + (const :tag "No default duration"))) + + (defcustom org-agenda-remove-tags nil "Non-nil means, remove the tags from the headline copy in the agenda. When this is the symbol `prefix', only remove tags when @@ -2531,6 +2610,14 @@ contents entries, but still be shown in the headlines of the document." (const :tag "Not in TOC" not-in-toc) (const :tag "On" t))) +(defcustom org-export-with-property-drawer nil + "Non-nil means, export property drawers. +When nil, these drawers are removed before export. + +This option can also be set with the +OPTIONS line, e.g. \"p:t\"." + :group 'org-export-general + :type 'boolean) + (defgroup org-export-translation nil "Options for translating special ascii sequences for the export backends." :tag "Org Export Translation" @@ -2547,6 +2634,14 @@ This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." :group 'org-export-translation :type 'boolean) +(defcustom org-export-with-footnotes t + "If nil, export [1] as a footnote marker. +Lines starting with [1] will be formatted as footnotes. + +This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." + :group 'org-export-translation + :type 'boolean) + (defcustom org-export-with-sub-superscripts t "Non-nil means, interpret \"_\" and \"^\" for export. When this option is turned on, you can use TeX-like syntax for sub- and @@ -2682,7 +2777,7 @@ In the given sequence, these characters will be used for level 1, 2, ..." (defcustom org-export-ascii-bullets '(?* ?+ ?-) "Bullet characters for headlines converted to lists in ASCII export. -The first character is used for the first lest level generated in this +The first character is is used for the first lest level generated in this way, and so on. If there are more levels than characters given here, the list will be repeated. Note that plain lists will keep the same bullets as the have in the @@ -2700,6 +2795,11 @@ Org-mode file." :tag "Org Export HTML" :group 'org-export) +(defcustom org-export-html-coding-system nil + "" + :group 'org-export-html + :type 'coding-system) + (defcustom org-export-html-style "<style type=\"text/css\"> html { @@ -3001,6 +3101,8 @@ Use customize to modify this, or restart Emacs after changing it." :tag "Org Faces" :group 'org-font-lock) +;; FIXME: convert that into a macro? Not critical, because this +;; is only executed a few times at load time. (defun org-compatible-face (specs) "Make a compatible face specification. XEmacs and Emacs 21 do not know about the `min-colors' attribute. @@ -3115,6 +3217,33 @@ color of the frame." "Face used for special keywords." :group 'org-faces) +(defface org-drawer ;; font-lock-function-name-face + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) + "Face used for drawers." + :group 'org-faces) + +(defface org-property-value nil + "Face used for the value of a property." + :group 'org-faces) + +(defface org-column + (org-compatible-face + '((((class color) (min-colors 16) (background light)) + (:background "grey90")) + (((class color) (min-colors 16) (background dark)) + (:background "grey30")) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black")) + (t (:inverse-video t)))) + "Face for column display of entry properties." + :group 'org-faces) + (defface org-warning ;; font-lock-warning-face (org-compatible-face '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) @@ -3145,6 +3274,13 @@ color of the frame." "Face for links." :group 'org-faces) +(defface org-target + '((((class color) (background light)) (:underline t)) + (((class color) (background dark)) (:underline t)) + (t (:underline t))) + "Face for links." + :group 'org-faces) + (defface org-date '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) @@ -3271,6 +3407,9 @@ to the part of the headline after the DONE keyword." ;;; Variables for pre-computed regular expressions, all buffer local +(defvar org-drawer-regexp nil + "Matches first line of a hidden block.") +(make-variable-buffer-local 'org-drawer-regexp) (defvar org-todo-regexp nil "Matches any of the TODO state keywords.") (make-variable-buffer-local 'org-todo-regexp) @@ -3337,7 +3476,9 @@ Also put tags into group 4 if tags are present.") (match-string-no-properties num string))) (defsubst org-no-properties (s) - (remove-text-properties 0 (length s) org-rm-props s) + (if (fboundp 'set-text-properties) + (set-text-properties 0 (length s) nil s) + (remove-text-properties 0 (length s) org-rm-props s)) s) (defsubst org-get-alist-option (option key) @@ -3409,10 +3550,11 @@ means to push this value onto the list in the variable.") (org-set-local 'org-todo-heads nil) (org-set-local 'org-todo-sets nil) (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" - "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES"))) + '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "COLUMNS" + "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" + "CONSTANTS"))) (splitre "[ \t]+") - kwds key value cat arch tags links hw dws tail sep kws1 prio) + kwds key value cat arch tags const links hw dws tail sep kws1 prio) (save-excursion (save-restriction (widen) @@ -3430,6 +3572,8 @@ means to push this value onto the list in the variable.") (push (cons 'type (org-split-string value splitre)) kwds)) ((equal key "TAGS") (setq tags (append tags (org-split-string value splitre)))) + ((equal key "COLUMNS") + (org-set-local 'org-default-columns-format value)) ((equal key "LINK") (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) (push (cons (match-string 1 value) @@ -3437,6 +3581,8 @@ means to push this value onto the list in the variable.") links))) ((equal key "PRIORITIES") (setq prio (org-split-string value " +"))) + ((equal key "CONSTANTS") + (setq const (append const (org-split-string value splitre)))) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) l var val) @@ -3487,6 +3633,14 @@ means to push this value onto the list in the variable.") (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) (setq org-todo-sets (nreverse org-todo-sets) org-todo-kwd-alist (nreverse org-todo-kwd-alist))) + ;; Process the constants + (when const + (let (e cst) + (while (setq e (pop const)) + (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))) + ;; Process the tags. (when tags (let (e tgs) @@ -3494,7 +3648,7 @@ means to push this value onto the list in the variable.") (cond ((equal e "{") (push '(:startgroup) tgs)) ((equal e "}") (push '(:endgroup) tgs)) - ((string-match "^\\([0-9a-zA-Z_@]+\\)(\\(.\\))$" e) + ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) (string-to-char (match-string 2 e))) tgs)) @@ -3510,6 +3664,10 @@ means to push this value onto the list in the variable.") (setq org-done-keywords (list (org-last org-todo-keywords-1)))) (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) (length org-scheduled-string))) + org-drawer-regexp + (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$") org-not-done-keywords (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) org-todo-regexp @@ -3530,7 +3688,8 @@ means to push this value onto the list in the variable.") org-todo-line-tags-regexp (concat "^\\(\\*+\\)[ \t]*\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)? *\\(.*?\\([ \t]:[a-zA-Z0-9:_@]+:[ \t]*\\)?$\\)") + (org-re + "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) org-looking-at-done-regexp (concat "^" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" @@ -3550,23 +3709,28 @@ means to push this value onto the list in the variable.") (concat "\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string + "\\|" org-archived-string "\\|" org-clock-string "\\)" " *[[<]\\([^]>]+\\)[]>]") org-keyword-time-not-clock-regexp (concat "\\<\\(" org-scheduled-string "\\|" org-deadline-string - "\\|" org-closed-string "\\)" + "\\|" org-closed-string + "\\|" org-archived-string + "\\)" " *[[<]\\([^]>]+\\)[]>]") org-maybe-keyword-time-regexp (concat "\\(\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string + "\\|" org-archived-string "\\|" org-clock-string "\\)\\)?" " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") org-planning-or-clock-line-re (concat "\\(?:^[ \t]*\\(" org-scheduled-string "\\|" org-deadline-string - "\\|" org-closed-string "\\|" org-clock-string "\\)\\>\\)") + "\\|" org-closed-string "\\|" org-clock-string + "\\|" org-archived-string "\\)\\>\\)") ) (org-set-font-lock-defaults))) @@ -3959,7 +4123,7 @@ that will be added to PLIST. Returns the string that was modified." "Matches plain link, without spaces.") (defconst org-bracket-link-regexp - "\\[\\[\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]" + "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" "Matches a link in double brackets.") (defconst org-bracket-link-analytic-regexp @@ -3986,11 +4150,14 @@ that will be added to PLIST. Returns the string that was modified." "Regular expression for fast time stamp matching.") (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" "Regular expression for fast time stamp matching.") +(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis. +This one does not require the space after the date.") (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" "Regular expression matching time strings for analysis.") -(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,6\\}>") +(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,11\\}>") "Regular expression matching time stamps, with groups.") -(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,6\\}[]>]") +(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,11\\}[]>]") "Regular expression matching time stamps (also [..]), with groups.") (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) "Regular expression matching a time stamp range.") @@ -4162,7 +4329,9 @@ We use a macro so that the test can happen at compilation time." (defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" "Regular expression matching a link target.") (defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" - "Regular expression matching a link target.") + "Regular expression matching a radio target.") +(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. + "Regular expression matching any target.") (defun org-activate-target-links (limit) "Run through the buffer and add overlays to target matches." @@ -4230,7 +4399,7 @@ between words." "\\)\\>"))) (defun org-activate-tags (limit) - (if (re-search-forward "[ \t]\\(:[A-Za-z_@0-9:]+:\\)[ \r\n]" limit t) + (if (re-search-forward (org-re "[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) (progn (add-text-properties (match-beginning 1) (match-end 1) (list 'mouse-face 'highlight @@ -4275,6 +4444,7 @@ between words." (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) + (list (concat "\\<" org-archived-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) ;; Emphasis (if em @@ -4306,6 +4476,13 @@ between words." '("^[ \t]*\\(:.*\\)" (1 'org-table t)) '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) + ;; Drawers + (list org-drawer-regexp '(0 'org-drawer t)) + (list "^[ \t]*:END:" '(0 'org-drawer t)) + ;; Properties + '("^[ \t]*\\(:[a-zA-Z0-9]+:\\)[ \t]*\\(\\S-.*\\)" + (1 'org-special-keyword t) (2 'org-property-value t)) +;FIXME (1 'org-tag t) (2 'org-property-value t)) (if org-format-transports-properties-p '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) @@ -4324,7 +4501,6 @@ between words." "Get the right face for match N in font-lock matching of healdines." (setq org-l (- (match-end 2) (match-beginning 1))) (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) -; (setq org-f (nth (1- (% org-l org-n-levels)) org-level-faces)) (setq org-f (nth (% (1- org-l) org-n-levels) org-level-faces)) (cond ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) @@ -4378,8 +4554,8 @@ between words." `indent-relative', like TAB normally does. See the option `org-cycle-emulate-tab' for details. -- Special case: if point is the beginning of the buffer and there is no - headline in line 1, this function will act as if called with prefix arg." +- 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." (interactive "P") (let* ((outline-regexp (if (and (org-mode-p) org-cycle-include-plain-lists) @@ -4436,6 +4612,14 @@ between words." (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview)))) + ((and org-drawers + (save-excursion + (beginning-of-line 1) + (looking-at org-drawer-regexp))) + ;; Toggle block visibility + (org-flag-drawer + (not (get-char-property (match-end 0) 'invisible)))) + ((integerp arg) ;; Show-subtree, ARG levels up from here. (save-excursion @@ -4971,6 +5155,9 @@ in the region." ((eolp) (insert " ")) ((equal (char-after) ?\ ) (forward-char 1)))))) +(defun org-reduced-level (l) + (if org-odd-levels-only (1+ (floor (/ l 2))) l)) + (defun org-get-legal-level (level &optional change) "Rectify a level change under the influence of `org-odd-levels-only' LEVEL is a current level, CHANGE is by how much the level should be @@ -5454,7 +5641,6 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) - (defun org-in-item-p () "It the cursor inside a plain list item. Does not have to be the first line." @@ -5549,7 +5735,9 @@ the whole buffer." (interactive "P") (save-excursion (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (progn (outline-back-to-heading) (point))) + (beg (condition-case nil + (progn (outline-back-to-heading) (point)) + (error (point-min)))) (end (move-marker (make-marker) (progn (outline-next-heading) (point)))) (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") @@ -5714,9 +5902,9 @@ Error if not at a plain list, or if this is the last item in the list." (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 last item in the list." +Error if not at a plain list, or if this is the first item in the list." (interactive) - (let (beg ind (pos (point))) + (let (beg ind ind1 (pos (point))) (org-beginning-of-item) (setq beg (point)) (setq ind (org-get-indentation)) @@ -5726,10 +5914,13 @@ Error if not at a plain list, or if this is the last item in the list." (beginning-of-line 0) (if (looking-at "[ \t]*$") nil - (if (<= (org-get-indentation) ind) + (if (<= (setq ind1 (org-get-indentation)) ind) (throw 'exit t))))) (condition-case nil - (org-beginning-of-item) + (if (or (not (org-at-item-p)) + (< ind1 (1- ind))) + (error "") + (org-beginning-of-item)) (error (goto-char pos) (error "On first item"))))) @@ -5802,10 +5993,45 @@ so this really moves item trees." "Renumber the ordered list at point if setup allows it. This tests the user option `org-auto-renumber-ordered-lists' before doing the renumbering." - (and org-auto-renumber-ordered-lists - (org-at-item-p) - (match-beginning 3) - (org-renumber-ordered-list 1))) + (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 1)))) + +(defun org-maybe-renumber-ordered-list-safe () + (condition-case nil + (save-excursion + (org-maybe-renumber-ordered-list)) + (error nil))) + +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: + + `-' -> `+' -> `*' -> `1.' -> `1)' + +If WHICH is a string, use that as the new bullet. If WHICH is an integer, +0 meand `-', 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)) new) + (setq new (cond + ((and which (nth (1- which) '("-" "+" "*" "1." "1)")))) + ((string-match "-" current) "+") + ((string-match "\\+" current) + (if (looking-at "\\S-") "1." "*")) + ((string-match "\\*" current) "1.") + ((string-match "\\." current) "1)") + ((string-match ")" current) "-") + (t (error "This should not happen")))) + (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new))) + (org-fix-bullet-type 1) + (org-maybe-renumber-ordered-list)))) (defun org-get-string-indentation (s) "What indentation has S due to SPACE and TAB at the beginning of the string?" @@ -5831,19 +6057,46 @@ with something like \"1.\" or \"2)\"." (ind (org-get-string-indentation (buffer-substring (point-at-bol) (match-beginning 3)))) ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg))) + ind1 (n (1- arg)) + fmt) ;; find where this list begins + (org-beginning-of-item-list) + (looking-at "[ \t]*[0-9]+\\([.)]\\)") + (setq fmt (concat "%d" (match-string 1))) + (beginning-of-line 0) + ;; walk forward and replace these numbers (catch 'exit (while t (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") (throw 'next t)) + (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 (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p)))) - (throw 'exit t))))) - ;; Walk forward and replace these numbers + (if (> ind1 ind) (throw 'next t)) + (if (< ind1 ind) (throw 'exit t)) + (if (not (org-at-item-p)) (throw 'exit nil)) + (delete-region (match-beginning 2) (match-end 2)) + (goto-char (match-beginning 2)) + (insert (format fmt (setq n (1+ n))))))) + (goto-line line) + (move-to-column col))) + +(defun org-fix-bullet-type (arg) + "Make sure all items in this list have the same bullet." + (interactive "p") + (unless (org-at-item-p) (error "This is not a list")) + (let ((line (org-current-line)) + (col (current-column)) + (ind (current-indentation)) + ind1 bullet) + ;; 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 (match-string 1)) + ;; walk forward and replace these numbers + (beginning-of-line 0) (catch 'exit (while t (catch 'next @@ -5854,13 +6107,35 @@ with something like \"1.\" or \"2)\"." (if (> ind1 ind) (throw 'next t)) (if (< ind1 ind) (throw 'exit t)) (if (not (org-at-item-p)) (throw 'exit nil)) - (if (not (match-beginning 3)) - (error "unordered bullet in ordered list. Press \\[undo] to recover")) - (delete-region (match-beginning 3) (1- (match-end 3))) - (goto-char (match-beginning 3)) - (insert (format "%d" (setq n (1+ n))))))) + (skip-chars-forward " \t") + (looking-at "\\S-+") + (replace-match bullet)))) (goto-line line) - (move-to-column col))) + (move-to-column col) + (if (string-match "[0-9]" bullet) + (org-renumber-ordered-list 1)))) + +(defun org-beginning-of-item-list () + "Go to the beginning of the current item list. +I.e. to the first item in this list." + (interactive) + (org-beginning-of-item) + (let ((pos (point-at-bol)) + (ind (org-get-indentation)) + ind1) + ;; find where this list begins + (catch 'exit + (while t + (catch 'next + (beginning-of-line 0) + (if (looking-at "[ \t]*$") (throw 'next t)) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (if (or (< ind1 ind) + (and (= ind1 ind) + (not (org-at-item-p)))) + (throw 'exit t) + (when (org-at-item-p) (setq pos (point-at-bol))))))) + (goto-char pos))) (defvar org-last-indent-begin-marker (make-marker)) (defvar org-last-indent-end-marker (make-marker)) @@ -5876,7 +6151,7 @@ with something like \"1.\" or \"2)\"." (unless (org-at-item-p) (error "Not on an item")) (save-excursion - (let (beg end ind ind1) + (let (beg end ind ind1 tmp delta ind-down ind-up) (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) (setq beg org-last-indent-begin-marker end org-last-indent-end-marker) @@ -5885,14 +6160,225 @@ with something like \"1.\" or \"2)\"." (org-end-of-item) (setq end (move-marker org-last-indent-end-marker (point)))) (goto-char beg) - (skip-chars-forward " \t") (setq ind (current-column)) - (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) + (setq tmp (org-item-indent-positions) + ind (car tmp) + ind-down (nth 2 tmp) + ind-up (nth 1 tmp) + delta (if (> arg 0) + (if ind-down (- ind-down ind) (+ 2 ind)) + (if ind-up (- ind-up ind) (- 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)) - (indent-to-column (+ ind1 arg)) - (beginning-of-line 2))))) + (or (eolp) (indent-to-column (+ ind1 delta))) + (beginning-of-line 2)))) + (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 () + "Assumes cursor in item line. FIXME" + (let* ((bolpos (point-at-bol)) + (ind (org-get-indentation)) + ind-down ind-up 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 pos (point)) + (save-excursion + (cond + ((and (condition-case nil (progn (org-previous-item) t) + (error nil)) + (or (forward-char 1) t) + (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) + (setq ind-down (org-get-indentation))) + ((and (goto-char pos) + (org-at-item-p)) + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (setq ind-down (current-column))))) + (list ind ind-up ind-down))) + +;;; The orgstruct minor mode + +;; Define a minor mode which can be used in other modes in order to +;; integrate the org-mode structure editing commands. + +;; This is really a hack, because the org-mode structure commands use +;; keys which normally belong to the major mode. Here is how it +;; works: The minor mode defines all the keys necessary to operate the +;; structure commands, but wraps the commands into a function which +;; tests if the cursor is currently at a headline or a plain list +;; item. If that is the case, the structure command is used, +;; temporarily setting many Org-mode variables like regular +;; expressions for filling etc. However, when any of those keys is +;; used at a different location, function uses `key-binding' to look +;; up if the key has an associated command in another currently active +;; keymap (minor modes, major mode, global), and executes that +;; command. There might be problems if any of the keys is otherwise +;; used as a prefix key. + +;; Another challenge is that the key binding for TAB can be tab or \C-i, +;; likewise the binding for RET can be return or \C-m. Orgtbl-mode +;; addresses this by checking explicitly for both bindings. + +(defvar orgstruct-mode-map (make-sparse-keymap) + "Keymap for the minor `org-cdlatex-mode'.") + +;;;###autoload +(define-minor-mode orgstruct-mode + "Toggle the minor more `orgstruct-mode'. +This mode is for using Org-mode structure commands in other modes. +The following key behave as if Org-mode was active, if the cursor +is on a headline, or on a plain list item (both in the definition +of Org-mode). + +M-up Move entry/item up +M-down Move entry/item down +M-left Promote +M-right Demote +M-S-up Move entry/item up +M-S-down Move entry/item down +M-S-left Promote subtree +M-S-right Demote subtree +M-q Fill paragraph and items like in Org-mode +C-c ^ Sort entries +C-c - Cycle list bullet +TAB Cycle item visibility +M-RET Insert new heading/item +S-M-RET Insert new TODO heading / Chekbox item +C-c C-c Set tags / toggle checkbox" + nil " OrgStruct" nil + (and (orgstruct-setup) (defun orgstruct-setup () nil))) + +;;;###autoload +(defun turn-on-orgstruct () + "Unconditionally turn on `orgstruct-mode'." + (orgstruct-mode 1)) + +(defun orgstruct-error () + "Error when there is no default binding for a structure key." + (interactive) + (error "This key is has no function outside structure elements")) + +(defvar org-local-vars nil + "List of local variables, for use by `orgstruct-mode'") + +(defun orgstruct-setup () + "Setup orgstruct keymaps." + (let ((nfunc 0) + (bindings + (list + '([(meta up)] org-metaup) + '([(meta down)] org-metadown) + '([(meta left)] org-metaleft) + '([(meta right)] org-metaright) + '([(meta shift up)] org-shiftmetaup) + '([(meta shift down)] org-shiftmetadown) + '([(meta shift left)] org-shiftmetaleft) + '([(meta shift right)] org-shiftmetaright) + '("\M-q" fill-paragraph) + '("\C-c^" org-sort) + '("\C-c-" org-cycle-list-bullet))) + elt key fun cmd) + (while (setq elt (pop bindings)) + (setq nfunc (1+ nfunc)) + (setq key (org-key (car elt)) + fun (nth 1 elt) + cmd (orgstruct-make-binding fun nfunc key)) + (org-defkey orgstruct-mode-map key cmd)) + + ;; Special treatment needed for TAB and RET + (org-defkey orgstruct-mode-map [(tab)] + (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) + (org-defkey orgstruct-mode-map "\C-i" + (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) + + (org-defkey orgstruct-mode-map "\M-\C-m" + (orgstruct-make-binding 'org-insert-heading 105 + "\M-\C-m" [(meta return)])) + (org-defkey orgstruct-mode-map [(meta return)] + (orgstruct-make-binding 'org-insert-heading 106 + [(meta return)] "\M-\C-m")) + + (org-defkey orgstruct-mode-map [(shift meta return)] + (orgstruct-make-binding 'org-insert-todo-heading 107 + [(meta return)] "\M-\C-m")) + + (org-defkey orgstruct-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) + (setq org-local-vars (org-get-local-variables)) + + t)) + +(defun orgstruct-make-binding (fun n &rest keys) + "Create a function for binding in the structure minor mode. +FUN is the command to call inside a table. N is used to create a unique +command name. KEYS are keys that should be checked in for a command +to execute outside of tables." + (eval + (list 'defun + (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) + '(arg) + (concat "In Structure, run `" (symbol-name fun) "'.\n" + "Outside of structure, run the binding of `" + (mapconcat (lambda (x) (format "%s" x)) keys "' or `") + "'.") + '(interactive "p") + (list 'if + '(org-context-p 'headline 'item) + (list 'org-run-like-in-org-mode (list 'quote fun)) + (list 'let '(orgstruct-mode) + (list 'call-interactively + (append '(or) + (mapcar (lambda (k) + (list 'key-binding k)) + keys) + '('orgstruct-error)))))))) + +(defun org-context-p (&rest contexts) + "FIXME:" + (let ((pos (point))) + (goto-char (point-at-bol)) + (prog1 (or (and (memq 'table contexts) + (looking-at "[ \t]*|")) + (and (memq 'headline contexts) + (looking-at "\\*+")) + (and (memq 'item contexts) + (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) + (goto-char pos)))) + +(defun org-get-local-variables () + "Return a list of all local variables in an org-mode buffer." + (let (varlist) + (with-current-buffer (get-buffer-create "*Org tmp*") + (erase-buffer) + (org-mode) + (setq varlist (buffer-local-variables))) + (kill-buffer "*Org tmp*") + (delq nil + (mapcar + (lambda (x) + (setq x + (if (symbolp x) + (list x) + (list (car x) (list 'quote (cdr x))))) + (if (string-match + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + (symbol-name (car x))) + x nil)) + varlist)))) + +(defun org-run-like-in-org-mode (cmd) + (eval (list 'let org-local-vars + (list 'call-interactively (list 'quote cmd))))) ;;;; Archiving @@ -5981,7 +6467,8 @@ this heading." (progn (if (re-search-forward (concat "\\(^\\|\r\\)" - (regexp-quote heading) "[ \t]*\\(:[a-zA-Z0-9_@:]+:\\)?[ \t]*\\($\\|\r\\)") + (regexp-quote heading) + (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) nil t) (goto-char (match-end 0)) ;; Heading not found, just insert it at the end @@ -6000,15 +6487,16 @@ this heading." ;; Paste (org-paste-subtree (org-get-legal-level level 1)) ;; Mark the entry as done, i.e. set to last word in org-todo-keywords-1 FIXME: not right anymore!!!!!!! - (if org-archive-mark-done - (let (org-log-done) - (org-todo (length org-todo-keywords-1)))) + (when (and org-archive-mark-done + (looking-at org-todo-line-regexp) + (or (not (match-end 3)) + (not (member (match-string 3) org-done-keywords)))) + (let (org-log-done) + (org-todo (car org-done-keywords)))) + ;; Move cursor to right after the TODO keyword (when org-archive-stamp-time - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (goto-char (or (match-end 2) (match-beginning 3))) - (org-insert-time-stamp (org-current-time) t t "(" ")")) + (org-add-planning-info 'archived (org-current-time))) ;; Save the buffer, if it is not the same buffer. (if (not (eq this-buffer buffer)) (save-buffer)))) ;; Here we are back in the original buffer. Everything seems to have @@ -6063,6 +6551,28 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (goto-char end))))) (message "%d trees archived" cntarch))) +(defun org-cycle-hide-drawers (state) + "Re-hide all archived subtrees after a visibility state change." + (when (not (memq state '(overview folded))) + (save-excursion + (let* ((globalp (memq state '(contents all))) + (beg (if globalp (point-min) (point))) + (end (if globalp (point-max) (org-end-of-subtree t)))) + (goto-char beg) + (while (re-search-forward org-drawer-regexp end t) + (org-flag-drawer t)))))) + +(defun org-flag-drawer (flag) + (save-excursion + (beginning-of-line 1) + (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") + (let ((b (match-end 0))) + (if (re-search-forward + "^[ \t]*:END:" + (save-excursion (outline-next-heading) (point)) t) + (outline-flag-region b (point-at-eol) flag) + (error ":END: line missing")))))) + (defun org-cycle-hide-archived-subtrees (state) "Re-hide all archived subtrees after a visibility state change." (when (and (not org-cycle-open-archived-trees) @@ -6100,7 +6610,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (let (res current) (save-excursion (beginning-of-line) - (if (re-search-forward "[ \t]:\\([a-zA-Z0-9_@:]+\\):[ \t]*$" + (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") (point-at-eol) t) (progn (setq current (match-string 1)) @@ -7213,7 +7723,7 @@ should be done in reverse order." (setq beg (point-at-bol 1))) (goto-char pos) (if (re-search-forward org-table-hline-regexp tend t) - (setq beg (point-at-bol 0)) + (setq end (point-at-bol 0)) (goto-char tend) (setq end (point-at-bol)))) (setq beg (move-marker (make-marker) beg) @@ -7820,7 +8330,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) (setq fields (org-split-string (match-string 1) " *| *")) (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) + (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) (push (cons (match-string 1 field) (match-string 2 field)) org-table-local-parameters)))) (goto-char beg) @@ -8029,7 +8539,7 @@ not overwrite the stored one." (modes (copy-sequence org-calc-default-modes)) (numbers nil) ; was a variable, now fixed default (keep-empty nil) - n form form0 bw fmt x ev orig c lispp) + n form form0 bw fmt x ev orig c lispp literal) ;; Parse the format string. Since we have a lot of modes, this is ;; a lot of work. However, I think calc still uses most of the time. (if (string-match ";" formula) @@ -8051,6 +8561,9 @@ not overwrite the stored one." (if (string-match "[NT]" fmt) (setq numbers (equal (match-string 0 fmt) "N") fmt (replace-match "" t t fmt))) + (if (string-match "L" fmt) + (setq literal t + fmt (replace-match "" t t fmt))) (if (string-match "E" fmt) (setq keep-empty t fmt (replace-match "" t t fmt))) @@ -8067,13 +8580,14 @@ not overwrite the stored one." (org-no-properties (buffer-substring (point-at-bol) (point-at-eol))) " *| *")) - (if numbers + (if (eq numbers t) (setq fields (mapcar (lambda (x) (number-to-string (string-to-number x))) fields))) (setq ndown (1- ndown)) (setq form (copy-sequence formula) lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) + (if (and lispp literal) (setq lispp 'literal)) ;; Check for old vertical references (setq form (org-rewrite-old-row-references form)) ;; Insert complex ranges @@ -8150,6 +8664,12 @@ $1-> %s\n" orig formula form0 form)) (or suppress-align (and org-table-may-need-update (org-table-align)))))) +(defun org-table-put-field-property (prop value) + (save-excursion + (put-text-property (progn (skip-chars-backward "^|") (point)) + (progn (skip-chars-forward "^|") (point)) + prop value))) + (defun org-table-get-range (desc &optional tbeg col highlight) "Get a calc vector from a column, accorting to descriptor DESC. Optional arguments TBEG and COL can give the beginning of the table and @@ -8272,7 +8792,9 @@ NUMBERS indicates that everything should be converted to numbers. LISPP means to return something appropriate for a Lisp list." (if (stringp elements) ; just a single val (if lispp - (prin1-to-string (if numbers (string-to-number elements) elements)) + (if (eq lispp 'literal) + elements + (prin1-to-string (if numbers (string-to-number elements) elements))) (if (equal elements "") (setq elements "0")) (if numbers (number-to-string (string-to-number elements)) elements)) (unless keep-empty @@ -8282,9 +8804,12 @@ LISPP means to return something appropriate for a Lisp list." elements)))) (setq elements (or elements '("0"))) (if lispp - (mapconcat 'prin1-to-string - (if numbers (mapcar 'string-to-number elements) elements) - " ") + (mapconcat + (lambda (x) + (if (eq lispp 'literal) + x + (prin1-to-string (if numbers (string-to-number x) x)))) + " ") (concat "[" (mapconcat (lambda (x) (if numbers (number-to-string (string-to-number x)) x)) @@ -8307,7 +8832,7 @@ With prefix arg ALL, do this for all lines in the table." (line-re org-table-dataline-regexp) (thisline (org-current-line)) (thiscol (org-table-current-column)) - beg end entry eqlnum eqlname eql (cnt 0) eq a name) + beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) ;; Insert constants in all formulas (setq eqlist (mapcar (lambda (x) @@ -8337,6 +8862,30 @@ With prefix arg ALL, do this for all lines in the table." end (move-marker (make-marker) (1+ (point-at-eol))))) (goto-char beg) (and all (message "Re-applying formulas to full table...")) + + ;; First find the named fields, and mark them untouchanble + (remove-text-properties beg end '(org-untouchable t)) + (while (setq eq (pop eqlname)) + (setq name (car eq) + a (assoc name org-table-named-field-locations)) + (and (not a) + (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) + (setq a (list name + (aref org-table-dlines + (string-to-number (match-string 1 name))) + (string-to-number (match-string 2 name))))) + (when (and a (or all (equal (nth 1 a) thisline))) + (message "Re-applying formula to field: %s" name) + (goto-line (nth 1 a)) + (org-table-goto-column (nth 2 a)) + (push (append a (list (cdr eq))) eqlname1) +;; FIXME (org-table-eval-formula nil (cdr eq) 'noalign 'nocst +;; FIXME 'nostore 'noanalysis) + (org-table-put-field-property :org-untouchable t))) + + ;; Now evauluate the column formulas, but skip fields covered by + ;; field formulas + (goto-char beg) (while (re-search-forward line-re end t) (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) ;; Unprotected line, recalculate @@ -8347,30 +8896,24 @@ With prefix arg ALL, do this for all lines in the table." (while (setq entry (pop eql)) (goto-line org-last-recalc-line) (org-table-goto-column (string-to-number (car entry)) nil 'force) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis)))) + (unless (get-text-property (point) :org-untouchable) + (org-table-eval-formula nil (cdr entry) + 'noalign 'nocst 'nostore 'noanalysis))))) + + ;; Now evaluate the field formulas + (while (setq eq (pop eqlname1)) + (message "Re-applying formula to field: %s" (car eq)) + (goto-line (nth 1 eq)) + (org-table-goto-column (nth 2 eq)) + (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst + 'nostore 'noanalysis)) + (goto-line thisline) (org-table-goto-column thiscol) + (remove-text-properties (point-min) (point-max) '(org-untouchable t)) (or noalign (and org-table-may-need-update (org-table-align)) (and all (message "Re-applying formulas to %d lines...done" cnt))) - ;; Now do the named fields - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a - (list - name - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (org-table-eval-formula nil (cdr eq) 'noalign 'nocst - 'nostore 'noanalysis))) + ;; back to initial position (message "Re-applying formulas...done") (goto-line thisline) @@ -8408,7 +8951,7 @@ With prefix arg ALL, do this for all lines in the table." (setq f (replace-match (concat "$" (cdr a)) t t f))) ;; Parameters and constants (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][a-zA-Z0-9]*\\)" f start)) + (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) (setq start (1+ start)) (if (setq a (save-match-data (org-table-get-constant (match-string 1 f)))) @@ -8421,8 +8964,11 @@ With prefix arg ALL, do this for all lines in the table." "Find the value for a parameter or constant in a formula. Parameters get priority." (or (cdr (assoc const org-table-local-parameters)) + (cdr (assoc const org-table-formula-constants-local)) (cdr (assoc const org-table-formula-constants)) (and (fboundp 'constants-get) (constants-get const)) + (and (string= (substring const 0 (min 5 (length const))) "PROP_") + (org-entry-get nil (substring const 5) 'inherit)) "#UNDEFINED_NAME")) (defvar org-table-fedit-map (make-sparse-keymap)) @@ -8906,6 +9452,9 @@ With prefix ARG, apply the new formulas to the table." (t (cond ((not var) (error "No reference at point")) + ((setq e (assoc var org-table-formula-constants-local)) + (message "Local Constant: $%s=%s in #+CONSTANTS line." + var (cdr e))) ((setq e (assoc var org-table-formula-constants)) (message "Constant: $%s=%s in `org-table-formula-constants'." var (cdr e))) @@ -9801,7 +10350,7 @@ For file links, arg negates `org-context-in-file-links'." ((eq major-mode 'bbdb-mode) (let ((name (bbdb-record-name (bbdb-current-record))) - (company (bbdb-record-company (bbdb-current-record)))) + (company (bbdb-record-getprop (bbdb-current-record) 'company))) (setq cpltxt (concat "bbdb:" (or name company)) link (org-make-link cpltxt)) (org-store-link-props :type "bbdb" :name name :company company))) @@ -10070,7 +10619,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 ":[a-zA-Z_@0-9:]+:[ \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 "\\|" @@ -10237,7 +10786,7 @@ With three \\[universal-argument] prefixes, negate the meaning of (with-output-to-temp-buffer "*Org Links*" (princ "Insert a link. Use TAB to complete valid link prefixes.\n") (when org-stored-links - (princ "\nStored links ar available with <up>/<down> (most recent with RET):\n\n") + (princ "\nStored links are available with <up>/<down> (most recent with RET):\n\n") (princ (mapconcat 'car (reverse org-stored-links) "\n")))) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*")) @@ -10419,8 +10968,12 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (org-in-regexp org-plain-link-re)) (setq type (match-string 1) path (match-string 2)) (throw 'match t))) + (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") + (setq type "tree-match" + path (match-string 1)) + (throw 'match t)) (save-excursion - (when (org-in-regexp "\\(:[A-Za-z_@0-9:]+\\):[ \t]*$") + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) (setq type "tags" path (match-string 1)) (while (string-match ":" path) @@ -10469,6 +11022,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (t nil)) pos)) + ((string= type "tree-match") + (org-occur (concat "\\[" (regexp-quote path) "\\]"))) + ((string= type "file") (if (string-match "::\\([0-9]+\\)\\'" path) (setq line (string-to-number (match-string 1 path)) @@ -10645,7 +11201,7 @@ in all files. If AVOID-POS is given, ignore matches near that position." (when (equal (string-to-char s) ?*) ;; Anchor on headlines, post may include tags. (setq pre "^\\*+[ \t]*\\(?:\\sw+\\)?[ \t]*" - post "[ \t]*\\(?:[ \t]+:[a-zA-Z_@0-9:+]:[ \t]*\\)?$" + post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") s (substring s 1))) (remove-text-properties 0 (length s) @@ -11235,7 +11791,7 @@ to be run from that hook to fucntion properly." (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise (v-n user-full-name) (org-startup-folded nil) - org-time-was-given x prompt char time) + org-time-was-given org-end-time-was-given x prompt char time) (setq org-store-link-plist (append (list :annotation v-a :initial v-i))) (unless tpl (setq tpl "") (message "No template") (ding)) @@ -11276,20 +11832,34 @@ to be run from that hook to fucntion properly." (org-set-local 'org-remember-default-headline headline)) ;; Interactive template entries (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([uUtT]\\)?" nil t) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([guUtT]\\)?" nil t) (setq char (if (match-end 3) (match-string 3)) prompt (if (match-end 2) (match-string 2))) (goto-char (match-beginning 0)) (replace-match "") - (if char - (progn - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) "U") t nil - prompt)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")))) + (cond + ((member char '("G" "g")) + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (if (equal char "G") (org-agenda-files) (and file (list file))))) + (ins (completing-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (insert (concat ":" (mapconcat 'identity + (org-split-string ins (org-re "[^[:alnum:]]+")) + ":") + ":")))) + (char + (setq org-time-was-given (equal (upcase char) char)) + (setq time (org-read-date (equal (upcase char) "U") t nil + prompt)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t (insert (read-string - (if prompt (concat prompt ": ") "Enter string"))))) + (if prompt (concat prompt ": ") "Enter string")))))) (goto-char (point-min)) (if (re-search-forward "%\\?" nil t) (replace-match "") @@ -11397,7 +11967,7 @@ See also the variable `org-reverse-note-order'." (goto-char (point-min)) (if (re-search-forward (concat "^\\*+[ \t]+" (regexp-quote heading) - "\\([ \t]+:[@a-zA-Z0-9_:]*\\)?[ \t]*$") + (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$")) nil t) (setq org-goto-start-pos (match-beginning 0)))) @@ -11591,14 +12161,17 @@ At all other locations, this simply calls `ispell-complete-word'." (catch 'exit (let* ((end (point)) (beg1 (save-excursion - (skip-chars-backward "a-zA-Z_@0-9") + (skip-chars-backward (org-re "[:alnum:]_@")) (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9_:$") (point))) (confirm (lambda (x) (stringp (car x)))) (searchhead (equal (char-before beg) ?*)) - (tag (equal (char-before beg1) ?:)) + (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)) ?*)))) (texp (equal (char-before beg) ?\\)) (link (equal (char-before beg) ?\[)) (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) @@ -11640,6 +12213,8 @@ At all other locations, this simply calls `ispell-complete-word'." tbl) (tag (setq type :tag beg beg1) (or org-tag-alist (org-get-buffer-tags))) + (prop (setq type :prop beg beg1) + (mapcar 'list (org-buffer-property-keys))) (t (progn (ispell-complete-word arg) (throw 'exit nil))))) (pattern (buffer-substring-no-properties beg end)) (completion (try-completion pattern table confirm))) @@ -11647,7 +12222,7 @@ At all other locations, this simply calls `ispell-complete-word'." (if (equal type :opt) (insert (substring (cdr (assoc (upcase pattern) table)) (length pattern))) - (if (equal type :tag) (insert ":")))) + (if (memq type '(:tag :prop)) (insert ":")))) ((null completion) (message "Can't find completion for \"%s\"" pattern) (ding)) @@ -11660,7 +12235,7 @@ At all other locations, this simply calls `ispell-complete-word'." (delete-window (get-buffer-window "*Completions*"))) (if (assoc completion table) (if (eq type :todo) (insert " ") - (if (eq type :tag) (insert ":")))) + (if (memq type '(:tag :prop)) (insert ":")))) (if (and (equal type :opt) (assoc completion table)) (message "%s" (substitute-command-keys "Press \\[org-complete] again to insert example settings")))) @@ -11938,13 +12513,14 @@ If non is given, the user is prompted for a date. REMOVE indicates what kind of entries to remove. An old WHAT entry will also be removed." (interactive) - (let (org-time-was-given) + (let (org-time-was-given org-end-time-was-given) (when what (setq time (or time (org-read-date nil 'to-time)))) (when (and org-insert-labeled-timestamps-at-point (member what '(scheduled deadline))) (insert (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") - (org-insert-time-stamp time org-time-was-given) + (org-insert-time-stamp time org-time-was-given + nil nil nil (list org-end-time-was-given)) (setq what nil)) (save-excursion (save-restriction @@ -11953,7 +12529,13 @@ be removed." (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) (goto-char (match-end 1)) (setq col (current-column)) - (goto-char (1+ (match-end 0))) + (goto-char (match-end 0)) + (if (eobp) (insert "\n")) + (forward-char 1) + (when (looking-at "[ \t]*:PROPERTIES:[ \t]*$") + (goto-char (match-end 0)) + (if (eobp) (insert "\n")) + (forward-char 1)) (if (and (not (looking-at outline-regexp)) (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp "[^\r\n]*")) @@ -11983,13 +12565,15 @@ be removed." (if (not (equal (char-before) ?\ )) " " "") (cond ((eq what 'scheduled) org-scheduled-string) ((eq what 'deadline) org-deadline-string) - ((eq what 'closed) org-closed-string)) + ((eq what 'closed) org-closed-string) + ((eq what 'archived) org-archived-string)) " ") (org-insert-time-stamp time (or org-time-was-given (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed)) + (eq what 'closed) + nil nil (list org-end-time-was-given)) (end-of-line 1)) (goto-char (point-min)) (widen) @@ -12206,7 +12790,7 @@ from the `before-change-functions' in the current buffer." (defun org-priority (&optional action) "Change the priority of an item by ARG. -ACTION can be set, up, or down." +ACTION can be `set', `up', `down', or a character." (interactive) (setq action (or action 'set)) (let (current new news have remove) @@ -12217,9 +12801,11 @@ ACTION can be set, up, or down." have t) (setq current org-default-priority)) (cond - ((eq action 'set) - (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) - (setq new (read-char-exclusive)) + ((or (eq action 'set) (integerp action)) + (if (integerp action) + (setq new action) + (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) + (setq new (read-char-exclusive))) (cond ((equal new ?\ ) (setq remove t)) ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) (error "Priority must be between `%c' and `%c'" @@ -12244,6 +12830,7 @@ ACTION can be set, up, or down." (insert " [#" news "]")) (goto-char (match-beginning 3)) (insert "[#" news "] "))))) + (org-preserve-lc (org-set-tags nil 'align)) (if remove (message "Priority removed") (message "Priority of current item set to %s" news)))) @@ -12267,7 +12854,8 @@ inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword are included in the output." (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\>\\)\\)? *\\(.*?\\)\\(:[A-Za-z_@0-9:]+:\\)?[ \t]*$")) + (org-re + "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) (props (list 'face nil 'done-face 'org-done 'undone-face nil @@ -12290,7 +12878,7 @@ are included in the output." (setq todo (if (match-end 1) (match-string 2)) tags (if (match-end 4) (match-string 4))) (goto-char (setq lspos (1+ (match-beginning 0)))) - (setq level (funcall outline-level) + (setq level (org-reduced-level (funcall outline-level)) category (org-get-category)) (setq i llast llast level) ;; remove tag lists from same and sublevels @@ -12349,25 +12937,43 @@ also TODO lines." (interactive "P") (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) +(defvar org-cached-props nil) +(defun org-cached-entry-get (pom property) + (cdr (assoc property (or org-cached-props + (setq org-cached-props + (org-entry-properties pom)))))) + +(defun org-global-tags-completion-table (&optional files) + "Return the list of all tags in all agenda buffer/files." + (save-excursion + (org-uniquify + (apply 'append + (mapcar + (lambda (file) + (set-buffer (find-file-noselect file)) + (org-get-buffer-tags)) + (if (and files (car files)) + files + (org-agenda-files))))))) + (defun org-make-tags-matcher (match) "Create the TAGS//TODO matcher form for the selection string MATCH." ;; todo-only is scoped dynamically into this function, and the function ;; may change it it the matcher asksk for it. (unless match ;; Get a new match request, with completion - (setq org-last-tags-completion-table - (or org-tag-alist - org-last-tags-completion-table)) - (setq match (completing-read - "Match: " 'org-tags-completion-function nil nil nil - 'org-tags-history))) - + (let ((org-last-tags-completion-table + (org-global-tags-completion-table))) + (setq match (completing-read + "Match: " 'org-tags-completion-function nil nil nil + 'org-tags-history)))) + ;; Parse the string and create a lisp form (let ((match0 match) - (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|[A-Za-z_@0-9]+\\)") + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p level-p) + orterms term orlist re-p level-p prop-p pn pv) (if (string-match "/+" match) ;; match contains also a todo-matching request (progn @@ -12393,10 +12999,19 @@ also TODO lines." tag (match-string 2 term) re-p (equal (string-to-char tag) ?{) level-p (match-end 3) + prop-p (match-end 4) mm (cond (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) (level-p `(= level ,(string-to-number (match-string 3 term)))) + (prop-p + (setq pn (match-string 4 term) + pv (match-string 5 term) + re-p (equal (string-to-char pv) ?{) + pv (substring pv 1 -1)) + (if re-p + `(string-match ,pv (org-cached-entry-get nil ,pn)) + `(equal ,pv (org-cached-entry-get nil ,pn)))) (t `(member ,(downcase tag) tags-list))) mm (if minus (list 'not mm) mm) term (substring term (match-end 0))) @@ -12406,7 +13021,9 @@ also TODO lines." (car tagsmatcher)) orlist) (setq tagsmatcher nil)) - (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))) + (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) + (setq tagsmatcher + (list 'progn '(setq org-cached-props nil) tagsmatcher))) ;; Make the todo matcher (if (or (not todomatch) (not (string-match "\\S-" todomatch))) @@ -12584,7 +13201,8 @@ Returns the new tags string, or nil to not change the current settings." groups ingroup) (save-excursion (beginning-of-line 1) - (if (looking-at ".*[ \t]\\(:[A-Za-z_@0-9:]+:\\)[ \t]*\\(\r\\|$\\)") + (if (looking-at + (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -12719,7 +13337,8 @@ Returns the new tags string, or nil to not change the current settings." (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) - (while (re-search-forward "\\[.\\] \\([a-zA-Z0-9_@]+\\)" nil t) + (while (re-search-forward + (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) (list 'face @@ -12739,7 +13358,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 ".*[ \t]\\(:[A-Za-z_@0-9:]+:\\)[ \t]*\\(\r\\|$\\)") + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*\\(\r\\|$\\)")) (org-match-string-no-properties 1) ""))) @@ -12748,15 +13367,536 @@ Returns the new tags string, or nil to not change the current settings." (let (tags) (save-excursion (goto-char (point-min)) - (while (re-search-forward "[ \t]:\\([A-Za-z_@0-9:]+\\):[ \t\r\n]" nil t) - (mapc (lambda (x) (add-to-list 'tags x)) - (org-split-string (org-match-string-no-properties 1) ":")))) + (while (re-search-forward + (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) ":"))))) (mapcar 'list tags))) + +;;;; Properties + +;;; Setting and retrieving properties + +(defconst org-special-properties + '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" + "CLOCK" "PRIORITY") + "The special properties valid in Org-mode. + +These are properties that are not defined in the property drawer, +but in some other way.") + +(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defmacro org-with-point-at (pom &rest body) + "Move to buffer and point of point-or-marker POM for the duration of BODY." + (declare (indent 1) (debug t)) + `(save-excursion + (if (markerp pom) (set-buffer (marker-buffer pom))) + (save-excursion + (goto-char (or pom (point))) + ,@body))) + +(defun org-get-property-block (&optional beg end force) + "Return the (beg . end) range of the body of the property drawer. +BEG and END can be beginning and end of subtree, if not given +they will be found. +If the drawer does not exist and FORCE is non-nil, greater the drawer." + (catch 'exit + (save-excursion + (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) + (end (or end (progn (outline-next-heading) (point))))) + (goto-char beg) + (if (re-search-forward org-property-start-re end t) + (setq beg (1+ (match-end 0))) + (or force (throw 'exit nil)) + (beginning-of-line 2) + (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) + (not (equal (match-string 1) org-clock-string))) + (beginning-of-line 2)) + (insert ":PROPERTIES:\n:END:\n") + (beginning-of-line -1) + (org-indent-line-function) + (setq beg (1+ (point-at-eol)) end beg) + (beginning-of-line 2) + (org-indent-line-function) + (throw 'exit (cons beg end))) + (if (re-search-forward org-property-end-re end t) + (setq end (match-beginning 0)) + (or force (throw 'exit nil)) + (goto-char beg) + (setq end beg) + (org-indent-line-function) + (insert ":END:\n")) + (cons beg end))))) + +(defun org-entry-properties (&optional pom which) + "Get all properties of the entry at point-or-marker POM. +This includes the TODO keyword, the tags, time strings for deadline, +scheduled, and clocking, and any additional properties defined in the +entry. The return value is an alist, keys may occur multiple times +if the property key was used several times. +POM may also be nil, in which case the current entry is used. +If WHICH is nil or `all', get all properties. If WHICH is +`special' or `standard', only get that subclass." + (setq which (or which 'all)) + (org-with-point-at pom + (let ((clockstr (substring org-clock-string 0 -1)) + (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) + beg end range props key value) + (save-excursion + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq beg (point)) + (outline-next-heading) + (setq end (point)) + (when (memq which '(all special)) + ;; Get the special properties, like TODO and tags + (goto-char beg) + (when (and (looking-at org-todo-line-regexp) (match-end 2)) + (push (cons "TODO" (org-match-string-no-properties 2)) props)) + (when (looking-at org-priority-regexp) + (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) + (when (and (setq value (org-get-tags)) (string-match "\\S-" value)) + (push (cons "TAGS" value) props)) + (when (setq value (org-get-tags-at)) + (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) + props)) + (while (re-search-forward org-keyword-time-regexp end t) + (setq key (substring (org-match-string-no-properties 1) 0 -1)) + (unless (member key excluded) (push key excluded)) + (push (cons key + (if (equal key clockstr) + (org-no-properties + (org-trim + (buffer-substring + (match-beginning 2) (point-at-eol)))) + (org-match-string-no-properties 2))) + props))) + (when (memq which '(all standard)) + ;; Get the standard properties, like :PORP: ... + (setq range (org-get-property-block beg end)) + (when range + (goto-char (car range)) + (while (re-search-forward + "^[ \t]*:\\([a-zA-Z][a-zA-Z0-9]*\\):[ \t]*\\(\\S-.*\\S-\\)" + (cdr range) t) + (setq key (org-match-string-no-properties 1) + value (org-match-string-no-properties 2)) + (unless (member key excluded) + (push (cons key value) props))))) + (nreverse props)))))) + +(defun org-entry-get (pom property &optional inherit) + "Get value of PROPERTY for entry at point-or-marker POM. +If INHERIT is non-nil and the entry does not have the property, +then also check higher levels of the hierarchy." + (org-with-point-at pom + (if inherit + (org-entry-get-with-inheritance property) + (if (member property org-special-properties) + ;; We need a special property. Use brute force, get all properties. + (cdr (assoc property (org-entry-properties nil 'special))) + (let ((range (org-get-property-block))) + (if (and range + (goto-char (car range)) + (re-search-forward + (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") + (cdr range) t)) + ;; Found the property, return it. + (org-match-string-no-properties 1))))))) + +(defun org-entry-delete (pom property) + "Delete the property PROPERTY from entry at point-or-marker POM." + (org-with-point-at pom + (if (member property org-special-properties) + nil ; cannot delete these properties. + (let ((range (org-get-property-block))) + (if (and range + (goto-char (car range)) + (re-search-forward + (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") + (cdr range) t)) + (delete-region (match-beginning 0) (1+ (point-at-eol)))))))) + +(defvar org-entry-property-inherited-from (make-marker)) + +(defun org-entry-get-with-inheritance (property) + "Get entry property, and search higher levels if not present." + (let (tmp) + (save-excursion + (catch 'ex + (while t + (when (setq tmp (org-entry-get nil property)) + (org-back-to-heading t) + (move-marker org-entry-property-inherited-from (point)) + (throw 'ex tmp)) + (condition-case nil + (org-up-heading-all 1) + (error (throw 'ex nil)))))))) + +(defun org-entry-put (pom property value) + "Set PROPERTY to VALUE for entry at point-or-marker POM." + (org-with-point-at pom + (org-back-to-heading t) + (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) + range) + (cond + ((equal property "TODO") + (when (and (stringp value) (string-match "\\S-" value) + (not (member value org-todo-keywords-1))) + (error "\"%s\" is not a valid TODO state" value)) + (if (or (not value) + (not (string-match "\\S-" value))) + (setq value 'none)) + (org-todo value) + (org-set-tags nil 'align)) + ((equal property "PRIORITY") + (org-priority (if (and value (stringp value) (string-match "\\S-" value)) + (string-to-char value) ?\ )) + (org-set-tags nil 'align)) + ((member property org-special-properties) + (error "The %s property can not yet be set with `org-entry-put'" + property)) + (t ; a non-special property + (setq range (org-get-property-block beg end 'force)) + (goto-char (car range)) + (if (re-search-forward + (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t) + (progn + (delete-region (match-beginning 1) (match-end 1)) + (goto-char (match-beginning 1))) + (goto-char (cdr range)) + (insert "\n") + (backward-char 1) + (org-indent-line-function) + (insert ":" property ":")) + (and value (insert " " value))))))) + +(defun org-buffer-property-keys (&optional include-specials) + "Get all property keys in the current buffer." + (let (rtn range) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-property-start-re nil t) + (setq range (org-get-property-block)) + (goto-char (car range)) + (while (re-search-forward "^[ \t]*:\\([a-zA-Z0-9]+\\):" (cdr range) t) + (add-to-list 'rtn (org-match-string-no-properties 1))) + (outline-next-heading)))) + (when include-specials + (setq rtn (append org-special-properties rtn))) + (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) + +;; FIXME: This should automatically find the right place int he entry. +;; And then org-entry-put should use it. +(defun org-insert-property-drawer () + "Insert a property drawer at point." + (interactive) + (beginning-of-line 1) + (insert ":PROPERTIES:\n:END:\n") + (beginning-of-line -1) + (org-indent-line-function) + (beginning-of-line 2) + (org-indent-line-function) + (end-of-line 0)) + +(defvar org-column-overlays nil + "Holds the list of current column overlays.") + +(defvar org-current-columns-fmt nil + "Loval variable, holds the currently active column format.") +(defvar org-current-columns-maxwidths nil + "Loval variable, holds the currently active maximum column widths.") + +(defvar org-column-map (make-sparse-keymap) + "The keymap valid in column display.") + +(define-key org-column-map "e" 'org-column-edit) +(define-key org-column-map "v" 'org-column-show-value) +(define-key org-column-map "q" 'org-column-quit) +(define-key org-column-map [left] 'backward-char) +(define-key org-column-map [right] 'forward-char) + +(easy-menu-define org-column-menu org-column-map "Org Column Menu" + '("Column" + ["Edit property" org-column-edit t] + ["Show full value" org-column-show-value t] + ["Quit" org-column-quit t])) + +(defun org-new-column-overlay (beg end &optional string face) + "Create a new column overlay an add it to the list." + (let ((ov (org-make-overlay beg end))) + (org-overlay-put ov 'face (or face 'secondary-selection)) + (org-overlay-display ov string face) + (push ov org-column-overlays) + ov)) + +(defun org-overlay-columns (&optional props) + "Overlay the current line with column display." + (interactive) + (let ((fmt (copy-sequence org-current-columns-fmt)) + (beg (point-at-bol)) + (start 0) props pom property ass width f string ov) + ;; Check if the entry is in another buffer. + (unless props + (if (eq major-mode 'org-agenda-mode) + (setq pom (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)) + props (if pom (org-entry-properties pom) nil)) + (setq props (org-entry-properties nil)))) + ;; Parse the format + (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" + fmt start) + (setq start (match-end 0) + property (match-string 2 fmt) + ass (if (equal property "ITEM") + (cons "ITEM" + (save-match-data + (org-no-properties + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))))) + (assoc property props)) + width (or (cdr (assoc property org-current-columns-maxwidths)) + (string-to-number (or (match-string 1 fmt) "10"))) + f (format "%%-%d.%ds | " width width) + string (format f (or (cdr ass) ""))) + ;; Create the overlay + (org-unmodified + (setq ov (org-new-column-overlay + beg (setq beg (1+ beg)) string 'org-column)) + (org-overlay-put ov 'keymap org-column-map) + (org-overlay-put ov 'org-column-key property) + (org-overlay-put ov 'org-column-value (cdr ass))) + (if (or (not (char-after beg)) + (equal (char-after beg) ?\n)) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char beg) + (insert " "))))) + ;; Make the rest of the line disappear. + ;; FIXME: put the keymap also at the end of the line! + (org-unmodified + (setq ov (org-new-column-overlay beg (point-at-eol))) + (org-overlay-put ov 'invisible t) + (org-overlay-put ov 'keymap 'org-column-map) + (push ov org-column-overlays) + (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (org-overlay-put ov 'keymap 'org-column-map) + (push ov org-column-overlays) + (let ((inhibit-read-only t)) + (put-text-property (1- (point-at-bol)) + (min (point-max) (1+ (point-at-eol))) + 'read-only "Type `e' to edit property"))))) + +(defun org-overlay-columns-title () + "Overlay the newline before the current line with the table title." + (interactive) + (let ((fmt (copy-sequence org-current-columns-fmt)) + (start 0) + string (title "") + property width f ov) + (while (string-match "%\\([0-9]+\\)?\\([a-zA-Z0-9]+\\)\\-*" + fmt start) + (setq start (match-end 0) + property (match-string 2 fmt) + width (or (cdr (assoc property org-current-columns-maxwidths)) + (string-to-number (or (match-string 1 fmt) "10"))) + f (format "%%-%d.%ds | " width width) + string (format f property) + title (concat title string))) + (org-unmodified + (setq ov (org-new-column-overlay + (1- (point-at-bol)) (point-at-bol) + (concat "\n" (make-string (length title) ?-) "\n" + title "\n" (make-string (length title) ?-) "\n") + 'bold)) + (org-overlay-put ov 'keymap org-column-map)))) + +(defun org-remove-column-overlays () + "Remove all currently active column overlays." + (interactive) + (org-unmodified + (mapc 'org-delete-overlay org-column-overlays) + (setq org-column-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t))))) + +(defun org-column-show-value () + "Show the full value of the property." + (interactive) + (let ((value (get-char-property (point) 'org-column-value))) + (message "Value is: %s" (or value "")))) + +(defun org-column-quit () + "Remove the column overlays and in this way exit column editing." + (interactive) + (org-unmodified + (org-remove-column-overlays) + (let ((inhibit-read-only t)) + ;; FIXME: is this safe??? + ;; or are there other reasons why there may be a read-only property???? + (remove-text-properties (point-min) (point-max) '(read-only t)))) + (when (eq major-mode 'org-agenda-mode) + (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) + +(defun org-column-edit () + "Edit the value of the property at point in column view. +Where possible, use the standard interface for changing this line." + (interactive) + (let* ((col (current-column)) + (key (get-char-property (point) 'org-column-key)) + (value (get-char-property (point) 'org-column-value)) + (bol (point-at-bol)) (eol (point-at-eol)) + (pom (or (get-text-property bol 'org-hd-marker) + (point))) ; keep despite of compiler waring + (line-overlays + (delq nil (mapcar (lambda (x) + (and (eq (overlay-buffer x) (current-buffer)) + (>= (overlay-start x) bol) + (<= (overlay-start x) eol) + x)) + org-column-overlays))) + nval eval) + (when (equal key "ITEM") + (error "Cannot edit item headline from here")) + + (cond + ((equal key "TODO") + (setq eval '(org-with-point-at pom + (let ((current-prefix-arg '(4))) (org-todo '(4)))))) + ((equal key "PRIORITY") + (setq eval '(org-with-point-at pom + (call-interactively 'org-priority)))) + ((equal key "TAGS") + (setq eval '(org-with-point-at pom + (let ((org-fast-tag-selection-single-key + (if (eq org-fast-tag-selection-single-key 'expert) + t org-fast-tag-selection-single-key))) + (call-interactively 'org-set-tags))))) + ((equal key "DEADLINE") + (setq eval '(org-with-point-at pom + (call-interactively 'org-deadline)))) + ((equal key "SCHEDULED") + (setq eval '(org-with-point-at pom + (call-interactively 'org-deadline)))) + (t + (setq nval (read-string "Edit: " value)) + (setq nval (org-trim nval)) + (when (not (equal nval value)) + (setq eval '(org-entry-put pom key nval))))) + (when eval + (let ((inhibit-read-only t)) + (remove-text-properties (1- bol) eol '(read-only t)) + (unwind-protect + (progn + (setq org-column-overlays + (org-delete-all line-overlays org-column-overlays)) + (mapc 'org-delete-overlay line-overlays) + (eval eval)) + (org-overlay-columns)))) + (move-to-column col))) + +(defun org-columns () + "Turn on column view on an org-mode file." + (interactive) + (org-remove-column-overlays) + (let (beg end fmt cache maxwidths) + (move-marker org-entry-property-inherited-from nil) + (setq fmt (org-entry-get nil "COLUMNS" t)) + (unless fmt + (message "No local columns format defined, using default")) + (org-set-local 'org-current-columns-fmt (or fmt org-default-columns-format)) + (org-back-to-heading) + (save-excursion + (if (marker-position org-entry-property-inherited-from) + (goto-char org-entry-property-inherited-from)) + (setq beg (point) + end (org-end-of-subtree t t)) + (goto-char beg) + ;; Get and cache the properties + (while (re-search-forward (concat "^" outline-regexp) end t) + (push (cons (org-current-line) (org-entry-properties)) cache)) + (when cache + (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) + (org-set-local 'org-current-columns-maxwidths maxwidths) + (goto-line (car (org-last cache))) + (org-overlay-columns-title) + (mapc (lambda (x) + (goto-line (car x)) + (org-overlay-columns (cdr x))) + cache))))) + +(defvar org-overriding-columns-format nil + "FIXME:") +(defvar org-agenda-view-columns-initially nil + "FIXME:") + +(defun org-agenda-columns () + "Turn on column view in the agenda." + (interactive) + (let (fmt first-done cache maxwidths m) + (cond + ((and (local-variable-p 'org-overriding-columns-format) + org-overriding-columns-format) + (setq fmt org-overriding-columns-format)) + ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) + (setq fmt (org-entry-get m "COLUMNS" t))) + ((and (boundp 'org-current-columns-fmt) + (local-variable-p 'org-current-columns-fmt) + org-current-columns-fmt) + (setq fmt org-current-columns-fmt)) + ((setq m (next-single-property-change (point-min) 'org-hd-marker)) + (setq m (get-text-property m 'org-hd-marker)) + (setq fmt (org-entry-get m "COLUMNS" t)))) + (setq fmt (or fmt org-default-columns-format)) + (org-set-local 'org-current-columns-fmt fmt) + (save-excursion + ;; Get and cache the properties + (goto-char (point-min)) + (while (not (eobp)) + (when (setq m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker))) + (push (cons (org-current-line) (org-entry-properties m)) cache)) + (beginning-of-line 2)) + (when cache + (setq maxwidths (org-get-columns-autowidth-alist fmt cache)) + (org-set-local 'org-current-columns-maxwidths maxwidths) + (goto-line (car (org-last cache))) + (org-overlay-columns-title) + (mapc (lambda (x) + (goto-line (car x)) + (org-overlay-columns (cdr x))) + cache))))) + +(defun org-get-columns-autowidth-alist (s cache) + "Derive the maximum column widths from the format and the cache." + (let ((start 0) rtn) + (while (string-match "%\\([a-zA-Z]\\S-*\\)" s start) + (push (cons (match-string 1 s) 1) rtn) + (setq start (match-end 0))) + (mapc (lambda (x) + (setcdr x (apply 'max + (mapcar + (lambda (y) + (length (or (cdr (assoc (car x) (cdr y))) " "))) + cache)))) + rtn) + rtn)) + + ;;;; Timestamps (defvar org-last-changed-timestamp nil) (defvar org-time-was-given) ; dynamically scoped parameter +(defvar org-end-time-was-given) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter (defun org-time-stamp (arg) @@ -12769,7 +13909,7 @@ So if you press just return without typing anything, the time stamp will represent the current date/time. If there is already a timestamp at the cursor, it will be modified." (interactive "P") - (let (org-time-was-given time) + (let (org-time-was-given org-end-time-was-given time) (cond ((and (org-at-timestamp-p) (eq last-command 'org-time-stamp) @@ -12784,12 +13924,15 @@ at the cursor, it will be modified." (when (org-at-timestamp-p) ; just to get the match data (replace-match "") (setq org-last-changed-timestamp - (org-insert-time-stamp time (or org-time-was-given arg)))) + (org-insert-time-stamp + time (or org-time-was-given arg) + nil nil nil (list org-end-time-was-given)))) (message "Timestamp updated")) (t (setq time (let ((this-command this-command)) (org-read-date arg 'totime))) - (org-insert-time-stamp time (or org-time-was-given arg)))))) + (org-insert-time-stamp time (or org-time-was-given arg) + nil nil nil (list org-end-time-was-given)))))) (defun org-time-stamp-inactive (&optional arg) "Insert an inactive time stamp. @@ -12798,9 +13941,10 @@ brackets. It is inactive in the sense that it does not trigger agenda entries, does not link to the calendar and cannot be changed with the S-cursor keys. So these are more for recording a certain time/date." (interactive "P") - (let (org-time-was-given time) + (let (org-time-was-given org-end-time-was-given time) (setq time (org-read-date arg 'totime)) - (org-insert-time-stamp time (or org-time-was-given arg) 'inactive))) + (org-insert-time-stamp time (or org-time-was-given arg) 'inactive + nil nil (list org-end-time-was-given)))) (defvar org-date-ovl (org-make-overlay 1 1)) (org-overlay-put org-date-ovl 'face 'org-warning) @@ -12809,6 +13953,7 @@ So these are more for recording a certain time/date." (defvar org-ans1) ; dynamically scoped parameter (defvar org-ans2) ; dynamically scoped parameter +(defvar org-plain-time-of-day-regexp) ; defined below (defun org-read-date (&optional with-time to-time from-string prompt) "Read a date and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything @@ -12938,7 +14083,8 @@ used to insert the time stamp into the buffer to include the time." t nil ans))) ;; Help matching am/pm times, because `parse-time-string' does not do that. ;; If there is a time with am/pm, and *no* time without it, we convert - ;; convert so that matching will be successful. + ;; so that matching will be successful. + ;; FIXME: make this replace twoce, so that we catch the end time. (when (and (not (string-match "[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) (setq hour (string-to-number (match-string 1 ans)) @@ -12949,6 +14095,14 @@ used to insert the time stamp into the buffer to include the time." (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) (setq ans (replace-match (format "%02d:%02d" hour minute) t t ans))) + ;; Check if there is a time range + (when (and (boundp 'org-end-time-was-given) + (string-match org-plain-time-of-day-regexp ans) + (match-end 8)) + (setq org-end-time-was-given (match-string 8 ans)) + (setq ans (concat (substring ans 0 (match-beginning 7)) + (substring ans (match-end 7))))) + (setq tl (parse-time-string ans) year (or (nth 5 tl) (string-to-number (format-time-string "%Y" ct))) month (or (nth 4 tl) (string-to-number (format-time-string "%m" ct))) @@ -13020,6 +14174,14 @@ The command returns the inserted time stamp." (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) (insert (or pre "")) (insert (setq stamp (format-time-string fmt time))) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) (when extra (backward-char 1) (insert extra) @@ -13054,7 +14216,7 @@ The command returns the inserted time stamp." t1 w1 with-hm tf time str w2 (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) - (if (string-match " \\+[0-9]+[dwmy]\\'" ts) + (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( \\+[0-9]+[dwmy]\\)?\\'" ts) (setq off (- (match-end 0) (match-beginning 0))))) (setq end (- end off)) (setq w1 (- end beg) @@ -13361,7 +14523,7 @@ DATE." This should be a lot faster than the normal `parse-time-string'. If time is not given, defaults to 0:00. However, with optional NODEFAULT, hour and minute fields will be nil if not given." - (if (string-match org-ts-regexp1 s) + (if (string-match org-ts-regexp0 s) (list 0 (if (or (match-beginning 8) (not nodefault)) (string-to-number (or (match-string 8 s) "0"))) @@ -13432,6 +14594,9 @@ With prefix ARG, change that many days." ((org-pos-in-match-range pos 8) 'minute) ((or (org-pos-in-match-range pos 4) (org-pos-in-match-range pos 5)) 'day) + ((and (> pos (or (match-end 8) (match-end 5))) + (< pos (match-end 0))) + (- pos (or (match-end 8) (match-end 5)))) (t 'day)))) ans)) @@ -13456,8 +14621,10 @@ in the timestamp determines what will be changed." inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) (replace-match "") - (if (string-match " \\+[0-9]+[dwmy]" ts) - (setq extra (match-string 0 ts))) + (if (string-match + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( \\+[0-9]+[dwmy]\\)?\\)[]>]" + ts) + (setq extra (match-string 1 ts))) (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) @@ -13471,6 +14638,8 @@ in the timestamp determines what will be changed." (list (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))) (list (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))) (nthcdr 6 time0)))) + (when (integerp org-ts-what) + (setq extra (org-modify-ts-extra extra org-ts-what n))) (if (eq what 'calendar) (let ((cal-date (save-excursion @@ -13494,6 +14663,35 @@ in the timestamp determines what will be changed." (memq org-ts-what '(day month year))) (org-recenter-calendar (time-to-days time))))) +(defun org-modify-ts-extra (s pos n) + "FIXME" + (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) + ng h m new) + (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( \\+\\([0-9]+\\)\\([dmwy]\\)\\)?" s) + (cond + ((or (org-pos-in-match-range pos 2) + (org-pos-in-match-range pos 3)) + (setq m (string-to-number (match-string 3 s)) + h (string-to-number (match-string 2 s))) + (if (org-pos-in-match-range pos 2) + (setq h (+ h n)) + (setq m (+ m n))) + (if (< m 0) (setq m (+ m 60) h (1- h))) + (if (> m 59) (setq m (- m 60) h (1+ h))) + (setq h (min 24 (max 0 h))) + (setq ng 1 new (format "-%02d:%02d" h m))) + ((org-pos-in-match-range pos 6) + (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) + ((org-pos-in-match-range pos 5) + (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))) + + (when ng + (setq s (concat + (substring s 0 (match-beginning ng)) + new + (substring s (match-end ng)))))) + s)) + (defun org-recenter-calendar (date) "If the calendar is visible, recenter it to DATE." (let* ((win (selected-window)) @@ -13604,7 +14802,8 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (equal (match-string 1) org-clock-string)) (setq ts (match-string 2)) (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) - (goto-char org-clock-marker) + (goto-char (match-end 0)) + (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) @@ -13646,7 +14845,7 @@ Puts the resulting times in minutes as a text property on each headline." (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string - "[ \t]*\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)")) + "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) (lmax 30) (ltimes (make-vector lmax 0)) (t1 0) @@ -13657,19 +14856,24 @@ Puts the resulting times in minutes as a text property on each headline." (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) - (if (match-end 2) - ;; A time - (setq ts (match-string 2) - te (match-string 3) - ts (time-to-seconds - (apply 'encode-time (org-parse-time-string ts))) - te (time-to-seconds - (apply 'encode-time (org-parse-time-string te))) - ts (if tstart (max ts tstart) ts) - te (if tend (min te tend) te) - dt (- te ts) - t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)) - ;; A headline + (cond + ((match-end 2) + ;; Two time stamps + (setq ts (match-string 2) + te (match-string 3) + ts (time-to-seconds + (apply 'encode-time (org-parse-time-string ts))) + te (time-to-seconds + (apply 'encode-time (org-parse-time-string te))) + ts (if tstart (max ts tstart) ts) + te (if tend (min te tend) te) + dt (- te ts) + t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) + ((match-end 4) + ;; A naket time + (setq t1 (+ t1 (string-to-number (match-string 5)) + (* 60 (string-to-number (match-string 4)))))) + (t ;; A headline (setq level (- (match-end 1) (match-beginning 1))) (when (or (> t1 0) (> (aref ltimes level) 0)) (loop for l from 0 to level do @@ -13678,7 +14882,7 @@ Puts the resulting times in minutes as a text property on each headline." (loop for l from level to (1- lmax) do (aset ltimes l 0)) (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time)))) + (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) (setq org-clock-file-total-minutes (aref ltimes 0))) (set-buffer-modified-p bmp))) @@ -13906,7 +15110,7 @@ the returned times will be formatted strings." (when (setq time (get-text-property p :org-clock-minutes)) (save-excursion (beginning-of-line 1) - (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[0-9a-zA-Z_@:]+:\\)?[ \t]*$") + (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) (setq level (- (match-end 1) (match-beginning 1))) (<= level maxlevel)) (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") @@ -14051,6 +15255,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) +(org-defkey org-agenda-mode-map "m" 'org-agenda-month-view) +(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later) (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) @@ -14086,7 +15292,6 @@ The following commands are available: '(org-defkey calendar-mode-map org-calendar-to-agenda-key 'org-calendar-goto-agenda)) (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) -(org-defkey org-agenda-mode-map "m" 'org-agenda-phases-of-moon) (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) @@ -14102,7 +15307,9 @@ The following commands are available: (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) +; FIXME: other key? wtah about the menu???/ +;(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) "Local keymap for agenda entries from Org-mode.") @@ -14131,16 +15338,18 @@ The following commands are available: ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] "--" - ("Tags" + ("Tags and Properties" ["Show all Tags" org-agenda-show-tags t] - ["Set Tags" org-agenda-set-tags t]) + ["Set Tags" org-agenda-set-tags t] + "--" + ["Column View" org-columns t]) ("Date/Schedule" ["Schedule" org-agenda-schedule t] ["Set Deadline" org-agenda-deadline t] "--" - ["Change date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] - ["Change date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] - ["Change date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) + ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] + ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] + ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) ("Priority" ["Set Priority" org-agenda-priority t] ["Increase Priority" org-agenda-priority-up t] @@ -14161,6 +15370,10 @@ The following commands are available: :style radio :selected (equal org-agenda-ndays 1)] ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (equal org-agenda-ndays 7)] + ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) + :style radio :selected (member org-agenda-ndays '(28 29 30 31))] + ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) + :style radio :selected (member org-agenda-ndays '(365 366))] "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)] @@ -14195,11 +15408,6 @@ The following commands are available: `(unless (get-text-property (point) 'org-protected) ,@body)) -(defmacro org-unmodified (&rest body) - "Execute body without changing buffer-modified-p." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) ,@body))) - (defmacro org-with-remote-undo (_buffer &rest _body) "Execute BODY while recording undo information in two buffers." (declare (indent 1) (debug t)) @@ -14477,7 +15685,7 @@ L Timeline for current buffer # List stuck projects (!=configure) "Run an agenda command in batch mode and send the result to STDOUT. If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. +longer string is is used as a tags/todo match string. Paramters are alternating variable names and values that will be bound before running the agenda command." (let (pars) @@ -14503,7 +15711,7 @@ before running the agenda command." "Run an agenda command in batch mode and send the result to STDOUT. If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. +longer string is is used as a tags/todo match string. Paramters are alternating variable names and values that will be bound before running the agenda command. @@ -14531,7 +15739,8 @@ date The relevant date, like 2007-2-14 time The time, like 15:00-16:50 extra Sting with extra planning info priority-l The priority letter if any was given -priority-n The computed numerical priority" +priority-n The computed numerical priority +agenda-day The day in the agenda where this is listed" (let (pars) (while parameters @@ -14554,7 +15763,7 @@ priority-n The computed numerical priority" (org-encode-for-stdout (mapconcat 'org-agenda-export-csv-mapper '(org-category txt type todo tags date time-of-day extra - priority-letter priority) + priority-letter priority agenda-day) ","))) (princ "\n")))))) @@ -14574,7 +15783,8 @@ priority-n The computed numerical priority" (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form '(year "-" month "-" day))) (setq tmp (calendar-date-string tmp))) - (setq props (plist-put props 'day tmp))) + (setq props (plist-put props 'day tmp)) + (setq props (plist-put props 'agenda-day tmp))) (when (setq tmp (plist-get props 'txt)) (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) (plist-put props 'priority-letter (match-string 1 tmp)) @@ -14873,15 +16083,22 @@ Optional argument FILE means, use this file instead of the current." (defun org-finalize-agenda () "Finishing touch for the agenda buffer, called just before displaying it." (unless org-agenda-multi - (org-agenda-align-tags) (save-excursion (let ((buffer-read-only)) (goto-char (point-min)) (while (org-activate-bracket-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link))) + (org-agenda-align-tags) (unless org-agenda-with-colors (remove-text-properties (point-min) (point-max) '(face nil)))) + (if (and (boundp 'org-overriding-columns-format) + org-overriding-columns-format) + (org-set-local 'org-overriding-columns-format + org-overriding-columns-format)) + (if (and (boundp 'org-agenda-view-columns-initially) + org-agenda-view-columns-initially) + (org-agenda-columns)) (run-hooks 'org-finalize-agenda-hook)))) (defun org-prepare-agenda-buffers (files) @@ -15154,9 +16371,11 @@ When EMPTY is non-nil, also include days without any entries." ;;; Agenda Daily/Weekly (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter +(defvar org-agenda-start-day nil) ; dynamically scoped parameter (defvar org-agenda-last-arguments nil "The arguments of the previous call to org-agenda") (defvar org-starting-day nil) ; local variable in the agenda buffer +(defvar org-agenda-span nil) ; local variable in the agenda buffer (defvar org-include-all-loc nil) ; local variable @@ -15174,18 +16393,22 @@ START-DAY defaults to TODAY, or to the most recent match for the weekday given in `org-agenda-start-on-weekday'. NDAYS defaults to `org-agenda-ndays'." (interactive "P") + (setq ndays (or ndays org-agenda-ndays) + start-day (or start-day org-agenda-start-day)) (if org-agenda-overriding-arguments (setq include-all (car org-agenda-overriding-arguments) start-day (nth 1 org-agenda-overriding-arguments) ndays (nth 2 org-agenda-overriding-arguments))) + (if (stringp start-day) + ;; Convert to an absolute day number + (setq start-day (time-to-days (org-read-date nil t start-day)))) (setq org-agenda-last-arguments (list include-all start-day ndays)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) (require 'calendar) (let* ((org-agenda-start-on-weekday - (if (or (equal ndays 1) - (and (null ndays) (equal 1 org-agenda-ndays))) - nil org-agenda-start-on-weekday)) + (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) + org-agenda-start-on-weekday nil)) (thefiles (org-agenda-files)) (files thefiles) (today (time-to-days (current-time))) @@ -15213,6 +16436,8 @@ NDAYS defaults to `org-agenda-ndays'." (org-prepare-agenda "Day/Week") (org-set-local 'org-starting-day (car day-numbers)) (org-set-local 'org-include-all-loc include-all) + (org-set-local 'org-agenda-span + (org-agenda-ndays-to-span nd)) (when (and (or include-all org-agenda-include-all-todo) (member today day-numbers)) (setq files thefiles @@ -15230,7 +16455,8 @@ NDAYS defaults to `org-agenda-ndays'." (list 'face 'org-agenda-structure)) (insert (org-finalize-agenda-entries rtnall) "\n"))) (setq s (point)) - (insert (if (= nd 7) "Week-" "Day-") "agenda:\n") + (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) + "-agenda:\n") (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure 'org-date-line t)) (while (setq d (pop day-numbers)) @@ -15294,6 +16520,9 @@ NDAYS defaults to `org-agenda-ndays'." (setq buffer-read-only t) (message ""))) +(defun org-agenda-ndays-to-span (n) + (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year))) + ;;; Agenda TODO list (defvar org-select-this-todo-keyword nil) @@ -15476,10 +16705,10 @@ MATCH is being ignored." "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - "^\\*+.*:[a-zA-Z0-9_@]+:[ \t]*$" + (org-re "^\\*+.*:[[:alnum:]_@]+:[ \t]*$") (concat "^\\*+.*:\\(" (mapconcat 'identity tags "\\|") - "\\):[a-zA-Z0-9_@:]*[ \t]*$"))) + (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -15580,8 +16809,10 @@ date. It also removes lines that contain only whitespace." (org-add-props string nil 'mouse-face 'highlight 'keymap org-agenda-keymap - 'help-echo (format "mouse-2 or RET jump to diary file %s" - (abbreviate-file-name buffer-file-name)) + 'help-echo (if buffer-file-name + (format "mouse-2 or RET jump to diary file %s" + (abbreviate-file-name buffer-file-name)) + "") 'org-agenda-diary-link t 'org-marker (org-agenda-new-marker (point-at-bol)))) @@ -15715,6 +16946,8 @@ the documentation of `org-diary'." (setq results (append results rtn)))))))) results)))) +;; FIXME: this works only if the cursor is not at the +;; beginning of the entry (defun org-entry-is-done-p () "Is the current entry marked DONE?" (save-excursion @@ -16154,7 +17387,6 @@ the documentation of `org-diary'." ;;; Agenda presentation and sorting -;; FIXME: should I allow spaces around the dash? (defconst org-plain-time-of-day-regexp (concat "\\(\\<[012]?[0-9]" @@ -16173,7 +17405,7 @@ groups carry important information: (defconst org-stamp-time-of-day-regexp (concat "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" - "\\([012][0-9]:[0-5][0-9]\\)>" + "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" "\\(--?" "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") "Regular expression to match a timestamp time or time range. @@ -16216,14 +17448,15 @@ only the correctly processes TXT should be returned - this is used by time ; time and tag are needed for the eval of the prefix format (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn) + stamp plain s0 s1 s2 rtn srp) (when (and dotime time-of-day org-prefix-has-time) ;; Extract starting and ending time and move them to prefix (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) (setq plain (string-match org-plain-time-of-day-regexp ts))) (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) s1 (match-string (if plain 1 2) ts) - s2 (match-string (if plain 8 4) ts)) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) ;; If the times are in TXT (not in DOTIMES), and the prefix will list ;; them, we might want to remove them there to avoid duplication. @@ -16238,7 +17471,17 @@ only the correctly processes TXT should be returned - this is used by (if s1 (setq s1 (org-get-time-of-day s1 'string t))) (if s2 (setq s2 (org-get-time-of-day s2 'string t)))) - (when (string-match "\\([ \t]+\\)\\(:[a-zA-Z_@0-9:]+:\\)[ \t]*$" txt) + (when (and s1 (not s2) org-agenda-default-appointment-duration + (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) + (let ((m (+ (string-to-number (match-string 2 s1)) + (* 60 (string-to-number (match-string 1 s1))) + org-agenda-default-appointment-duration)) + h) + (setq h (/ m 60) m (- m (* h 60))) + (setq s2 (format "%02d:%02d" h m)))) + + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) (and org-agenda-remove-tags @@ -16471,7 +17714,8 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (let ((buf (current-buffer))) (if (not (one-window-p)) (delete-window)) (kill-buffer buf) - (org-agenda-maybe-reset-markers 'force)) + (org-agenda-maybe-reset-markers 'force) + (org-remove-column-overlays)) ;; Maybe restore the pre-agenda window configuration. (and org-agenda-restore-windows-after-quit (not (eq org-agenda-window-setup 'other-frame)) @@ -16517,8 +17761,11 @@ When this is the global TODO list, a prefix argument will be interpreted." (cond (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) - (let ((org-agenda-overriding-arguments org-agenda-last-arguments)) - (setf (nth 1 org-agenda-overriding-arguments) nil) + (let* ((sd (time-to-days (current-time))) + (comp (org-agenda-compute-time-span sd org-agenda-span)) + (org-agenda-overriding-arguments org-agenda-last-arguments)) + (setf (nth 1 org-agenda-overriding-arguments) (car comp)) + (setf (nth 2 org-agenda-overriding-arguments) (cdr comp)) (org-agenda-redo) (org-agenda-find-today-or-agenda))) (t (error "Cannot find today"))))) @@ -16530,62 +17777,106 @@ When this is the global TODO list, a prefix argument will be interpreted." (point-min)))) (defun org-agenda-later (arg) - "Go forward in time by `org-agenda-ndays' days. -With prefix ARG, go forward that many times `org-agenda-ndays'." + "Go forward in time by thee current span. +With prefix ARG, go forward that many times the current span." (interactive "p") (org-agenda-check-type t 'agenda) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) - (+ org-starting-day (* arg org-agenda-ndays)) - nil t))) + (let* ((span org-agenda-span) + (sd org-starting-day) + (greg (calendar-gregorian-from-absolute sd)) + greg2 nd) + (cond + ((eq span 'day) + (setq sd (+ arg sd) nd 1)) + ((eq span 'week) + (setq sd (+ (* 7 arg) sd) nd 7)) + ((eq span 'month) + (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) + sd (calendar-absolute-from-gregorian greg2)) + (setcar greg2 (1+ (car greg2))) + (setq nd (- (calendar-absolute-from-gregorian greg2) sd))) + ((eq span 'year) + (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) + sd (calendar-absolute-from-gregorian greg2)) + (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))) + (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))) + (let ((org-agenda-overriding-arguments + (list (car org-agenda-last-arguments) sd nd t))) (org-agenda-redo) - (org-agenda-find-today-or-agenda))) - + (org-agenda-find-today-or-agenda)))) + (defun org-agenda-earlier (arg) - "Go back in time by `org-agenda-ndays' days. -With prefix ARG, go back that many times `org-agenda-ndays'." + "Go backward in time by the current span. +With prefix ARG, go backward that many times the current span." (interactive "p") - (org-agenda-check-type t 'agenda) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) - (- org-starting-day (* arg org-agenda-ndays)) - nil t))) - (org-agenda-redo) - (org-agenda-find-today-or-agenda))) + (org-agenda-later (- arg))) +(defun org-agenda-day-view () + "Switch to daily view for agenda." + (interactive) + (org-agenda-change-time-span 'day)) (defun org-agenda-week-view () - "Switch to weekly view for agenda." + "Switch to daily view for agenda." (interactive) - (org-agenda-check-type t 'agenda) - (if (= org-agenda-ndays 7) - (error "This is already the week view")) - (setq org-agenda-ndays 7) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) - (or (get-text-property (point) 'day) - org-starting-day) - nil t))) - (org-agenda-redo) - (org-agenda-find-today-or-agenda)) - (org-agenda-set-mode-name) - (message "Switched to week view")) - -(defun org-agenda-day-view () + (org-agenda-change-time-span 'week)) +(defun org-agenda-month-view () "Switch to daily view for agenda." (interactive) + (org-agenda-change-time-span 'month)) +(defun org-agenda-year-view () + "Switch to daily view for agenda." + (interactive) + (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") + (org-agenda-change-time-span 'year) + (error "Abort"))) + +(defun org-agenda-change-time-span (span) + "Change the agenda view to SPAN. +SPAN may be `day', `week', `month', `year'." (org-agenda-check-type t 'agenda) - (if (= org-agenda-ndays 1) - (error "This is already the day view")) - (setq org-agenda-ndays 1) - (let ((org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) - (or (get-text-property (point) 'day) - org-starting-day) - nil t))) + (if (equal org-agenda-span span) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (get-text-property (point) 'day) + org-starting-day)) + (computed (org-agenda-compute-time-span sd span)) + (org-agenda-overriding-arguments + (list (car org-agenda-last-arguments) + (car computed) (cdr computed) t))) (org-agenda-redo) (org-agenda-find-today-or-agenda)) (org-agenda-set-mode-name) - (message "Switched to day view")) + (message "Switched to %s view" span)) + +(defun org-agenda-compute-time-span (sd span) + "Compute starting date and number of days for agenda. +SPAN may be `day', `week', `month', `year'. The return value +is a cons cell with the starting date and the number of days, +so that the date SD will be in that range." + (let* ((greg (calendar-gregorian-from-absolute sd)) + nd) + (cond + ((eq span 'day) + (setq nd 1)) + ((eq span 'week) + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (n1 org-agenda-start-on-weekday) + (d (- nt n1))) + (setq sd (- sd (+ (if (< d 0) 7 0) d))) + (setq nd 7))) + ((eq span 'month) + (setq sd (calendar-absolute-from-gregorian + (list (car greg) 1 (nth 2 greg))) + nd (- (calendar-absolute-from-gregorian + (list (1+ (car greg)) 1 (nth 2 greg))) + sd))) + ((eq span 'year) + (setq sd (calendar-absolute-from-gregorian + (list 1 1 (nth 2 greg))) + nd (- (calendar-absolute-from-gregorian + (list 1 1 (1+ (nth 2 greg)))) + sd)))) + (cons sd nd))) ;; FIXME: this no longer works if user make date format that starts with a blank (defun org-agenda-next-date-line (&optional arg) @@ -16977,7 +18268,7 @@ the new TODO state." (let ((buffer-read-only)) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward "\\([ \t]+\\):[a-zA-Z0-9_@:]+:[ \t]*$" + (while (re-search-forward (org-re "\\([ \t]+\\):[[:alnum:]_@:]+:[ \t]*$") (if line (point-at-eol) nil) t) (delete-region (match-beginning 1) (match-end 1)) (goto-char (match-beginning 1)) @@ -17038,7 +18329,7 @@ the tags of the current headline come last." (org-back-to-heading t) (condition-case nil (while t - (if (looking-at "[^\r\n]+?:\\([a-zA-Z_@0-9:]+\\):[ \t]*\\([\n\r]\\|\\'\\)") + (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*\\([\n\r]\\|\\'\\)")) (setq tags (append (org-split-string (org-match-string-no-properties 1) ":") tags))) @@ -17705,6 +18996,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (:archived-trees . org-export-with-archived-trees) (:emphasize . org-export-with-emphasize) (:sub-superscript . org-export-with-sub-superscripts) + (:footnotes . org-export-with-footnotes) + (:property-drawer . org-export-with-property-drawer) (:TeX-macros . org-export-with-TeX-macros) (:LaTeX-fragments . org-export-with-LaTeX-fragments) (:skip-before-1st-heading . org-export-skip-text-before-1st-heading) @@ -17761,6 +19054,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (":" . :fixed-width) ("|" . :tables) ("^" . :sub-superscript) + ("f" . :footnotes) + ("p" . :property-drawer) ("*" . :emphasize) ("TeX" . :TeX-macros) ("LaTeX" . :LaTeX-fragments) @@ -18206,6 +19501,12 @@ translations. There is currently no way for users to extend this.") b (org-end-of-subtree t)) (if (> b a) (delete-region a b))))) + ;; Get rid of property drawers + (unless org-export-with-property-drawer + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t) + (replace-match ""))) + ;; Protect stuff from HTML processing (goto-char (point-min)) (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) @@ -18319,7 +19620,7 @@ translations. There is currently no way for users to extend this.") (save-excursion (goto-char (point-min)) (let ((end (save-excursion (outline-next-heading) (point)))) - (when (re-search-forward "^[ \t]*[^# \t\r\n].*\n" end t) + (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t) ;; Mark the line so that it will not be exported as normal text. (org-unmodified (add-text-properties (match-beginning 0) (match-end 0) @@ -18508,7 +19809,9 @@ underlined headlines. The default is 3." (setq txt (org-html-expand-for-ascii txt)) (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match "[ \t]+:[a-zA-Z0-9_@:]+:[ \t]*$" txt)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) @@ -18568,7 +19871,12 @@ underlined headlines. The default is 3." (org-format-table-ascii table-buffer) "\n") "\n"))) (t - (insert (org-fix-indentation line org-ascii-current-indentation) "\n")))) + (setq line (org-fix-indentation line org-ascii-current-indentation)) + (if (and org-export-with-fixed-width + (string-match "^\\([ \t]*\\)\\(:\\)" line)) + (setq line (replace-match "\\1" nil nil line))) + (insert line "\n")))) + (normal-mode) ;; insert the table of contents @@ -18655,7 +19963,7 @@ underlined headlines. The default is 3." (insert "\n")) (setq char (nth (- umax level) (reverse org-export-ascii-underline))) (unless org-export-with-tags - (if (string-match "[ \t]+\\(:[a-zA-Z0-9_@:]+:\\)[ \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))) @@ -18741,7 +20049,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EMAIL: %s #+LANGUAGE: %s #+TEXT: Some descriptive text to be emitted. Several lines OK. -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s LaTeX:%s skip:%s +#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s p:%s #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -18760,10 +20068,12 @@ Does include HTML export options as well as TODO and CATEGORY stuff." org-export-with-fixed-width org-export-with-tables org-export-with-sub-superscripts + org-export-with-footnotes org-export-with-emphasize org-export-with-TeX-macros org-export-with-LaTeX-fragments org-export-skip-text-before-1st-heading + org-export-with-property-drawer (file-name-nondirectory buffer-file-name) "TODO FEEDBACK VERIFY DONE" "Me Jason Marie DONE" @@ -19008,11 +20318,14 @@ the body tags themselves." (start 0) (coding-system (and (boundp 'buffer-file-coding-system) buffer-file-coding-system)) - (coding-system-for-write coding-system) - (save-buffer-coding-system coding-system) - (charset (and coding-system + (coding-system-for-write (or org-export-html-coding-system + coding-system)) + (save-buffer-coding-system (or org-export-html-coding-system + coding-system)) + (charset (and coding-system-for-write (fboundp 'coding-system-get) - (coding-system-get coding-system 'mime-charset))) + (coding-system-get coding-system-for-write + 'mime-charset))) (region (buffer-substring (if region-p (region-beginning) (point-min)) @@ -19123,7 +20436,9 @@ lang=\"%s\" xml:lang=\"%s\"> (org-search-todo-below line lines level)))) (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match "[ \t]+:[a-zA-Z0-9_@:]+:[ \t]*$" txt)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) @@ -19331,27 +20646,30 @@ lang=\"%s\" xml:lang=\"%s\"> "></i>")))) (setq line (replace-match rpl t t line) start (+ start (length rpl)))) + ;; TODO items (if (and (string-match org-todo-line-regexp line) (match-beginning 2)) - (if (member (match-string 2 line) org-done-keywords) - (setq line (replace-match - "<span class=\"done\">\\2</span>" - t nil line 2)) - (setq line - (concat (substring line 0 (match-beginning 2)) - "<span class=\"todo\">" (match-string 2 line) - "</span>" (substring line (match-end 2)))))) + + (setq line + (concat (substring line 0 (match-beginning 2)) + "<span class=\"" + (if (member (match-string 2 line) + org-done-keywords) + "done" "todo") + "\">" (match-string 2 line) + "</span>" (substring line (match-end 2))))) ;; Does this contain a reference to a footnote? - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) - (let ((n (match-string 2 line))) - (setq line - (replace-match - (format - "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" - (match-string 1 line) n n n) - t t line)))) + (when org-export-with-footnotes + (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) + (let ((n (match-string 2 line))) + (setq line + (replace-match + (format + "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" + (match-string 1 line) n n n) + t t line))))) (cond ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) @@ -19455,11 +20773,12 @@ lang=\"%s\" xml:lang=\"%s\"> (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) ;; Is this the start of a footnote? - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) - (org-close-par-maybe) - (let ((n (match-string 1 line))) - (setq line (replace-match - (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line)))) + (when org-export-with-footnotes + (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) + (org-close-par-maybe) + (let ((n (match-string 1 line))) + (setq line (replace-match + (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line))))) ;; Check if the line break needs to be conserved (cond @@ -19570,7 +20889,7 @@ lang=\"%s\" xml:lang=\"%s\"> (nreverse rtn)))) (defun org-colgroup-info-to-vline-list (info) - (let (vl new last rtn line) + (let (vl new last) (while info (setq last new new (pop info)) (if (or (memq last '(:end :startend)) @@ -19623,7 +20942,7 @@ lang=\"%s\" xml:lang=\"%s\"> (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) (nlines 0) fnum i - tbopen line fields html gr) + tbopen line fields html gr colgropen) (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) @@ -19664,13 +20983,20 @@ lang=\"%s\" xml:lang=\"%s\"> (push (mapconcat (lambda (x) (setq gr (pop org-table-colgroup-info)) - (format "%s<COL align=\"%s\">%s" - (if (memq gr '(:start :startend)) "<colgroup>" "") + (format "%s<COL align=\"%s\"></COL>%s" + (if (memq gr '(:start :startend)) + (prog1 + (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") + (setq colgropen t)) + "") (if (> (/ (float x) nlines) org-table-number-fraction) "right" "left") - (if (memq gr '(:end :startend)) "</colgroup>" ""))) + (if (memq gr '(:end :startend)) + (progn (setq colgropen nil) "</colgroup>") + ""))) fnum "") html) + (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) (push org-export-html-table-tag html)) (concat (mapconcat 'identity html "\n") "\n"))) @@ -19829,7 +21155,7 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (defun org-export-cleanup-toc-line (s) "Remove tags and time staps from lines going into the toc." - (if (string-match " +:[a-zA-Z0-9_@:]+: *$" 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) @@ -19954,6 +21280,7 @@ stacked delimiters is N. Escaping delimiters is not possible." (org-close-par-maybe) (insert "</li>\n")) +(defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) "Insert a new level in HTML export. When TITLE is nil, just close all open levels." @@ -19968,7 +21295,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 "\\(:[a-zA-Z0-9_@:]+:\\)[ \t]*$" title) + (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags (save-match-data @@ -19989,7 +21316,7 @@ When TITLE is nil, just close all open levels." (aset org-levels-open (1- level) t) (org-close-par-maybe) (insert "<ul>\n<li>" title "<br/>\n"))) - (if org-export-with-section-numbers + (if (and org-export-with-section-numbers (not body-only)) (setq title (concat (org-section-number level) " " title))) (setq level (+ level org-export-html-toplevel-hlevel -1)) (if with-toc @@ -20107,10 +21434,14 @@ When COMBINE is non nil, add the category to each line." (progn (goto-char (match-end 0)) (setq ts2 (match-string 1) inc nil)) - (setq ts2 ts - tmp (buffer-substring (max (point-min) + (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) + ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) + (progn + (setq inc nil) + (replace-match "\\1" t nil ts)) + ts) deadlinep (string-match org-deadline-regexp tmp) scheduledp (string-match org-scheduled-regexp tmp) ;; donep (org-entry-is-done-p) @@ -20427,7 +21758,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) (org-defkey org-mode-map "\C-c]" 'org-remove-file) -(org-defkey org-mode-map "\C-c-" 'org-table-insert-hline) +(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) (org-defkey org-mode-map "\C-c^" 'org-sort) (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) @@ -20464,6 +21795,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*" (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) +(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) + (when (featurep 'xemacs) (org-defkey org-mode-map 'button3 'popup-mode-menu)) @@ -20835,7 +22168,7 @@ This command does many different things, depending on context: ((org-at-item-checkbox-p) (call-interactively 'org-toggle-checkbox)) ((org-at-item-p) - (call-interactively 'org-renumber-ordered-list)) + (call-interactively 'org-maybe-renumber-ordered-list)) ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) (cond ((equal (match-string 1) "TBLFM") @@ -20862,11 +22195,24 @@ Calls `org-table-next-row' or `newline', depending on context. See the individual commands for more information." (interactive) (cond + ((bobp) (newline)) ((org-at-table-p) (org-table-justify-field-maybe) (call-interactively 'org-table-next-row)) (t (newline)))) +(defun org-ctrl-c-minus () + "Insert separator line in table or modify bullet type in list. +Calls `org-table-insert-hline' or `org-cycle-list-bullet', +depending on context." + (interactive) + (cond + ((org-at-table-p) + (call-interactively 'org-table-insert-hline)) + ((org-in-item-p) + (call-interactively 'org-cycle-list-bullet)) + (t (error "`C-c -' does have no function here.")))) + (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. Calls `org-insert-heading' or `org-table-wrap-region', depending on context. @@ -20903,7 +22249,7 @@ See the individual commands for more information." ["Insert Row" org-shiftmetadown (org-at-table-p)] ["Sort lines in region" org-table-sort-lines (org-at-table-p)] "--" - ["Insert Hline" org-table-insert-hline (org-at-table-p)]) + ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) ("Rectangle" ["Copy Rectangle" org-copy-special (org-at-table-p)] ["Cut Rectangle" org-cut-special (org-at-table-p)] @@ -21026,6 +22372,9 @@ See the individual commands for more information." ; (or (org-on-heading-p) (org-at-item-p))] ; ["Update Statistics" org-update-checkbox-count t] ) + ("TAGS and Properties" + ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] + ["Column view of properties" org-columns t]) ("Dates and Scheduling" ["Timestamp" org-time-stamp t] ["Timestamp (inactive)" org-time-stamp-inactive t] @@ -21410,18 +22759,51 @@ not an indirect buffer" (defun org-indent-line-function () "Indent line like previous, but further if previous was headline or item." (interactive) - (let ((column (save-excursion - (beginning-of-line) - (if (looking-at "#") 0 - (skip-chars-backward "\n \t") - (beginning-of-line) - (if (or (looking-at "\\*+[ \t]+") - (looking-at "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)")) - (progn (goto-char (match-end 0)) (current-column)) - (current-indentation)))))) + (let* ((pos (point)) + (itemp (org-at-item-p)) + column bpos bcol tpos tcol bullet btype bullet-type) + ;; Find the previous relevant line + (beginning-of-line 1) + (cond + ((looking-at "#") (setq column 0)) + ((looking-at "\\*+ ") (setq column 0)) + (t + (beginning-of-line 0) + (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) + (beginning-of-line 0)) + (cond + ((looking-at "\\*+[ \t]+") + (goto-char (match-end 0)) + (setq column (current-column))) + ((org-in-item-p) + (org-beginning-of-item) + (looking-at "[ \t]*\\(\\S-+\\)[ \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 (not itemp) + (setq column tcol) + (goto-char pos) + (beginning-of-line 1) + (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)))) + (t (setq column (org-get-indentation)))))) + (goto-char pos) (if (<= (current-column) (current-indentation)) (indent-line-to column) - (save-excursion (indent-line-to column))))) + (save-excursion (indent-line-to column))) + (setq column (current-column)) + (beginning-of-line 1) + (if (looking-at + "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") + (replace-match (concat "\\1" (format org-property-format + (match-string 2) (match-string 3))) + t nil)) + (move-to-column column))) (defun org-set-autofill-regexps () (interactive) @@ -21550,16 +22932,16 @@ move point." (pos (point)) (re (concat "^" outline-regexp)) level l) - (org-back-to-heading t) - (setq level (funcall outline-level)) - (catch 'exit - (or previous (forward-char 1)) - (while (funcall fun re nil t) - (setq l (funcall outline-level)) - (when (< l level) (goto-char pos) (throw 'exit nil)) - (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) - (goto-char pos) - nil))) + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq level (funcall outline-level)) + (catch 'exit + (or previous (forward-char 1)) + (while (funcall fun re nil t) + (setq l (funcall outline-level)) + (when (< l level) (goto-char pos) (throw 'exit nil)) + (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) + (goto-char pos) + nil)))) (defun org-show-siblings () "Show all siblings of the current headline." @@ -21717,6 +23099,8 @@ Still experimental, may disappear in the furture." ;; make tree, check each match with the callback (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) + + ;;;; Finish up (provide 'org) @@ -21725,4 +23109,3 @@ Still experimental, may disappear in the furture." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here - diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 85f6ccff70a..f09303bce38 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -279,8 +279,8 @@ Any terminating `>' or `/' is not matched.") . (cons (concat "<" (regexp-opt (mapcar 'car sgml-tag-face-alist) t) "\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>") - '(3 (cdr (assoc (downcase (match-string 1)) - sgml-tag-face-alist)) prepend)))))) + '(3 (cdr (assoc-string (match-string 1) sgml-tag-face-alist t)) + prepend)))))) ;; for font-lock, but must be defvar'ed after ;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above @@ -366,20 +366,19 @@ a DOCTYPE or an XML declaration." "List of tags whose !ELEMENT definition says the end-tag is optional.") (defun sgml-xml-guess () - "Guess whether the current buffer is XML." + "Guess whether the current buffer is XML. Return non-nil if so." (save-excursion (goto-char (point-min)) - (when (or (string= "xml" (file-name-extension (or buffer-file-name ""))) - (looking-at "\\s-*<\\?xml") - (when (re-search-forward - (eval-when-compile + (or (string= "xml" (file-name-extension (or buffer-file-name ""))) + (looking-at "\\s-*<\\?xml") + (when (re-search-forward + (eval-when-compile (mapconcat 'identity '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)" - "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"") - "\\s-+")) - nil t) - (string-match "X\\(HT\\)?ML" (match-string 3)))) - (set (make-local-variable 'sgml-xml-mode) t)))) + "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"") + "\\s-+")) + nil t) + (string-match "X\\(HT\\)?ML" (match-string 3)))))) (defvar v2) ; free for skeleton @@ -407,7 +406,7 @@ a DOCTYPE or an XML declaration." (eq (char-before) ?<)))) ;;;###autoload -(define-derived-mode sgml-mode text-mode "SGML" +(define-derived-mode sgml-mode text-mode '(sgml-xml-mode "XML" "SGML") "Major mode for editing SGML documents. Makes > match <. Keys <, &, SPC within <>, \", / and ' can be electric depending on @@ -459,9 +458,9 @@ Do \\[describe-key] on the following bindings to discover what they do. . sgml-font-lock-syntactic-keywords))) (set (make-local-variable 'facemenu-add-face-function) 'sgml-mode-facemenu-add-face-function) - (sgml-xml-guess) + (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess)) (if sgml-xml-mode - (setq mode-name "XML") + () (set (make-local-variable 'skeleton-transformation-function) sgml-transformation-function)) ;; This will allow existing comments within declarations to be @@ -734,22 +733,93 @@ With prefix argument, only self insert." (defun sgml-skip-tag-backward (arg) "Skip to beginning of tag or matching opening tag if present. -With prefix argument ARG, repeat this ARG times." +With prefix argument ARG, repeat this ARG times. +Return non-nil if we skipped over matched tags." (interactive "p") ;; FIXME: use sgml-get-context or something similar. - (while (>= arg 1) - (search-backward "<" nil t) - (if (looking-at "</\\([^ \n\t>]+\\)") - ;; end tag, skip any nested pairs - (let ((case-fold-search t) - (re (concat "</?" (regexp-quote (match-string 1)) - ;; Ignore empty tags like <foo/>. - "\\([^>]*[^/>]\\)?>"))) - (while (and (re-search-backward re nil t) - (eq (char-after (1+ (point))) ?/)) - (forward-char 1) - (sgml-skip-tag-backward 1)))) - (setq arg (1- arg)))) + (let ((return t)) + (while (>= arg 1) + (search-backward "<" nil t) + (if (looking-at "</\\([^ \n\t>]+\\)") + ;; end tag, skip any nested pairs + (let ((case-fold-search t) + (re (concat "</?" (regexp-quote (match-string 1)) + ;; Ignore empty tags like <foo/>. + "\\([^>]*[^/>]\\)?>"))) + (while (and (re-search-backward re nil t) + (eq (char-after (1+ (point))) ?/)) + (forward-char 1) + (sgml-skip-tag-backward 1))) + (setq return nil)) + (setq arg (1- arg))) + return)) + +(defvar sgml-electric-tag-pair-overlays nil) +(defvar sgml-electric-tag-pair-timer nil) + +(defun sgml-electric-tag-pair-before-change-function (beg end) + (condition-case err + (save-excursion + (goto-char end) + (skip-chars-backward "[:alnum:]-_.:") + (if (and ;; (<= (point) beg) ; This poses problems for downcase-word. + (or (eq (char-before) ?<) + (and (eq (char-before) ?/) + (eq (char-before (1- (point))) ?<))) + (null (get-char-property (point) 'text-clones))) + (let* ((endp (eq (char-before) ?/)) + (cl-start (point)) + (cl-end (progn (skip-chars-forward "[:alnum:]-_.:") (point))) + (match + (if endp + (when (sgml-skip-tag-backward 1) (forward-char 1) t) + (with-syntax-table sgml-tag-syntax-table + (up-list -1) + (when (sgml-skip-tag-forward 1) + (backward-sexp 1) + (forward-char 2) + t)))) + (clones (get-char-property (point) 'text-clones))) + (when (and match + (/= cl-end cl-start) + (equal (buffer-substring cl-start cl-end) + (buffer-substring (point) + (save-excursion + (skip-chars-forward "[:alnum:]-_.:") + (point)))) + (or (not endp) (eq (char-after cl-end) ?>))) + (when clones + (message "sgml-electric-tag-pair-before-change-function: deleting old OLs") + (mapc 'delete-overlay clones)) + (message "sgml-electric-tag-pair-before-change-function: new clone") + (text-clone-create cl-start cl-end 'spread "[[:alnum:]-_.:]+") + (setq sgml-electric-tag-pair-overlays + (append (get-char-property (point) 'text-clones) + sgml-electric-tag-pair-overlays)))))) + (scan-error nil) + (error (message "Error in sgml-electric-pair-mode: %s" err)))) + +(defun sgml-electric-tag-pair-flush-overlays () + (while sgml-electric-tag-pair-overlays + (delete-overlay (pop sgml-electric-tag-pair-overlays)))) + +(define-minor-mode sgml-electric-tag-pair-mode + "Automatically update the closing tag when editing the opening one." + :lighter "/e" + (if sgml-electric-tag-pair-mode + (progn + (add-hook 'before-change-functions + 'sgml-electric-tag-pair-before-change-function + nil t) + (unless sgml-electric-tag-pair-timer + (setq sgml-electric-tag-pair-timer + (run-with-idle-timer 5 'repeat 'sgml-electric-tag-pair-flush-overlays)))) + (remove-hook 'before-change-functions + 'sgml-electric-tag-pair-before-change-function + t) + ;; We leave the timer running for other buffers. + )) + (defun sgml-skip-tag-forward (arg) "Skip to end of tag or matching closing tag if present. @@ -1218,7 +1288,7 @@ not the case, the first tag returned is the one inside which we are." ((eq (sgml-tag-type tag-info) 'open) (cond ((null stack) - (if (member-ignore-case (sgml-tag-name tag-info) ignore) + (if (assoc-string (sgml-tag-name tag-info) ignore t) ;; There was an implicit end-tag. nil (push tag-info context) @@ -1303,12 +1373,13 @@ the current start-tag or the current comment or the current cdata, ..." (defun sgml-empty-tag-p (tag-name) "Return non-nil if TAG-NAME is an implicitly empty tag." (and (not sgml-xml-mode) - (member-ignore-case tag-name sgml-empty-tags))) + (assoc-string tag-name sgml-empty-tags 'ignore-case))) (defun sgml-unclosed-tag-p (tag-name) "Return non-nil if TAG-NAME is a tag for which an end-tag is optional." (and (not sgml-xml-mode) - (member-ignore-case tag-name sgml-unclosed-tags))) + (assoc-string tag-name sgml-unclosed-tags 'ignore-case))) + (defun sgml-calculate-indent (&optional lcon) "Calculate the column to which this line should be indented. @@ -1374,8 +1445,8 @@ LCON is the lexical context, if any." (let* ((here (point)) (unclosed (and ;; (not sgml-xml-mode) (looking-at sgml-tag-name-re) - (member-ignore-case (match-string 1) - sgml-unclosed-tags) + (assoc-string (match-string 1) + sgml-unclosed-tags 'ignore-case) (match-string 1))) (context ;; If possible, align on the previous non-empty text line. @@ -1813,11 +1884,11 @@ This takes effect when first loading the library.") ("ul" . "Unordered list") ("var" . "Math variable face") ("wbr" . "Enable <br> within <nobr>")) -"*Value of `sgml-tag-help' for HTML mode.") + "*Value of `sgml-tag-help' for HTML mode.") ;;;###autoload -(define-derived-mode html-mode sgml-mode "HTML" +(define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") "Major mode based on SGML mode for editing HTML documents. This allows inserting skeleton constructs used in hypertext documents with completion. See below for an introduction to HTML. Use @@ -1871,7 +1942,6 @@ To work around that, do: outline-level (lambda () (char-before (match-end 0)))) (setq imenu-create-index-function 'html-imenu-index) - (when sgml-xml-mode (setq mode-name "XHTML")) (set (make-local-variable 'sgml-empty-tags) ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd', ;; plus manual addition of "wbr". diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 577eb2e1938..9f576b09db3 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -57,8 +57,6 @@ If optional argument HERE is non-nil, insert info at point." (require 'texinfo) ; So `texinfo-footnote-style' is defined. (require 'texnfo-upd) ; So `texinfo-section-types-regexp' is defined. -(defvar texinfo-format-syntax-table nil) - (defvar texinfo-vindex) (defvar texinfo-findex) (defvar texinfo-cindex) @@ -81,27 +79,80 @@ If optional argument HERE is non-nil, insert info at point." (defvar texinfo-short-index-format-cmds-alist) (defvar texinfo-format-filename) (defvar texinfo-footnote-number) -(defvar texinfo-start-of-header) -(defvar texinfo-end-of-header) -(defvar texinfo-raisesections-alist) -(defvar texinfo-lowersections-alist) + +(defvar texinfo-raisesections-alist + '((@chapter . @chapter) ; Cannot go higher + (@unnumbered . @unnumbered) + (@centerchap . @unnumbered) + + (@majorheading . @majorheading) + (@chapheading . @chapheading) + (@appendix . @appendix) + + (@section . @chapter) + (@unnumberedsec . @unnumbered) + (@heading . @chapheading) + (@appendixsec . @appendix) + + (@subsection . @section) + (@unnumberedsubsec . @unnumberedsec) + (@subheading . @heading) + (@appendixsubsec . @appendixsec) + + (@subsubsection . @subsection) + (@unnumberedsubsubsec . @unnumberedsubsec) + (@subsubheading . @subheading) + (@appendixsubsubsec . @appendixsubsec)) + "*An alist of next higher levels for chapters, sections, etc... +For example, section to chapter, subsection to section. +Used by `texinfo-raise-lower-sections'. +The keys specify types of section; the values correspond to the next +higher types.") + +(defvar texinfo-lowersections-alist + '((@chapter . @section) + (@unnumbered . @unnumberedsec) + (@centerchap . @unnumberedsec) + (@majorheading . @heading) + (@chapheading . @heading) + (@appendix . @appendixsec) + + (@section . @subsection) + (@unnumberedsec . @unnumberedsubsec) + (@heading . @subheading) + (@appendixsec . @appendixsubsec) + + (@subsection . @subsubsection) + (@unnumberedsubsec . @unnumberedsubsubsec) + (@subheading . @subsubheading) + (@appendixsubsec . @appendixsubsubsec) + + (@subsubsection . @subsubsection) ; Cannot go lower. + (@unnumberedsubsubsec . @unnumberedsubsubsec) + (@subsubheading . @subsubheading) + (@appendixsubsubsec . @appendixsubsubsec)) + "*An alist of next lower levels for chapters, sections, etc... +For example, chapter to section, section to subsection. +Used by `texinfo-raise-lower-sections'. +The keys specify types of section; the values correspond to the next +lower types.") ;;; Syntax table -(if texinfo-format-syntax-table - nil - (setq texinfo-format-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\" " " texinfo-format-syntax-table) - (modify-syntax-entry ?\\ " " texinfo-format-syntax-table) - (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table) - (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table) - (modify-syntax-entry ?\[ "." texinfo-format-syntax-table) - (modify-syntax-entry ?\] "." texinfo-format-syntax-table) - (modify-syntax-entry ?\( "." texinfo-format-syntax-table) - (modify-syntax-entry ?\) "." texinfo-format-syntax-table) - (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table) - (modify-syntax-entry ?} "){" texinfo-format-syntax-table) - (modify-syntax-entry ?\' "." texinfo-format-syntax-table)) +(defvar texinfo-format-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\" " " st) + (modify-syntax-entry ?\\ " " st) + (modify-syntax-entry ?@ "\\" st) + (modify-syntax-entry ?\^q "\\" st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + (modify-syntax-entry ?\( "." st) + (modify-syntax-entry ?\) "." st) + (modify-syntax-entry ?{ "(}" st) + (modify-syntax-entry ?} "){" st) + (modify-syntax-entry ?\' "." st) + st)) ;;; Top level buffer and region formatting functions @@ -113,8 +164,8 @@ The Info file output is generated in a buffer visiting the Info file name specified in the @setfilename command. Non-nil argument (prefix, if interactive) means don't make tag table -and don't split the file if large. You can use Info-tagify and -Info-split to do these manually." +and don't split the file if large. You can use `Info-tagify' and +`Info-split' to do these manually." (interactive "P") (let ((lastmessage "Formatting Info file...") (coding-system-for-write buffer-file-coding-system)) @@ -329,7 +380,7 @@ is automatically removed when the Info file is created. The original Texinfo source buffer is not changed. Non-nil argument (prefix, if interactive) means don't split the file -if large. You can use Info-split to do this manually." +if large. You can use `Info-split' to do this manually." (interactive "P") (let ((temp-buffer (concat "*--" (buffer-name) "--temporary-buffer*" ))) (message "First updating nodes and menus, then creating Info file.") @@ -764,64 +815,6 @@ commands." (setq count (1+ count))) (kill-word 1) (insert (symbol-name new-level)))))))))) - -(defvar texinfo-raisesections-alist - '((@chapter . @chapter) ; Cannot go higher - (@unnumbered . @unnumbered) - (@centerchap . @unnumbered) - - (@majorheading . @majorheading) - (@chapheading . @chapheading) - (@appendix . @appendix) - - (@section . @chapter) - (@unnumberedsec . @unnumbered) - (@heading . @chapheading) - (@appendixsec . @appendix) - - (@subsection . @section) - (@unnumberedsubsec . @unnumberedsec) - (@subheading . @heading) - (@appendixsubsec . @appendixsec) - - (@subsubsection . @subsection) - (@unnumberedsubsubsec . @unnumberedsubsec) - (@subsubheading . @subheading) - (@appendixsubsubsec . @appendixsubsec)) - "*An alist of next higher levels for chapters, sections. etc. -For example, section to chapter, subsection to section. -Used by `texinfo-raise-lower-sections'. -The keys specify types of section; the values correspond to the next -higher types.") - -(defvar texinfo-lowersections-alist - '((@chapter . @section) - (@unnumbered . @unnumberedsec) - (@centerchap . @unnumberedsec) - (@majorheading . @heading) - (@chapheading . @heading) - (@appendix . @appendixsec) - - (@section . @subsection) - (@unnumberedsec . @unnumberedsubsec) - (@heading . @subheading) - (@appendixsec . @appendixsubsec) - - (@subsection . @subsubsection) - (@unnumberedsubsec . @unnumberedsubsubsec) - (@subheading . @subsubheading) - (@appendixsubsec . @appendixsubsubsec) - - (@subsubsection . @subsubsection) ; Cannot go lower. - (@unnumberedsubsubsec . @unnumberedsubsubsec) - (@subsubheading . @subsubheading) - (@appendixsubsubsec . @appendixsubsubsec)) - "*An alist of next lower levels for chapters, sections. etc. -For example, chapter to section, section to subsection. -Used by `texinfo-raise-lower-sections'. -The keys specify types of section; the values correspond to the next -lower types.") - ;;; Perform those texinfo-to-info conversions that apply to the whole input ;;; uniformly. @@ -1077,8 +1070,8 @@ Leave point after argument." (forward-char -1) (skip-chars-backward " ") (setq end (point)) - (setq args (cons (if (> end beg) (buffer-substring-no-properties beg end)) - args)) + (push (if (> end beg) (buffer-substring-no-properties beg end)) + args) (goto-char next) (skip-chars-forward " ")) (if (eolp) (forward-char 1)) @@ -1110,8 +1103,8 @@ Leave point after argument." (goto-char beg) (while (search-forward "\n" end t) (replace-match " ")))) - (setq args (cons (if (> end beg) (buffer-substring-no-properties beg end)) - args)) + (push (if (> end beg) (buffer-substring-no-properties beg end)) + args) (goto-char next)) ;;(if (eolp) (forward-char 1)) (setq texinfo-command-end (point)) @@ -1140,7 +1133,7 @@ Leave point after argument." (re-search-forward "[\n ]") (forward-char -1) (setq end (point)))) - (setq args (cons (buffer-substring-no-properties beg end) args)) + (push (buffer-substring-no-properties beg end) args) (skip-chars-forward " ")) (forward-char 1) (nreverse args)))) @@ -1184,7 +1177,7 @@ Leave point after argument." (let ((tem (if texinfo-fold-nodename-case (downcase name) name))) (if (assoc tem texinfo-node-names) (error "Duplicate node name: %s" name) - (setq texinfo-node-names (cons (list tem) texinfo-node-names)))) + (push (list tem) texinfo-node-names))) (setq texinfo-footnote-number 0) ;; insert "\n\^_" unconditionally since this is what info is looking for (insert "\n\^_\nFile: " texinfo-format-filename @@ -1494,8 +1487,6 @@ If used within a line, follow `@br' with braces." Argument is either end or separate." (setq texinfo-footnote-style (texinfo-parse-arg-discard))) -(defvar texinfo-footnote-number) - (put 'footnote 'texinfo-format 'texinfo-format-footnote) (defun texinfo-format-footnote () "Format a footnote in either end of node or separate node style. @@ -1601,9 +1592,8 @@ Used by @refill indenting command to avoid indenting within lists, etc.") (defun texinfo-push-stack (check arg) (setq texinfo-stack-depth (1+ texinfo-stack-depth)) - (setq texinfo-stack - (cons (list check arg texinfo-command-start) - texinfo-stack))) + (push (list check arg texinfo-command-start) + texinfo-stack)) (defun texinfo-pop-stack (check) (setq texinfo-stack-depth (1- texinfo-stack-depth)) @@ -1974,7 +1964,7 @@ Or else: @end multitable where the fractions specify the width of each column as a percent -of the current width of the text (i.e., of the fill-column). +of the current width of the text (i.e., of the `fill-column'). Long lines of text are filled within columns. @@ -2028,12 +2018,10 @@ commands that are defined in texinfo.tex for printed output. ((looking-at "@columnfractions") (forward-word 1) (while (not (eolp)) - (setq texinfo-multitable-width-list - (cons - (truncate - (1- - (* fill-column (read (get-buffer (current-buffer)))))) - texinfo-multitable-width-list)))) + (push (truncate + (1- + (* fill-column (read (get-buffer (current-buffer)))))) + texinfo-multitable-width-list))) ;; ;; Case 2: {Column 1 template} {Column 2} {Column 3 example} ((looking-at "{") @@ -2044,9 +2032,8 @@ commands that are defined in texinfo.tex for printed output. (end-of-template ;; forward-sexp works with braces in Texinfo mode (progn (forward-sexp 1) (1- (point))))) - (setq texinfo-multitable-width-list - (cons (- end-of-template start-of-template) - texinfo-multitable-width-list)) + (push (- end-of-template start-of-template) + texinfo-multitable-width-list) ;; Remove carriage return from within a template, if any. ;; This helps those those who want to use more than ;; one line's worth of words in @multitable line. @@ -2417,13 +2404,11 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." (beginning-delimiter (or (nth 1 args) "")) (end-delimiter (or (nth 2 args) ""))) (texinfo-discard-command) - (setq texinfo-enclosure-list - (cons - (list command-name - (list - beginning-delimiter - end-delimiter)) - texinfo-enclosure-list)))) + (push (list command-name + (list + beginning-delimiter + end-delimiter)) + texinfo-enclosure-list))) ;;; @alias @@ -2436,12 +2421,10 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image." (save-excursion (end-of-line) (setq texinfo-command-end (point))) (if (not (looking-at "\\([^=]+\\)=\\(.*\\)")) (error "Invalid alias command") - (setq texinfo-alias-list - (cons - (cons - (match-string-no-properties 1) - (match-string-no-properties 2)) - texinfo-alias-list)) + (push (cons + (match-string-no-properties 1) + (match-string-no-properties 2)) + texinfo-alias-list) (texinfo-discard-command)) ) ) @@ -2570,8 +2553,7 @@ If used within a line, follow `@bullet' with braces." "lisp\\|" "smalllisp" "\\)") - "Regexp specifying environments in which @kbd does not put `...' - around argument.") + "Regexp matching environments in which @kbd does not put `...' around arg.") (defvar texinfo-format-kbd-end-regexp (concat @@ -2584,7 +2566,7 @@ If used within a line, follow `@bullet' with braces." "smalllisp" "\\)") "Regexp specifying end of environments in which @kbd does not put `...' - around argument. (See `texinfo-format-kbd-regexp')") +around argument. (See `texinfo-format-kbd-regexp')") (put 'kbd 'texinfo-format 'texinfo-format-kbd) (defun texinfo-format-kbd () @@ -2793,8 +2775,8 @@ If used within a line, follow `@minus' with braces." ;;; Refilling and indenting: @refill, @paragraphindent, @noindent -;;; Indent only those paragraphs that are refilled as a result of an -;;; @refill command. +;; Indent only those paragraphs that are refilled as a result of an +;; @refill command. ;; * If the value is `asis', do not change the existing indentation at ;; the starts of paragraphs. @@ -2804,8 +2786,8 @@ If used within a line, follow `@minus' with braces." ;; * If the value is greater than zero, indent each paragraph by that ;; number of spaces. -;;; But do not refill paragraphs with an @refill command that are -;;; preceded by @noindent or are part of a table, list, or deffn. +;; But do not refill paragraphs with an @refill command that are +;; preceded by @noindent or are part of a table, list, or deffn. (defvar texinfo-paragraph-indent "asis" "Number of spaces for @refill to indent a paragraph; else to leave as is.") @@ -2822,7 +2804,7 @@ Default is to leave the number of spaces as is." (put 'refill 'texinfo-format 'texinfo-format-refill) (defun texinfo-format-refill () - "Refill paragraph. Also, indent first line as set by @paragraphindent. + "Refill paragraph. Also, indent first line as set by @paragraphindent. Default is to leave paragraph indentation as is." (texinfo-discard-command) (let ((position (point-marker))) @@ -2941,11 +2923,9 @@ Default is to leave paragraph indentation as is." ;; eg: "aa" . texinfo-aaindex (or (assoc index-name texinfo-indexvar-alist) - (setq texinfo-indexvar-alist - (cons - (cons index-name - index-alist-name) - texinfo-indexvar-alist))) + (push (cons index-name + index-alist-name) + texinfo-indexvar-alist)) (fset index-formatting-command (list 'lambda 'nil @@ -4024,7 +4004,7 @@ The command `@value{foo}' expands to the value." (put 'ifset 'texinfo-end 'texinfo-discard-command) (put 'ifset 'texinfo-format 'texinfo-if-set) (defun texinfo-if-set () - "If set, continue formatting; else do not format region up to @end ifset" + "If set, continue formatting; else do not format region up to @end ifset." (let ((arg (texinfo-parse-arg-discard))) (cond ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) @@ -4045,7 +4025,7 @@ The command `@value{foo}' expands to the value." (put 'ifclear 'texinfo-end 'texinfo-discard-command) (put 'ifclear 'texinfo-format 'texinfo-if-clear) (defun texinfo-if-clear () - "If clear, continue formatting; if set, do not format up to @end ifset" + "If clear, continue formatting; if set, do not format up to @end ifset." (let ((arg (texinfo-parse-arg-discard))) (cond ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) @@ -4291,7 +4271,7 @@ the @ifeq command." ;;; Batch formatting (defun batch-texinfo-format () - "Runs texinfo-format-buffer on the files remaining on the command line. + "Run `texinfo-format-buffer' on the files remaining on the command line. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke @@ -4317,8 +4297,8 @@ For example, invoke (nconc (directory-files file) (cdr command-line-args-left)))) (t - (setq files (cons file files) - command-line-args-left (cdr command-line-args-left))))) + (push file files) + (setq command-line-args-left (cdr command-line-args-left))))) (while files (setq file (car files) files (cdr files)) @@ -4354,5 +4334,5 @@ For example, invoke ;;; Place `provide' at end of file. (provide 'texinfmt) -;;; arch-tag: 1e8d9a2d-bca0-40a0-ac6c-dab01bc6f725 +;; arch-tag: 1e8d9a2d-bca0-40a0-ac6c-dab01bc6f725 ;;; texinfmt.el ends here diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index ede8c57ec98..e4c13d3039a 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -83,7 +83,10 @@ (comment-normalize-vars) (goto-char (point-max)) (forward-comment -1) - (unless (bolp) (insert "\n")) + (skip-chars-forward " \t\n") + (cond + ((not (bolp)) (insert "\n\n")) + ((not (eq ?\n (char-before (1- (point))))) (insert "\n"))) (let ((beg (point)) (idfile (and buffer-file-name (expand-file-name @@ -419,6 +422,137 @@ Return non-nil if FILE is unchanged." (defun vc-arch-init-version () nil) +;;; Completion of versions and revisions. + +(defun vc-arch-complete (table string pred action) + (assert (not (functionp table))) + (cond + ((null action) (try-completion string table pred)) + ((eq action t) (all-completions string table pred)) + (t (test-completion string table pred)))) + +(defun vc-arch--version-completion-table (root string) + (delq nil + (mapcar + (lambda (d) + (when (string-match "/\\([^/]+\\)/\\([^/]+\\)\\'" d) + (concat (match-string 2 d) "/" (match-string 1 d)))) + (let ((default-directory root)) + (file-expand-wildcards + (concat "*/*/" + (if (string-match "/" string) + (concat (substring string (match-end 0)) + "*/" (substring string 0 (match-beginning 0))) + (concat "*/" string)) + "*")))))) + +(defun vc-arch-revision-completion-table (file) + (lexical-let ((file file)) + (lambda (string pred action) + ;; FIXME: complete revision patches as well. + (let ((root (expand-file-name "{arch}" (vc-arch-root file)))) + (vc-arch-complete + (vc-arch--version-completion-table root string) + string pred action))))) + +;;; Trimming revision libraries. + +;; This code is not directly related to VC and there are many variants of +;; this functionality available as scripts, but I like this version better, +;; so maybe others will like it too. + +(defun vc-arch-trim-find-least-useful-rev (revs) + (let* ((first (pop revs)) + (second (pop revs)) + (third (pop revs)) + ;; We try to give more importance to recent revisions. The idea is + ;; that it's OK if checking out a revision 1000-patch-old is ten + ;; times slower than checking out a revision 100-patch-old. But at + ;; the same time a 2-patch-old rev isn't really ten times more + ;; important than a 20-patch-old, so we use an arbitrary constant + ;; "100" to reduce this effect for recent revisions. Making this + ;; constant a float has the side effect of causing the subsequent + ;; computations to be done as floats as well. + (max (+ 100.0 (car (or (car (last revs)) third)))) + (cost (lambda () (/ (- (car third) (car first)) (- max (car second))))) + (minrev second) + (mincost (funcall cost))) + (while revs + (setq first second) + (setq second third) + (setq third (pop revs)) + (when (< (funcall cost) mincost) + (setq minrev second) + (setq mincost (funcall cost)))) + minrev)) + +(defun vc-arch-trim-make-sentinel (revs) + (if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done")) + `(lambda (proc msg) + (message "VC-Arch trimming %s..." ',(file-name-nondirectory (car revs))) + (rename-file ,(car revs) ,(concat (car revs) "*rm*")) + (setq proc (start-process "vc-arch-trim" nil + "rm" "-rf" ',(concat (car revs) "*rm*"))) + (set-process-sentinel proc (vc-arch-trim-make-sentinel ',(cdr revs)))))) + +(defun vc-arch-trim-one-revlib (dir) + "Delete half of the revisions in the revision library." + (interactive "Ddirectory: ") + (let ((revs + (sort (delq nil + (mapcar + (lambda (f) + (when (string-match "-\\([0-9]+\\)\\'" f) + (cons (string-to-number (match-string 1 f)) f))) + (directory-files dir nil nil 'nosort))) + 'car-less-than-car)) + (subdirs nil)) + (when (cddr revs) + (dotimes (i (/ (length revs) 2)) + (let ((minrev (vc-arch-trim-find-least-useful-rev revs))) + (setq revs (delq minrev revs)) + (push minrev subdirs))) + (funcall (vc-arch-trim-make-sentinel + (mapcar (lambda (x) (expand-file-name (cdr x) dir)) subdirs)) + nil nil)))) + +(defun vc-arch-trim-revlib () + "Delete half of the revisions in the revision library." + (interactive) + (let ((rl-dir (with-output-to-string + (call-process vc-arch-command nil standard-output nil + "my-revision-library")))) + (while (string-match "\\(.*\\)\n" rl-dir) + (let ((dir (match-string 1 rl-dir))) + (setq rl-dir + (if (and (file-directory-p dir) (file-writable-p dir)) + dir + (substring rl-dir (match-end 0)))))) + (unless (file-writable-p rl-dir) + (error "No writable revlib directory found")) + (message "Revlib at %s" rl-dir) + (let* ((archives (directory-files rl-dir 'full "[^.]\\|...")) + (categories + (apply 'append + (mapcar (lambda (dir) + (when (file-directory-p dir) + (directory-files dir 'full "[^.]\\|..."))) + archives))) + (branches + (apply 'append + (mapcar (lambda (dir) + (when (file-directory-p dir) + (directory-files dir 'full "[^.]\\|..."))) + categories))) + (versions + (apply 'append + (mapcar (lambda (dir) + (when (file-directory-p dir) + (directory-files dir 'full "--.*--"))) + branches)))) + (mapc 'vc-arch-trim-one-revlib versions)) + )) + ;;; Less obvious implementations. (defun vc-arch-find-version (file rev buffer) diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index e5481b5f405..23ce0d9c17a 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -10,7 +10,7 @@ ;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com> ;; Keywords: tools ;; Created: Sept 2006 -;; Version: 2007-01-17 +;; Version: 2007-05-24 ;; URL: http://launchpad.net/vc-bzr ;; This file is free software; you can redistribute it and/or modify @@ -36,38 +36,53 @@ ;; See <URL:http://bazaar-vcs.org/> concerning bzr. -;; Load this library to register bzr support in VC. The support is -;; preliminary and incomplete, adapted from my darcs version. Lightly -;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See -;; various Fixmes below. +;; Load this library to register bzr support in VC. It covers basic VC +;; functionality, but was only lightly exercised with a few Emacs/bzr +;; version combinations, namely those current on the authors' PCs. +;; See various Fixmes below. -;; This should be suitable for direct inclusion in Emacs if someone -;; can persuade rms. + +;; Known bugs +;; ========== + +;; When edititing a symlink and *both* the symlink and its target +;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the +;; symlink, thereby not detecting whether the actual contents +;; (that is, the target contents) are changed. +;; See https://bugs.launchpad.net/vc-bzr/+bug/116607 + +;; For an up-to-date list of bugs, please see: +;; https://bugs.launchpad.net/vc-bzr/+bugs ;;; Code: (eval-when-compile + (require 'cl) (require 'vc)) ; for vc-exec-after +;; Clear up the cache to force vc-call to check again and discover +;; new functions when we reload this file. +(put 'BZR 'vc-functions nil) + (defgroup vc-bzr nil "VC bzr backend." ;; :version "22" :group 'vc) (defcustom vc-bzr-program "bzr" - "*Name of the bzr command (excluding any arguments)." + "Name of the bzr command (excluding any arguments)." :group 'vc-bzr :type 'string) ;; Fixme: there's probably no call for this. (defcustom vc-bzr-program-args nil - "*List of global arguments to pass to `vc-bzr-program'." + "List of global arguments to pass to `vc-bzr-program'." :group 'vc-bzr :type '(repeat string)) (defcustom vc-bzr-diff-switches nil - "*String/list of strings specifying extra switches for bzr diff under VC." + "String/list of strings specifying extra switches for bzr diff under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) @@ -81,76 +96,42 @@ "Return a three-numeric element list with components of the bzr version. This is of the form (X Y Z) for revision X.Y.Z. The elements are zero if running `vc-bzr-program' doesn't produce the expected output." - (if vc-bzr-version - vc-bzr-version - (let ((s (shell-command-to-string - (concat (shell-quote-argument vc-bzr-program) " --version")))) - (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s) - (setq vc-bzr-version (list (string-to-number (match-string 1 s)) - (string-to-number (match-string 2 s)) - (string-to-number (match-string 3 s)))) - '(0 0 0))))) + (or vc-bzr-version + (setq vc-bzr-version + (let ((s (shell-command-to-string + (concat (shell-quote-argument vc-bzr-program) + " --version")))) + (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s) + (list (string-to-number (match-string 1 s)) + (string-to-number (match-string 2 s)) + (string-to-number (match-string 3 s))) + '(0 0 0)))))) (defun vc-bzr-at-least-version (vers) "Return t if the bzr command reports being a least version VERS. First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'." (version-list-<= vers (vc-bzr-version))) -;; XXX: vc-do-command is tailored for RCS and assumes that command-line -;; options precede the file name (ci -something file); with bzr, we need -; to pass options *after* the subcommand, e.g. bzr ls --versioned. -(defun vc-bzr-do-command* (buffer okstatus command &rest args) - "Execute bzr COMMAND, notifying user and checking for errors. -This is a wrapper around `vc-do-command', which see for detailed -explanation of arguments BUFFER, OKSTATUS and COMMAND. - -If the optional list of ARGS is present, its elements are -appended to the command line, in the order given. - -Unlike `vc-do-command', this has no way of telling which elements -in ARGS are file names and which are command-line options, so be -sure to pass absolute file names if needed. On the other hand, -you can mix options and file names in any order." - (apply 'vc-do-command buffer okstatus command nil args)) - -(cond - ((vc-bzr-at-least-version '(0 9)) - ;; since v0.9, bzr supports removing the progress indicators - ;; by setting environment variable BZR_PROGRESS_BAR to "none". - (defun vc-bzr-command (bzr-command buffer okstatus file &rest args) - "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. +;; since v0.9, bzr supports removing the progress indicators +;; by setting environment variable BZR_PROGRESS_BAR to "none". +(defun vc-bzr-command (bzr-command buffer okstatus file &rest args) + "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." - (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) - (apply 'vc-do-command buffer okstatus vc-bzr-program - file bzr-command (append vc-bzr-program-args args)))) - - (defun vc-bzr-command* (bzr-command buffer okstatus file &rest args) - "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND. -Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment. -First argument BZR-COMMAND is passed as the first optional argument to -`vc-bzr-do-command*'." - (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) - (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program - bzr-command (append vc-bzr-program-args args))))) + (let ((process-environment + (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9) + "LC_ALL=C" ; Force English output + process-environment)) + ;; bzr may attempt some kind of user interaction if its stdin/stdout + ;; is connected to a PTY; therefore, ask Emacs to use a pipe to + ;; communicate with it. + ;; This is redundant because vc-do-command does it already. --Stef + (process-connection-type nil)) + (apply 'vc-do-command buffer okstatus vc-bzr-program + file bzr-command (append vc-bzr-program-args args)))) - (t - ;; for older versions, we fall back to washing the log buffer +(unless (vc-bzr-at-least-version '(0 9)) + ;; For older versions, we fall back to washing the log buffer ;; when all output has been gathered. - (defun vc-bzr-command (command buffer okstatus file &rest args) - "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND." - ;; Note: The ^Ms from the progress-indicator stuff that bzr prints - ;; on stderr cause auto-detection of a mac coding system on the - ;; stream for async output. bzr ought to be fixed to be able to - ;; suppress this. See also `vc-bzr-post-command-function'. (We - ;; can't sink the stderr output in `vc-do-command'.) - (apply 'vc-do-command buffer okstatus vc-bzr-program - file command (append vc-bzr-program-args args))) - - (defun vc-bzr-command* (command buffer okstatus &rest args) - "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND." - (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program - command file (append vc-bzr-program-args args))) - (defun vc-bzr-post-command-function (command file flags) "`vc-post-command-functions' function to remove progress messages." ;; Note that using this requires that the vc command is run @@ -169,73 +150,78 @@ First argument BZR-COMMAND is passed as the first optional argument to (while (looking-at "read knit.*\n") (replace-match ""))))) - (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) + (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function)) -;; Fixme: If we're only interested in status messages, we only need -;; to set LC_MESSAGES, and we might need finer control of this. This -;; is moot anyhow, since bzr doesn't appear to be localized at all -;; (yet?). -(eval-when-compile -(defmacro vc-bzr-with-c-locale (&rest body) - "Run BODY with LC_ALL=C in the process environment. -This ensures that messages to be matched come out as expected." - `(let ((process-environment (cons "LC_ALL=C" process-environment))) - ,@body))) -(put 'vc-bzr-with-c-locale 'edebug-form-spec t) -(put 'vc-bzr-with-c-locale 'lisp-indent-function 0) - -(defun vc-bzr-bzr-dir (file) - "Return the .bzr directory in the hierarchy above FILE. +;;;###autoload +(defconst vc-bzr-admin-dirname ".bzr") ; FIXME: "_bzr" on w32? + +;;;###autoload (defun vc-bzr-registered (file) +;;;###autoload (if (vc-find-root file vc-bzr-admin-dirname) +;;;###autoload (progn +;;;###autoload (load "vc-bzr") +;;;###autoload (vc-bzr-registered file)))) + +(defun vc-bzr-root-dir (file) + "Return the root directory in the hierarchy above FILE. Return nil if there isn't one." - (setq file (expand-file-name file)) - (let ((dir (if (file-directory-p file) - file - (file-name-directory file))) - bzr) - (catch 'found - (while t - (setq bzr (expand-file-name ".bzr" dir)) ; fixme: "_bzr" on Doze?? - (if (file-directory-p bzr) - (throw 'found (file-name-as-directory bzr))) - (if (equal "" (file-name-nondirectory (directory-file-name dir))) - (throw 'found nil) - (setq dir (file-name-directory (directory-file-name dir)))))))) + (vc-find-root file vc-bzr-admin-dirname)) (defun vc-bzr-registered (file) "Return non-nil if FILE is registered with bzr." - (if (vc-bzr-bzr-dir file) ; short cut - (vc-bzr-state file))) ; expensive + (if (vc-bzr-root-dir file) ; Short cut. + (vc-bzr-state file))) ; Expensive. -(defun vc-bzr-state (file) - (let (ret state conflicts pending-merges) - (with-temp-buffer - (cd (file-name-directory file)) - (setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file))) - (goto-char 1) - (save-excursion - (when (re-search-forward "^conflicts:" nil t) - (message "Warning -- conflicts in bzr branch"))) +(defun vc-bzr-buffer-nonblank-p (&optional buffer) + "Return non-nil if BUFFER contains any non-blank characters." + (or (> (buffer-size buffer) 0) (save-excursion - (when (re-search-forward "^pending merges:" nil t) - (message "Warning -- pending merges in bzr branch"))) - (setq state - (cond ((not (equal ret 0)) nil) - ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) - ;; Fixme: Also get this in a non-registered sub-directory. - ((looking-at "^$") 'up-to-date) - ;; if we're seeing this as first line of text, - ;; then the status is up-to-date, - ;; but bzr output only gives the warning to users. - ((looking-at "conflicts\\|pending") 'up-to-date) - ((looking-at "unknown\\|ignored") nil) - (t (error "Unrecognized output from `bzr status'")))) - (when (or conflicts pending-merges) - (message - (concat "Warning -- " - (if conflicts "conflicts ") - (if (and conflicts pending-merges) "and ") - (if pending-merges "pending merges ") - "in bzr branch"))) + (set-buffer (or buffer (current-buffer))) + (goto-char (point-min)) + (re-search-forward "[^ \t\n]" (point-max) t)))) + +(defconst vc-bzr-state-words + "added\\|ignored\\|modified\\|removed\\|renamed\\|unknown" + "Regexp matching file status words as reported in `bzr' output.") + +;; FIXME: Also get this in a non-registered sub-directory. +(defun vc-bzr-state (file) + (with-temp-buffer + (cd (file-name-directory file)) + (let ((ret (vc-bzr-command "status" t 255 file)) + (state 'up-to-date)) + ;; the only secure status indication in `bzr status' output + ;; is a couple of lines following the pattern:: + ;; | <status>: + ;; | <file name> + ;; if the file is up-to-date, we get no status report from `bzr', + ;; so if the regexp search for the above pattern fails, we consider + ;; the file to be up-to-date. + (goto-char (point-min)) + (when + (re-search-forward + (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" + (file-name-nondirectory file) "[ \t\n]*$") + (point-max) t) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (goto-char start) + (setq state + (cond + ((not (equal ret 0)) nil) + ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) + ((looking-at "unknown\\|ignored") nil))) + ;; erase the status text that matched + (delete-region start end))) + (when (vc-bzr-buffer-nonblank-p) + ;; "bzr" will output some warnings and informational messages + ;; to the user to stderr; due to Emacs' `vc-do-command' (and, + ;; it seems, `start-process' itself), we cannot catch stderr + ;; and stdout into different buffers. So, if there's anything + ;; left in the buffer after removing the above status + ;; keywords, let us just presume that any other message from + ;; "bzr" is a user warning, and display it. + (message "Warnings in `bzr' output: %s" + (buffer-substring (point-min) (point-max)))) (when state (vc-file-setprop file 'vc-workfile-version (vc-bzr-workfile-version file)) @@ -246,10 +232,12 @@ Return nil if there isn't one." (eq 'up-to-date (vc-bzr-state file))) (defun vc-bzr-workfile-version (file) + ;; Looks like this could be obtained via counting lines in + ;; .bzr/branch/revision-history. (with-temp-buffer (vc-bzr-command "revno" t 0 file) - (goto-char 1) - (buffer-substring 1 (line-end-position)))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position)))) (defun vc-bzr-checkout-model (file) 'implicit) @@ -263,11 +251,10 @@ COMMENT is ignored." ;; Could run `bzr status' in the directory and see if it succeeds, but ;; that's relatively expensive. -(defun vc-bzr-responsible-p (file) +(defalias 'vc-bzr-responsible-p 'vc-bzr-root-dir "Return non-nil if FILE is (potentially) controlled by bzr. The criterion is that there is a `.bzr' directory in the same -or a superior directory." - (vc-bzr-bzr-dir file)) +or a superior directory.") (defun vc-bzr-could-register (file) "Return non-nil if FILE could be registered under bzr." @@ -277,7 +264,7 @@ or a superior directory." (vc-bzr-command "add" t 0 file "--dry-run") ;; The command succeeds with no output if file is ;; registered (in bzr 0.8). - (goto-char 1) + (goto-char (point-min)) (looking-at "added ")) (error)))) @@ -307,43 +294,39 @@ EDITABLE is ignored." (unless contents-done (with-temp-buffer (vc-bzr-command "revert" t 'async file)))) -(eval-when-compile - (defvar log-view-message-re) - (defvar log-view-file-re) - (defvar log-view-font-lock-keywords) - (defvar log-view-current-tag-function)) - -;; Grim hack to account for lack of an extension mechanism for -;; log-view. Should be fixed in VC... -(defun vc-bzr-view-log-function () - "To be added to `log-view-mode-hook' to set variables for bzr output. -Removes itself after running." - (remove-hook 'log-view-mode-hook 'vc-bzr-view-log-function) +(defvar log-view-message-re) +(defvar log-view-file-re) +(defvar log-view-font-lock-keywords) +(defvar log-view-current-tag-function) + +(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" + (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. (require 'add-log) ;; Don't have file markers, so use impossible regexp. (set (make-local-variable 'log-view-file-re) "\\'\\`") - (set (make-local-variable 'log-view-message-re) "^ *-+\n *\\(revno: [0-9]+\\|merged: .+\\)") + (set (make-local-variable 'log-view-message-re) + "^ *-+\n *\\(?:revno: \\([0-9]+\\)\\|merged: .+\\)") (set (make-local-variable 'log-view-font-lock-keywords) - `(("^ *committer: \ -\\([^<(]+?\\)[ ]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" - nil nil - (1 'change-log-name-face nil t) - (2 'change-log-email-face nil t) - (3 'change-log-email-face nil t)) - ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)) - (,log-view-message-re . 'log-view-message-face) -;; ("^ \\(.*\\)$" (1 'log-view-message-face)) - ))) + ;; log-view-font-lock-keywords is careful to use the buffer-local + ;; value of log-view-message-re only since Emacs-23. + (append `((,log-view-message-re . 'log-view-message-face)) + ;; log-view-font-lock-keywords + '(("^ *committer: \ +\\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)))))) (defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 "Get bzr change log for FILE into specified BUFFER." - ;; Fixme: VC needs a hook to sort out the mode for the buffer, or at - ;; least set the regexps right. ;; Fixme: This might need the locale fixing up if things like `revno' ;; got localized, but certainly it shouldn't use LC_ALL=C. ;; NB. Can't be async -- see `vc-bzr-post-command-function'. (vc-bzr-command "log" buffer 0 file) - (add-hook 'log-view-mode-hook 'vc-bzr-view-log-function)) + ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for + ;; the buffer, or at least set the regexps right. + (unless (fboundp 'vc-default-log-view-mode) + (add-hook 'log-view-mode-hook 'vc-bzr-log-view-mode))) (defun vc-bzr-show-log-entry (version) "Find entry for patch name VERSION in bzr change log buffer." @@ -476,21 +459,22 @@ Return nil if current line isn't annotated." (defun vc-bzr-dir-state (dir &optional localp) "Find the VC state of all files in DIR. Optional argument LOCALP is always ignored." - (let (at-start bzr-root-directory current-bzr-state current-vc-state) - ;; check that DIR is a bzr repository - (set 'bzr-root-directory (vc-bzr-root dir)) - (unless (string-match "^/" bzr-root-directory) + (let ((bzr-root-directory (vc-bzr-root dir)) + (at-start t) + current-bzr-state current-vc-state) + ;; Check that DIR is a bzr repository. + (unless (file-name-absolute-p bzr-root-directory) (error "Cannot find bzr repository for directory `%s'" dir)) ;; `bzr ls --versioned' lists all versioned files; ;; assume they are up-to-date, unless we are given ;; evidence of the contrary. - (set 'at-start t) + (setq at-start t) (with-temp-buffer - (vc-bzr-command* "ls" t 0 "--versioned" "--non-recursive") + (vc-bzr-command "ls" t 0 nil "--versioned" "--non-recursive") (goto-char (point-min)) - (while (or at-start + (while (or at-start (eq 0 (forward-line))) - (set 'at-start nil) + (setq at-start nil) (let ((file (expand-file-name (buffer-substring-no-properties (line-beginning-position) (line-end-position)) @@ -500,26 +484,26 @@ Optional argument LOCALP is always ignored." ;; mixes different SCMs in the same dir? (vc-file-setprop file 'vc-backend 'BZR)))) ;; `bzr status' reports on added/modified/renamed and unknown/ignored files - (set 'at-start t) + (setq at-start t) (with-temp-buffer - (vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil)) + (vc-bzr-command "status" t 0 nil) (goto-char (point-min)) - (while (or at-start + (while (or at-start (eq 0 (forward-line))) - (set 'at-start nil) + (setq at-start nil) (cond ((looking-at "^added") - (set 'current-vc-state 'edited) - (set 'current-bzr-state 'added)) + (setq current-vc-state 'edited) + (setq current-bzr-state 'added)) ((looking-at "^modified") - (set 'current-vc-state 'edited) - (set 'current-bzr-state 'modified)) + (setq current-vc-state 'edited) + (setq current-bzr-state 'modified)) ((looking-at "^renamed") - (set 'current-vc-state 'edited) - (set 'current-bzr-state 'renamed)) + (setq current-vc-state 'edited) + (setq current-bzr-state 'renamed)) ((looking-at "^\\(unknown\\|ignored\\)") - (set 'current-vc-state nil) - (set 'current-bzr-state 'not-versioned)) + (setq current-vc-state nil) + (setq current-bzr-state 'not-versioned)) ((looking-at " ") ;; file names are indented by two spaces (when current-vc-state @@ -540,8 +524,8 @@ Optional argument LOCALP is always ignored." (vc-file-setprop file 'vc-state nil)))) (t ;; skip this part of `bzr status' output - (set 'current-vc-state nil) - (set 'current-bzr-state nil))))))) + (setq current-vc-state nil) + (setq current-bzr-state nil))))))) (defun vc-bzr-dired-state-info (file) "Bzr-specific version of `vc-dired-state-info'." diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el new file mode 100644 index 00000000000..416c08ae4ca --- /dev/null +++ b/lisp/vc-hg.el @@ -0,0 +1,393 @@ +;;; vc-hg.el --- VC backend for the mercurial version control system + +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +;; Author: Ivan Kanis +;; Keywords: tools +;; Version: 1889 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This is a mercurial version control backend + +;;; Thanks: + +;;; Bugs: + +;;; Installation: + +;;; Todo: + +;; Implement the rest of the vc interface. See the comment at the +;; beginning of vc.el. The current status is: + +;; FUNCTION NAME STATUS +;; * registered (file) OK +;; * state (file) OK +;; - state-heuristic (file) ?? PROBABLY NOT NEEDED +;; - dir-state (dir) NEEDED +;; * workfile-version (file) OK +;; - latest-on-branch-p (file) ?? +;; * checkout-model (file) OK +;; - workfile-unchanged-p (file) ?? +;; - mode-line-string (file) NOT NEEDED +;; - dired-state-info (file) NEEDED +;; STATE-CHANGING FUNCTIONS +;; * register (file &optional rev comment) OK +;; - init-version () NOT NEEDED +;; - responsible-p (file) OK +;; - could-register (file) OK +;; - receive-file (file rev) ?? PROBABLY NOT NEEDED +;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT +;; * checkin (file rev comment) OK +;; * find-version (file rev buffer) OK +;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT +;; * revert (file &optional contents-done) OK +;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED +;; - merge (file rev1 rev2) NEEDED +;; - merge-news (file) NEEDED +;; - steal-lock (file &optional version) NOT NEEDED +;; HISTORY FUNCTIONS +;; * print-log (file &optional buffer) OK +;; - log-view-mode () OK +;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD +;; - wash-log (file) ?? +;; - logentry-check () NOT NEEDED +;; - comment-history (file) NOT NEEDED +;; - update-changelog (files) NOT NEEDED +;; * diff (file &optional rev1 rev2 buffer) OK +;; - revision-completion-table (file) ?? +;; - diff-tree (dir &optional rev1 rev2) TEST IT +;; - annotate-command (file buf &optional rev) OK +;; - annotate-time () OK +;; - annotate-current-time () ?? NOT NEEDED +;; - annotate-extract-revision-at-line () OK +;; SNAPSHOT SYSTEM +;; - create-snapshot (dir name branchp) NEEDED (probably branch?) +;; - assign-name (file name) NOT NEEDED +;; - retrieve-snapshot (dir name update) ?? NEEDED?? +;; MISCELLANEOUS +;; - make-version-backups-p (file) ?? +;; - repository-hostname (dirname) ?? +;; - previous-version (file rev) OK +;; - next-version (file rev) OK +;; - check-headers () ?? +;; - clear-headers () ?? +;; - delete-file (file) TEST IT +;; - rename-file (old new) OK +;; - find-file-hook () PROBABLY NOT NEEDED +;; - find-file-not-found-hook () PROBABLY NOT NEEDED + +;; Implement Stefan Monnier's advice: +;; vc-hg-registered and vc-hg-state +;; Both of those functions should be super extra careful to fail gracefully in +;; unexpected circumstances. The reason this is important is that any error +;; there will prevent the user from even looking at the file :-( +;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under +;; mercurial's control and extracting the current revision should be done +;; without even using `hg' (this way even if you don't have `hg' installed, +;; Emacs is able to tell you this file is under mercurial's control). + +;;; History: +;; + +;;; Code: + +(eval-when-compile + (require 'vc)) + +;;; Customization options + +(defcustom vc-hg-global-switches nil + "*Global switches to pass to any Hg command." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" + :value ("") + string)) + :version "22.2" + :group 'vc) + +;;; State querying functions + +;;;###autoload (defun vc-hg-registered (file) +;;;###autoload "Return non-nil if FILE is registered with hg." +;;;###autoload (if (vc-find-root file ".hg") ; short cut +;;;###autoload (progn +;;;###autoload (load "vc-hg") +;;;###autoload (vc-hg-registered file)))) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-registered (file) + "Return non-nil if FILE is registered with hg." + (if (vc-hg-root file) ; short cut + (vc-hg-state file))) ; expensive + +(defun vc-hg-state (file) + "Hg-specific version of `vc-state'." + (let* + ((status nil) + (out + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "status" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) + (when (eq 0 status) + (if (eq 0 (length out)) 'up-to-date + (let ((state (aref out 0))) + (cond + ((eq state ?M) 'edited) + ((eq state ?A) 'edited) + ((eq state ?P) 'needs-patch) + ((eq state ??) nil) + (t 'up-to-date))))))) + +(defun vc-hg-workfile-version (file) + "Hg-specific version of `vc-workfile-version'." + (let* + ((status nil) + (out + (with-output-to-string + (with-current-buffer + standard-output + (setq status + (condition-case nil + ;; Ignore all errors. + (call-process + "hg" nil t nil "--cwd" (file-name-directory file) + "log" "-l1" (file-name-nondirectory file)) + ;; Some problem happened. E.g. We can't find an `hg' + ;; executable. + (error nil))))))) + (when (eq 0 status) + (if (string-match "changeset: *\\([0-9]*\\)" out) + (match-string 1 out) + "0")))) + +;;; History functions + +(defun vc-hg-print-log(file &optional buffer) + "Get change log associated with FILE." + ;; `log-view-mode' needs to have the file name in order to function + ;; correctly. "hg log" does not print it, so we insert it here by + ;; hand. + + ;; `vc-do-command' creates the buffer, but we need it before running + ;; the command. + (vc-setup-buffer buffer) + ;; If the buffer exists from a previous invocation it might be + ;; read-only. + (let ((inhibit-read-only t)) + (with-current-buffer + buffer + (insert "File: " (file-name-nondirectory file) "\n"))) + (vc-hg-command + buffer + (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) + file "log")) + +(defvar log-view-message-re) +(defvar log-view-file-re) +(defvar log-view-font-lock-keywords) + +(define-derived-mode vc-hg-log-view-mode log-view-mode "HG-Log-View" + (require 'add-log) ;; we need the faces add-log + ;; Don't have file markers, so use impossible regexp. + (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)") + (set (make-local-variable 'log-view-message-re) + "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") + (set (make-local-variable 'log-view-font-lock-keywords) + (append + log-view-font-lock-keywords + ;; Handle the case: + ;; user: foo@bar + '(("^user:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + (1 'change-log-email)) + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^date: \\(.+\\)" (1 'change-log-date)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) + +(defun vc-hg-diff (file &optional oldvers newvers buffer) + "Get a difference report using hg between two versions of FILE." + (let ((working (vc-workfile-version file))) + (if (and (equal oldvers working) (not newvers)) + (setq oldvers nil)) + (if (and (not oldvers) newvers) + (setq oldvers working)) + (apply 'call-process "hg" nil (or buffer "*vc-diff*") nil + "--cwd" (file-name-directory file) "diff" + (append + (if oldvers + (if newvers + (list "-r" oldvers "-r" newvers) + (list "-r" oldvers)) + (list "")) + (list (file-name-nondirectory file)))))) + +(defalias 'vc-hg-diff-tree 'vc-hg-diff) + +(defun vc-hg-annotate-command (file buffer &optional version) + "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. +Optional arg VERSION is a version to annotate from." + (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) + + +;; The format for one line output by "hg annotate -d -n" looks like this: +;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS +;; i.e: VERSION_NUMBER DATE: CONTENTS +(defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ") + +(defun vc-hg-annotate-time () + (when (looking-at vc-hg-annotate-re) + (goto-char (match-end 0)) + (vc-annotate-convert-time + (date-to-time (match-string-no-properties 2))))) + +(defun vc-hg-annotate-extract-revision-at-line () + (save-excursion + (beginning-of-line) + (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1)))) + +(defun vc-hg-previous-version (file rev) + (let ((newrev (1- (string-to-number rev)))) + (when (>= newrev 0) + (number-to-string newrev)))) + +(defun vc-hg-next-version (file rev) + (let ((newrev (1+ (string-to-number rev))) + (tip-version + (with-temp-buffer + (vc-hg-command t nil nil "tip") + (goto-char (point-min)) + (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") + (string-to-number (match-string-no-properties 1))))) + ;; We don't want to exceed the maximum possible version number, ie + ;; the tip version. + (when (<= newrev tip-version) + (number-to-string newrev)))) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-delete-file (file) + "Delete FILE and delete it in the hg repository." + (condition-case () + (delete-file file) + (file-error nil)) + (vc-hg-command nil nil file "remove" "--after" "--force")) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-rename-file (old new) + "Rename file from OLD to NEW using `hg mv'." + (vc-hg-command nil nil new old "mv")) + +(defun vc-hg-register (file &optional rev comment) + "Register FILE under hg. +REV is ignored. +COMMENT is ignored." + (vc-hg-command nil nil file "add")) + +(defalias 'vc-hg-responsible-p 'vc-hg-root) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-could-register (file) + "Return non-nil if FILE could be registered under hg." + (and (vc-hg-responsible-p file) ; shortcut + (condition-case () + (with-temp-buffer + (vc-hg-command t nil file "add" "--dry-run")) + ;; The command succeeds with no output if file is + ;; registered. + (error)))) + +;; XXX This would remove the file. Is that correct? +;; (defun vc-hg-unregister (file) +;; "Unregister FILE from hg." +;; (vc-hg-command nil nil file "remove")) + +(defun vc-hg-checkin (file rev comment) + "HG-specific version of `vc-backend-checkin'. +REV is ignored." + (vc-hg-command nil nil file "commit" "-m" comment)) + +(defun vc-hg-find-version (file rev buffer) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (if rev + (vc-hg-command buffer nil file "cat" "-r" rev) + (vc-hg-command buffer nil file "cat")))) + +;; Modelled after the similar function in vc-bzr.el +;; This should not be needed, `vc-hg-find-version' provides the same +;; functionality. +;; (defun vc-hg-checkout (file &optional editable rev workfile) +;; "Retrieve a revision of FILE into a WORKFILE. +;; EDITABLE is ignored. +;; REV is the revision to check out into WORKFILE." +;; (unless workfile +;; (setq workfile (vc-version-backup-file-name file rev))) +;; (let ((coding-system-for-read 'binary) +;; (coding-system-for-write 'binary)) +;; (with-temp-file workfile +;; (if rev +;; (vc-hg-command t nil file "cat" "-r" rev) +;; (vc-hg-command t nil file "cat"))))) + +(defun vc-hg-checkout-model (file) + 'implicit) + +;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-revert (file &optional contents-done) + (unless contents-done + (with-temp-buffer (vc-hg-command t nil file "revert")))) + +;;; Internal functions + +(defun vc-hg-command (buffer okstatus file &rest flags) + "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 buffer okstatus "hg" file + (if (stringp vc-hg-global-switches) + (cons vc-hg-global-switches flags) + (append vc-hg-global-switches + flags)))) + +(defun vc-hg-root (file) + (vc-find-root file ".hg")) + +(provide 'vc-hg) + +;; arch-tag: bd094dc5-715a-434f-a331-37b9fb7cd954 +;;; vc-hg.el ends here diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 22935ab7f3b..89d271431fa 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -62,7 +62,7 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS Arch MCVS) +(defcustom vc-handled-backends '(RCS CVS SVN SCCS HG Arch MCVS) ;; Arch and MCVS come last because they are per-tree rather than per-dir. "*List of version control backends for which VC will be used. Entries in this list will be tried in order to determine whether a diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index b109f48d91d..2c6046cab36 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -492,7 +492,9 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." ;; Old `svn' used name="svn:this_dir", newer use just name="". (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" - "url=\"\\([^\"]+\\)\"") nil t) + "url=\"\\(?1:[^\"]+\\)\"" + ;; Yet newer ones don't use XML any more. + "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t) ;; This is not a hostname but a URL. This may actually be considered ;; as a feature since it allows vc-svn-stay-local to specify different ;; behavior for different modules on the same server. diff --git a/lisp/vc.el b/lisp/vc.el index d5c53a15a76..04efe7fc2f0 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -105,7 +105,9 @@ ;; ;; * registered (file) ;; -;; Return non-nil if FILE is registered in this backend. +;; Return non-nil if FILE is registered in this backend. Both this +;; function as well as `state' should be careful to fail gracefully in the +;; event that the backend executable is absent. ;; ;; * state (file) ;; @@ -222,7 +224,7 @@ ;; The implementation should pass the value of vc-checkout-switches ;; to the backend command. ;; -;; * checkout (file &optional editable rev) +;; - checkout (file &optional editable rev) ;; ;; Check out revision REV of FILE into the working area. If EDITABLE ;; is non-nil, FILE should be writable by the user and if locking is @@ -270,6 +272,12 @@ ;; Insert the revision log of FILE into BUFFER, or the *vc* buffer ;; if BUFFER is nil. ;; +;; - log-view-mode () +;; +;; Mode to use for the output of print-log. This defaults to +;; `log-view-mode' and is expected to be changed (if at all) to a derived +;; mode of `log-view-mode'. +;; ;; - show-log-entry (version) ;; ;; If provided, search the log entry for VERSION in the current buffer, @@ -315,6 +323,11 @@ ;; of either 0 (no differences found), or 1 (either non-empty diff ;; or the diff is run asynchronously). ;; +;; - revision-completion-table (file) +;; +;; Return a completion table for existing revisions of FILE. +;; The default is to not use any completion table. +;; ;; - diff-tree (dir &optional rev1 rev2) ;; ;; Insert the diff for all files at and below DIR into the *vc-diff* @@ -939,6 +952,8 @@ Else, add CODE to the process' sentinel." ;; lost. Terminated processes get deleted automatically ;; anyway. -- cyd ((or (null proc) (eq (process-status proc) 'exit)) + ;; Make sure we've read the process's output before going further. + (if proc (accept-process-output proc)) (eval code)) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) @@ -946,12 +961,13 @@ Else, add CODE to the process' sentinel." (set-process-sentinel proc `(lambda (p s) (with-current-buffer ',(current-buffer) - (goto-char (process-mark p)) - ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf - ; (goto-char...)' - (car (cdr (cdr ;strip off `lambda (p s)' - sentinel)))))) - (list `(vc-exec-after ',code)))))))) + (save-excursion + (goto-char (process-mark p)) + ,@(append (cdr (cdr (car ;Strip off (save-exc (goto-char...) + (cdr (cdr ;Strip off (with-current-buffer buf + (car (cdr (cdr ;Strip off (lambda (p s) + sentinel)))))))) + (list `(vc-exec-after ',code))))))))) (t (error "Unexpected process state")))) nil) @@ -1740,6 +1756,8 @@ saving the buffer." (message "No changes to %s since latest version" file) (vc-version-diff file nil nil))))) +(defun vc-default-revision-completion-table (backend file) nil) + (defun vc-version-diff (file rev1 rev2) "List the differences between FILE's versions REV1 and REV2. If REV1 is empty or nil it means to use the current workfile version; @@ -1747,12 +1765,13 @@ REV2 empty or nil means the current file contents. FILE may also be a directory, in that case, generate diffs between the correponding versions of all registered files in or below it." (interactive - (let ((file (expand-file-name - (read-file-name (if buffer-file-name - "File or dir to diff (default visited file): " - "File or dir to diff: ") - default-directory buffer-file-name t))) - (rev1-default nil) (rev2-default nil)) + (let* ((file (expand-file-name + (read-file-name (if buffer-file-name + "File or dir to diff (default visited file): " + "File or dir to diff: ") + default-directory buffer-file-name t))) + (rev1-default nil) (rev2-default nil) + (completion-table (vc-call revision-completion-table file))) ;; compute default versions based on the file state (cond ;; if it's a directory, don't supply any version default @@ -1764,21 +1783,25 @@ versions of all registered files in or below it." ;; if the file is not locked, use last and previous version as default (t (setq rev1-default (vc-call previous-version file - (vc-workfile-version file))) + (vc-workfile-version file))) (if (string= rev1-default "") (setq rev1-default nil)) (setq rev2-default (vc-workfile-version file)))) ;; construct argument list - (list file - (read-string (if rev1-default - (concat "Older version (default " - rev1-default "): ") - "Older version: ") - nil nil rev1-default) - (read-string (if rev2-default - (concat "Newer version (default " - rev2-default "): ") - "Newer version (default current source): ") - nil nil rev2-default)))) + (let* ((rev1-prompt (if rev1-default + (concat "Older version (default " + rev1-default "): ") + "Older version: ")) + (rev2-prompt (concat "Newer version (default " + (or rev2-default "current source") "): ")) + (rev1 (if completion-table + (completing-read rev1-prompt completion-table + nil nil nil nil rev1-default) + (read-string rev1-prompt nil nil rev1-default))) + (rev2 (if completion-table + (completing-read rev2-prompt completion-table + nil nil nil nil rev2-default) + (read-string rev2-prompt nil nil rev2-default)))) + (list file rev1 rev2)))) (if (file-directory-p file) ;; recursive directory diff (progn @@ -1933,7 +1956,16 @@ The meaning of REV1 and REV2 is the same as for `vc-version-diff'." "Visit version REV of the current file in another window. If the current file is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, use it instead of checking it out again." - (interactive "sVersion to visit (default is workfile version): ") + (interactive + (save-current-buffer + (vc-ensure-vc-buffer) + (let ((completion-table + (vc-call revision-completion-table buffer-file-name)) + (prompt "Version to visit (default is workfile version): ")) + (list + (if completion-table + (completing-read prompt completion-table) + (read-string prompt)))))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (version (if (string-equal rev "") @@ -2453,7 +2485,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." (pop-to-buffer (current-buffer)) (vc-exec-after `(let ((inhibit-read-only t)) - (log-view-mode) + (vc-call-backend ',(vc-backend file) 'log-view-mode) (goto-char (point-max)) (forward-line -1) (while (looking-at "=*\n") (delete-char (- (match-end 0) (match-beginning 0))) @@ -2468,6 +2500,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." ',focus-rev) (set-buffer-modified-p nil))))) +(defun vc-default-log-view-mode (backend) (log-view-mode)) (defun vc-default-show-log-entry (backend rev) (with-no-warnings (log-view-goto-rev rev))) @@ -3026,13 +3059,13 @@ cover the range from the oldest annotation to the newest." ;; Run through this file and find the oldest and newest dates annotated. (save-excursion (goto-char (point-min)) - (while (setq date (prog1 (vc-call-backend vc-annotate-backend - 'annotate-time) - (forward-line 1))) - (if (> date newest) - (setq newest date)) - (if (< date oldest) - (setq oldest date)))) + (while (not (eobp)) + (when (setq date (vc-call-backend vc-annotate-backend 'annotate-time)) + (if (> date newest) + (setq newest date)) + (if (< date oldest) + (setq oldest date))) + (forward-line 1))) (vc-annotate-display (/ (- (if full newest current) oldest) (vc-annotate-oldest-in-map vc-annotate-color-map)) @@ -3097,9 +3130,9 @@ use; you may override this using the second optional arg MODE." (vc-annotate-display-default (or vc-annotate-ratio 1.0))) ;; One of the auto-scaling modes ((eq vc-annotate-display-mode 'scale) - (vc-annotate-display-autoscale)) + (vc-exec-after `(vc-annotate-display-autoscale))) ((eq vc-annotate-display-mode 'fullscale) - (vc-annotate-display-autoscale t)) + (vc-exec-after `(vc-annotate-display-autoscale t))) ((numberp vc-annotate-display-mode) ; A fixed number of days lookback (vc-annotate-display-default (/ vc-annotate-display-mode @@ -3176,9 +3209,13 @@ colors. `vc-annotate-background' specifies the background color." (set (make-local-variable 'vc-annotate-parent-rev) rev) (set (make-local-variable 'vc-annotate-parent-display-mode) display-mode))) - (when current-line - (goto-line current-line temp-buffer-name)) - (message "Annotating... done"))) + + (vc-exec-after + `(progn + (when ,current-line + (goto-line ,current-line ,temp-buffer-name)) + (unless (active-minibuffer-window) + (message "Annotating... done")))))) (defun vc-annotate-prev-version (prefix) "Visit the annotation of the version previous to this one. @@ -3353,30 +3390,30 @@ The annotations are relative to the current time, unless overridden by OFFSET." (font-lock-mode 1)) (defun vc-annotate-lines (limit) - (let (difference) - (while (and (< (point) limit) - (setq difference (vc-annotate-difference vc-annotate-offset))) - (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) - (cons nil vc-annotate-very-old-color))) - ;; substring from index 1 to remove any leading `#' in the name - (face-name (concat "vc-annotate-face-" - (if (string-equal - (substring (cdr color) 0 1) "#") - (substring (cdr color) 1) - (cdr color)))) - ;; Make the face if not done. - (face (or (intern-soft face-name) - (let ((tmp-face (make-face (intern face-name)))) - (set-face-foreground tmp-face (cdr color)) - (if vc-annotate-background - (set-face-background tmp-face - vc-annotate-background)) - tmp-face))) ; Return the face - (point (point))) - (forward-line 1) - (put-text-property point (point) 'face face))) - ;; Pretend to font-lock there were no matches. - nil)) + (while (< (point) limit) + (let ((difference (vc-annotate-difference vc-annotate-offset)) + (start (point)) + (end (progn (forward-line 1) (point)))) + (when difference + (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) + (cons nil vc-annotate-very-old-color))) + ;; substring from index 1 to remove any leading `#' in the name + (face-name (concat "vc-annotate-face-" + (if (string-equal + (substring (cdr color) 0 1) "#") + (substring (cdr color) 1) + (cdr color)))) + ;; Make the face if not done. + (face (or (intern-soft face-name) + (let ((tmp-face (make-face (intern face-name)))) + (set-face-foreground tmp-face (cdr color)) + (if vc-annotate-background + (set-face-background tmp-face + vc-annotate-background)) + tmp-face)))) ; Return the face + (put-text-property start end 'face face))))) + ;; Pretend to font-lock there were no matches. + nil) ;; Collect back-end-dependent stuff here diff --git a/lisp/wdired.el b/lisp/wdired.el index 4cc5a3c48c0..0c97b10ba5c 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -106,7 +106,6 @@ (eval-when-compile (require 'cl)) (require 'dired) (autoload 'dired-do-create-files-regexp "dired-aux") -(autoload 'dired-call-process "dired-aux") (defgroup wdired nil "Mode to rename files by editing their names in dired buffers." @@ -684,7 +683,7 @@ Like original function but it skips read-only words." (new-bit "-") (pos-prop (- (point) (- (current-column) wdired-col-perm)))) (if (eq (char-after (point)) ?-) - (setq new-bit + (setq new-bit (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r" (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w" "x")))) @@ -744,8 +743,8 @@ Like original function but it skips read-only words." (progn (setq perm-tmp (int-to-string (wdired-perms-to-number perms-new))) - (unless (equal 0 (dired-call-process dired-chmod-program - t perm-tmp filename)) + (unless (equal 0 (process-file dired-chmod-program + nil nil nil perm-tmp filename)) (setq errors (1+ errors)) (dired-log (concat dired-chmod-program " " perm-tmp " `" filename "' failed\n\n")))) diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 20006d9eea7..5c25f0945a9 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,37 @@ +2007-07-07 Michael Albinus <michael.albinus@gmx.de> + + * process.texi (Asynchronous Processes): + * files.texi (Magic File Names): Add `start-file-process'. + +2007-06-27 Richard Stallman <rms@gnu.org> + + * files.texi (Format Conversion Piecemeal): Clarify + `after-insert-file-functions' calling convention. + +2007-06-27 Michael Albinus <michael.albinus@gmx.de> + + * files.texi (Magic File Names): Remove `dired-call-process'. Add + `process-file'. + +2007-06-27 Kenichi Handa <handa@m17n.org> + + * text.texi (Special Properties): Fix description about + `compostion' property. + +2007-06-26 Kenichi Handa <handa@m17n.org> + + * nonascii.texi (Default Coding Systems): Document about the + return value `undecided'. + +2007-06-25 David Kastrup <dak@gnu.org> + + * keymaps.texi (Active Keymaps): Document new POSITION argument of + `current-active-maps'. + +2007-06-24 Karl Berry <karl@gnu.org> + + * elisp.texi, vol1.texi, vol2.texi: new Back-Cover Text. + 2007-06-15 Juanma Barranquero <lekktu@gmail.com> * display.texi (Overlay Arrow): Doc fix. diff --git a/lispref/elisp.texi b/lispref/elisp.texi index accfe05c27d..7b57b8a61af 100644 --- a/lispref/elisp.texi +++ b/lispref/elisp.texi @@ -15,7 +15,7 @@ @end direntry @c in general, keep the following line commented out, unless doing a -@c copy of this manual that will be published. the manual should go +@c copy of this manual that will be published. The manual should go @c onto the distribution in the full, 8.5 x 11" size. @c set smallbook @@ -29,13 +29,11 @@ @tex @ifset smallbook @fonttextsize 10 -@set EMACSVER 22 +@set EMACSVER 22.1 \global\let\urlcolor=\Black % don't print links in grayscale \global\let\linkcolor=\Black @end ifset \global\hbadness=6666 % don't worry about not-too-underfull boxes -\global\let\urlcolor=\Black % don't print links in grayscale -\global\let\linkcolor=\Black @end tex @c Combine indices. @@ -63,9 +61,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/lispref/files.texi b/lispref/files.texi index 19bacb142eb..5af77fafc31 100644 --- a/lispref/files.texi +++ b/lispref/files.texi @@ -2587,7 +2587,6 @@ first, before handlers for jobs such as remote file access. @code{directory-file-name}, @code{directory-files}, @code{directory-files-and-attributes}, -@code{dired-call-process}, @code{dired-compress-file}, @code{dired-uncache},@* @code{expand-file-name}, @code{file-accessible-directory-p}, @@ -2614,8 +2613,10 @@ first, before handlers for jobs such as remote file access. @code{make-directory}, @code{make-directory-internal}, @code{make-symbolic-link},@* +@code{process-file}, @code{rename-file}, @code{set-file-modes}, @code{set-file-times}, @code{set-visited-file-modtime}, @code{shell-command}, +@code{start-file-process}, @code{substitute-in-file-name},@* @code{unhandled-file-name-directory}, @code{vc-registered}, @@ -2633,7 +2634,6 @@ first, before handlers for jobs such as remote file access. @code{directory-file-name}, @code{directory-files}, @code{directory-files-and-at@discretionary{}{}{}tributes}, -@code{dired-call-process}, @code{dired-compress-file}, @code{dired-uncache}, @code{expand-file-name}, @code{file-accessible-direc@discretionary{}{}{}tory-p}, @@ -2658,8 +2658,10 @@ first, before handlers for jobs such as remote file access. @code{load}, @code{make-direc@discretionary{}{}{}tory}, @code{make-direc@discretionary{}{}{}tory-internal}, @code{make-symbolic-link}, +@code{process-file}, @code{rename-file}, @code{set-file-modes}, @code{set-visited-file-modtime}, @code{shell-command}, +@code{start-file-process}, @code{substitute-in-file-name}, @code{unhandled-file-name-directory}, @code{vc-regis@discretionary{}{}{}tered}, @@ -3071,8 +3073,10 @@ have been dealt with by this function. @defvar after-insert-file-functions Each function in this list is called by @code{insert-file-contents} -with one argument, the number of characters inserted, and should -return the new character count, leaving point the same. +with one argument, the number of characters inserted, and with point +at the beginning of the inserted text. Each function should leave +point unchanged, and return the new character count describing the +inserted text as modified by the function. @c ??? The docstring mentions a handler from `file-name-handler-alist' @c "intercepting" `insert-file-contents'. Hmmm. --ttn @end defvar diff --git a/lispref/keymaps.texi b/lispref/keymaps.texi index 400a2c38240..bf20680dd81 100644 --- a/lispref/keymaps.texi +++ b/lispref/keymaps.texi @@ -655,12 +655,15 @@ events within @code{read-key-sequence}. @xref{Translation Keymaps}. @xref{Standard Keymaps}, for a list of standard keymaps. -@defun current-active-maps &optional olp +@defun current-active-maps &optional olp position This returns the list of active keymaps that would be used by the command loop in the current circumstances to look up a key sequence. Normally it ignores @code{overriding-local-map} and -@code{overriding-terminal-local-map}, but if @var{olp} is -non-@code{nil} then it pays attention to them. +@code{overriding-terminal-local-map}, but if @var{olp} is non-@code{nil} +then it pays attention to them. @var{position} can optionally be either +an event position as returned by @code{event-start} or a buffer +position, and may change the keymaps as described for +@code{key-binding}. @end defun @defun key-binding key &optional accept-defaults no-remap position diff --git a/lispref/nonascii.texi b/lispref/nonascii.texi index dd0f15c817e..a8f45e9dd20 100644 --- a/lispref/nonascii.texi +++ b/lispref/nonascii.texi @@ -1031,6 +1031,9 @@ argument, a list of all arguments passed to @code{find-operation-coding-system}. It must return a coding system or a cons cell containing two coding systems. This value has the same meaning as described above. + +If @var{coding} (or what returned by the above function) is +@code{undecided}, the normal code-detection is performed. @end defvar @defvar process-coding-system-alist diff --git a/lispref/processes.texi b/lispref/processes.texi index 81cac3e5046..5e74d0e247f 100644 --- a/lispref/processes.texi +++ b/lispref/processes.texi @@ -495,6 +495,23 @@ Process my-process finished @end smallexample @end defun +@defun start-file-process name buffer-or-name program &rest args +Like @code{start-process}, this function starts a new asynchronous +subprocess running @var{program} in it. The corresponding process +object is returned. + +If @code{default-directory} corresponds to a file handler, that +handler is invoked. @var{program} runs then on a remote host which is +identified by @code{default-directory}. The local part of +@code{default-directory} is the working directory of the subprocess. + +@var{program} and @var{program-args} might be file names. They are not +objects of file handler invocation. + +Some file handlers may not support @code{start-file-process} (for +example @code{ange-ftp-hook-function}). It returns then @code{nil}. +@end defun + @defun start-process-shell-command name buffer-or-name command &rest command-args This function is like @code{start-process} except that it uses a shell to execute the specified command. The argument @var{command} is a shell @@ -1309,7 +1326,7 @@ latter specifies one measured in milliseconds. The two time periods thus specified are added together, and @code{accept-process-output} returns after that much time, whether or not there has been any subprocess output. - + The argument @var{millisec} is semi-obsolete nowadays because @var{seconds} can be a floating point number to specify waiting a fractional number of seconds. If @var{seconds} is 0, the function diff --git a/lispref/text.texi b/lispref/text.texi index f05a0cd696a..b3cd6cb4a92 100644 --- a/lispref/text.texi +++ b/lispref/text.texi @@ -3256,25 +3256,10 @@ Manual}) provides an example. @item composition @kindex composition @r{(text property)} This text property is used to display a sequence of characters as a -single glyph composed from components. For instance, in Thai a base -consonant is composed with the following combining vowel as a single -glyph. The value should be a character or a sequence (vector, list, -or string) of integers. +single glyph composed from components. But the value of the property +itself is completely internal to Emacs and should not be manipulated +directly by, for instance, @code{put-text-property}. -@itemize @bullet -@item -If it is a character, it means to display that character instead of -the text in the region. - -@item -If it is a string, it means to display that string's contents instead -of the text in the region. - -@item -If it is a vector or list, the elements are characters interleaved -with internal codes specifying how to compose the following character -with the previous one. -@end itemize @end table @node Format Properties diff --git a/lispref/vol1.texi b/lispref/vol1.texi index 5dff4f076b9..d0989f6c58e 100644 --- a/lispref/vol1.texi +++ b/lispref/vol1.texi @@ -80,9 +80,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/lispref/vol2.texi b/lispref/vol2.texi index 2ccbaefca9b..35ffa0e88b2 100644 --- a/lispref/vol2.texi +++ b/lispref/vol2.texi @@ -80,9 +80,9 @@ Front-Cover texts being ``A GNU Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying diff --git a/man/ChangeLog b/man/ChangeLog index e216f6ab7c3..ad2d3b889f2 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,29 @@ +2007-07-02 Carsten Dominik <dominik@science.uva.nl> + + * org.texi (Properties): New chapter. + +2007-06-24 Karl Berry <karl@gnu.org> + + * emacs.texi: new Back-Cover Text. + +2007-06-20 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi:Change ifinfo to ifnottex (as appropriate) throughout. + (About This Manual): Remove redundant information. + (Getting Started): Mention author. + (Basic Arithmetic, Customizing Calc): Make description of the + variable `calc-multiplication-has-precedence' match its new effect. + +2007-06-19 Jay Belanger <jay.p.belanger@gmail.com> + + * calc.texi (Basic Arithmetic, Customizing Calc): Mention + the variable `calc-multiplication-has-precedence'. + +2007-06-19 Carsten Dominik <dominik@science.uva.nl> + + * org.texi (Tag): Section swapped with node Timestamps. + (Formula syntax for Lisp): Document new `L' flag. + 2007-06-06 Andreas Seltenreich <andreas@gate450.dyndns.org> * gnus.texi (Misc Group Stuff, Summary Buffer) diff --git a/man/calc.texi b/man/calc.texi index ecf85a450bd..9436e79ef0f 100644 --- a/man/calc.texi +++ b/man/calc.texi @@ -124,28 +124,32 @@ Copyright @copyright{} 1990, 1991, 2001, 2002, 2003, 2004, @end titlepage @c [begin] -@ifinfo +@ifnottex @node Top, Getting Started, (dir), (dir) @chapter The GNU Emacs Calculator @noindent @dfn{Calc} is an advanced desk calculator and mathematical tool -that runs as part of the GNU Emacs environment. +written by Dave Gillespie that runs as part of the GNU Emacs environment. -This manual is divided into three major parts: ``Getting Started,'' -the ``Calc Tutorial,'' and the ``Calc Reference.'' The Tutorial -introduces all the major aspects of Calculator use in an easy, -hands-on way. The remainder of the manual is a complete reference to -the features of the Calculator. +This manual, also written (mostly) by Dave Gillespie, is divided into +three major parts: ``Getting Started,'' the ``Calc Tutorial,'' and the +``Calc Reference.'' The Tutorial introduces all the major aspects of +Calculator use in an easy, hands-on way. The remainder of the manual is +a complete reference to the features of the Calculator. +@end ifnottex +@ifinfo For help in the Emacs Info system (which you are using to read this file), type @kbd{?}. (You can also type @kbd{h} to run through a longer Info tutorial.) - @end ifinfo + @menu * Getting Started:: General description and overview. +@ifinfo * Interactive Tutorial:: +@end ifinfo * Tutorial:: A step-by-step introduction for beginners. * Introduction:: Introduction to the Calc reference manual. @@ -179,7 +183,12 @@ longer Info tutorial.) * Lisp Function Index:: Internal Lisp math functions. @end menu +@ifinfo @node Getting Started, Interactive Tutorial, Top, Top +@end ifinfo +@ifnotinfo +@node Getting Started, Tutorial, Top, Top +@end ifnotinfo @chapter Getting Started @noindent This chapter provides a general overview of Calc, the GNU Emacs @@ -267,12 +276,6 @@ experience with GNU Emacs in order to get the most out of Calc, this manual ought to be readable even if you don't know or use Emacs regularly. -@ifinfo -The manual is divided into three major parts:@: the ``Getting -Started'' chapter you are reading now, the Calc tutorial (chapter 2), -and the Calc reference manual (the remaining chapters and appendices). -@end ifinfo -@iftex The manual is divided into three major parts:@: the ``Getting Started'' chapter you are reading now, the Calc tutorial (chapter 2), and the Calc reference manual (the remaining chapters and appendices). @@ -280,7 +283,6 @@ and the Calc reference manual (the remaining chapters and appendices). @c This manual has been printed in two volumes, the @dfn{Tutorial} and the @c @dfn{Reference}. Both volumes include a copy of the ``Getting Started'' @c chapter. -@end iftex If you are in a hurry to use Calc, there is a brief ``demonstration'' below which illustrates the major features of Calc in just a couple of @@ -321,6 +323,7 @@ you can also go to the part of the manual describing any Calc key, function, or variable using @w{@kbd{h k}}, @kbd{h f}, or @kbd{h v}, respectively. @xref{Help Commands}. +@ifnottex The Calc manual can be printed, but because the manual is so large, you should only make a printed copy if you really need it. To print the manual, you will need the @TeX{} typesetting program (this is a free @@ -347,7 +350,7 @@ or @example dvips calc.dvi @end example - +@end ifnottex @c Printed copies of this manual are also available from the Free Software @c Foundation. @@ -543,13 +546,13 @@ system. Type @kbd{d N} to return to normal notation. Type @kbd{7.5}, then @kbd{s l a @key{RET}} to let @expr{a = 7.5} in these formulas. (That's a letter @kbd{l}, not a numeral @kbd{1}.) -@iftex +@ifnotinfo @strong{Help functions.} You can read about any command in the on-line manual. Type @kbd{C-x * c} to return to Calc after each of these commands: @kbd{h k t N} to read about the @kbd{t N} command, @kbd{h f sqrt @key{RET}} to read about the @code{sqrt} function, and @kbd{h s} to read the Calc summary. -@end iftex +@end ifnotinfo @ifinfo @strong{Help functions.} You can read about any command in the on-line manual. Remember to type the letter @kbd{l}, then @kbd{C-x * c}, to @@ -1251,9 +1254,12 @@ Press @kbd{1} now to enter the first section of the Tutorial. @menu * Tutorial:: @end menu -@end ifinfo @node Tutorial, Introduction, Interactive Tutorial, Top +@end ifinfo +@ifnotinfo +@node Tutorial, Introduction, Getting Started, Top +@end ifnotinfo @chapter Tutorial @noindent @@ -1272,32 +1278,22 @@ The Quick mode and Keypad mode interfaces are fairly self-explanatory. @xref{Embedded Mode}, for a description of the Embedded mode interface. -@ifinfo The easiest way to read this tutorial on-line is to have two windows on your Emacs screen, one with Calc and one with the Info system. (If you have a printed copy of the manual you can use that instead.) Press @kbd{C-x * c} to turn Calc on or to switch into the Calc window, and press @kbd{C-x * i} to start the Info system or to switch into its window. -Or, you may prefer to use the tutorial in printed form. -@end ifinfo -@iftex -The easiest way to read this tutorial on-line is to have two windows on -your Emacs screen, one with Calc and one with the Info system. (If you -have a printed copy of the manual you can use that instead.) Press -@kbd{C-x * c} to turn Calc on or to switch into the Calc window, and -press @kbd{C-x * i} to start the Info system or to switch into its window. -@end iftex This tutorial is designed to be done in sequence. But the rest of this manual does not assume you have gone through the tutorial. The tutorial does not cover everything in the Calculator, but it touches on most general areas. -@ifinfo +@ifnottex You may wish to print out a copy of the Calc Summary and keep notes on it as you learn Calc. @xref{About This Manual}, to see how to make a printed summary. @xref{Summary}. -@end ifinfo +@end ifnottex @iftex The Calc Summary at the end of the reference manual includes some blank space for your own use. You may wish to keep notes there as you learn @@ -1334,13 +1330,13 @@ to control various modes of the Calculator. @subsection RPN Calculations and the Stack @cindex RPN notation -@ifinfo +@ifnottex @noindent Calc normally uses RPN notation. You may be familiar with the RPN system from Hewlett-Packard calculators, FORTH, or PostScript. (Reverse Polish Notation, RPN, is named after the Polish mathematician Jan Lukasiewicz.) -@end ifinfo +@end ifnottex @tex \noindent Calc normally uses RPN notation. You may be familiar with the RPN @@ -1769,7 +1765,7 @@ is equivalent to @noindent or, in large mathematical notation, -@ifinfo +@ifnottex @example @group 3 * 4 * 5 @@ -1778,7 +1774,7 @@ or, in large mathematical notation, 6 * 7 @end group @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -3325,7 +3321,7 @@ We can multiply these two matrices in either order to get an identity. Matrix inverses are related to systems of linear equations in algebra. Suppose we had the following set of equations: -@ifinfo +@ifnottex @group @example a + 2b + 3c = 6 @@ -3333,7 +3329,7 @@ Suppose we had the following set of equations: 7a + 6b = 3 @end example @end group -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplayh @@ -3352,7 +3348,7 @@ $$ @noindent This can be cast into the matrix equation, -@ifinfo +@ifnottex @group @example [ [ 1, 2, 3 ] [ [ a ] [ [ 6 ] @@ -3360,7 +3356,7 @@ This can be cast into the matrix equation, [ 7, 6, 0 ] ] [ c ] ] [ 3 ] ] @end example @end group -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -3425,14 +3421,14 @@ vectors and matrices that include variables. Solve the following system of equations to get expressions for @expr{x} and @expr{y} in terms of @expr{a} and @expr{b}. -@ifinfo +@ifnottex @group @example x + a y = 6 x + b y = 10 @end example @end group -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -3456,9 +3452,9 @@ you can't solve @expr{A X = B} directly because the matrix @expr{A} is not square for an over-determined system. Matrix inversion works only for square matrices. One common trick is to multiply both sides on the left by the transpose of @expr{A}: -@ifinfo +@ifnottex @samp{trn(A)*A*X = trn(A)*B}. -@end ifinfo +@end ifnottex @tex \turnoffactive $A^T A \, X = A^T B$, where $A^T$ is the transpose \samp{trn(A)}. @@ -3472,7 +3468,7 @@ solution, which can be regarded as the ``closest'' solution to the set of equations. Use Calc to solve the following over-determined system: -@ifinfo +@ifnottex @group @example a + 2b + 3c = 6 @@ -3481,7 +3477,7 @@ system: 2a + 4b + 6c = 11 @end example @end group -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplayh @@ -3749,11 +3745,11 @@ stored value from the stack.) In a least squares fit, the slope @expr{m} is given by the formula -@ifinfo +@ifnottex @example m = (N sum(x y) - sum(x) sum(y)) / (N sum(x^2) - sum(x)^2) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -3790,12 +3786,12 @@ this formula uses. @end group @end smallexample -@ifinfo +@ifnottex @noindent These are @samp{sum(x)}, @samp{sum(x^2)}, @samp{sum(y)}, and @samp{sum(x y)}, respectively. (We could have used @kbd{*} to compute @samp{sum(x^2)} and @samp{sum(x y)}.) -@end ifinfo +@end ifnottex @tex \turnoffactive These are $\sum x$, $\sum x^2$, $\sum y$, and $\sum x y$, @@ -3845,11 +3841,11 @@ Now we grind through the formula: That gives us the slope @expr{m}. The y-intercept @expr{b} can now be found with the simple formula, -@ifinfo +@ifnottex @example b = (sum(y) - m sum(x)) / N @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -3987,14 +3983,14 @@ The @kbd{C-x * g} command accepts numbers separated by spaces or commas, with or without surrounding vector brackets. @xref{List Answer 3, 3}. (@bullet{}) -@ifinfo +@ifnottex As another example, a theorem about binomial coefficients tells us that the alternating sum of binomial coefficients @var{n}-choose-0 minus @var{n}-choose-1 plus @var{n}-choose-2, and so on up to @var{n}-choose-@var{n}, always comes out to zero. Let's verify this for @expr{n=6}. -@end ifinfo +@end ifnottex @tex As another example, a theorem about binomial coefficients tells us that the alternating sum of binomial coefficients @@ -5193,12 +5189,12 @@ to be a better approximation than stairsteps. A third method is that the steps are not required to be flat. Simpson's rule boils down to the formula, -@ifinfo +@ifnottex @example (h/3) * (f(a) + 4 f(a+h) + 2 f(a+2h) + 4 f(a+3h) + ... + 2 f(a+(n-2)*h) + 4 f(a+(n-1)*h) + f(a+n*h)) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -5215,12 +5211,12 @@ is the width of each slice. These are 10 and 0.1 in our example. For reference, here is the corresponding formula for the stairstep method: -@ifinfo +@ifnottex @example h * (f(a) + f(a+h) + f(a+2h) + f(a+3h) + ... + f(a+(n-2)*h) + f(a+(n-1)*h)) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -5657,11 +5653,11 @@ so that @expr{2 - 3 (x + y) + x y} is a sum of three terms.) infinite series that exactly equals the value of that function at values of @expr{x} near zero. -@ifinfo +@ifnottex @example cos(x) = 1 - x^2 / 2! + x^4 / 4! - x^6 / 6! + ... @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -5675,11 +5671,11 @@ Calc represents the truncated Taylor series as a polynomial in @expr{x}. Mathematicians often write a truncated series using a ``big-O'' notation that records what was the lowest term that was truncated. -@ifinfo +@ifnottex @example cos(x) = 1 - x^2 / 2! + O(x^3) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -6204,11 +6200,11 @@ equations numerically is @dfn{Newton's Method}. Given the equation @expr{x_0} which is reasonably close to the desired solution, apply this formula over and over: -@ifinfo +@ifnottex @example new_x = x - f(x)/f'(x) @end example -@end ifinfo +@end ifnottex @tex \beforedisplay $$ x_{\rm new} = x - {f(x) \over f'(x)} $$ @@ -6242,11 +6238,11 @@ is defined as the derivative of @infoline @expr{ln(gamma(z))}. For large values of @expr{z}, it can be approximated by the infinite sum -@ifinfo +@ifnottex @example psi(z) ~= ln(z) - 1/2z - sum(bern(2 n) / 2 n z^(2 n), n, 1, inf) @end example -@end ifinfo +@end ifnottex @tex \beforedisplay $$ \psi(z) \approx \ln z - {1\over2z} - @@ -6305,13 +6301,13 @@ a way to convert from this form back to the standard algebraic form. (@bullet{}) @strong{Exercise 11.} The @dfn{Stirling numbers of the first kind} are defined by the recurrences, -@ifinfo +@ifnottex @example s(n,n) = 1 for n >= 0, s(n,0) = 0 for n > 0, s(n+1,m) = s(n,m-1) - n s(n,m) for n >= m >= 1. @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -6843,14 +6839,14 @@ get the row sum. Similarly, use @kbd{[1 1] r 4 *} to get the column sum. @node Matrix Answer 2, Matrix Answer 3, Matrix Answer 1, Answers to Exercises @subsection Matrix Tutorial Exercise 2 -@ifinfo +@ifnottex @example @group x + a y = 6 x + b y = 10 @end group @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -6905,7 +6901,7 @@ now, we have a system @infoline @expr{A2 * X = B2} which we can solve using Calc's @samp{/} command. -@ifinfo +@ifnottex @example @group a + 2b + 3c = 6 @@ -6914,7 +6910,7 @@ which we can solve using Calc's @samp{/} command. 2a + 4b + 6c = 11 @end group @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplayh @@ -7045,11 +7041,11 @@ vector. Given @expr{x} and @expr{y} vectors in quick variables 1 and 2 as before, the first job is to form the matrix that describes the problem. -@ifinfo +@ifnottex @example m*x + b*1 = y @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -7836,11 +7832,11 @@ Why does this work? Think about a two-step computation: subtracting off enough 511's to put the result in the desired range. So the result when we take the modulo after every step is, -@ifinfo +@ifnottex @example 3 (3 a + b - 511 m) + c - 511 n @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -7852,11 +7848,11 @@ $$ 3 (3 a + b - 511 m) + c - 511 n $$ for some suitable integers @expr{m} and @expr{n}. Expanding out by the distributive law yields -@ifinfo +@ifnottex @example 9 a + 3 b + c - 511*3 m - 511 n @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -7870,11 +7866,11 @@ contribution it makes could just as easily be made by the @expr{n} term. So we can take it out to get an equivalent formula with @expr{n' = 3m + n}, -@ifinfo +@ifnottex @example 9 a + 3 b + c - 511 n' @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -11285,7 +11281,7 @@ from 1 to 8. Interval arithmetic is used to get a worst-case estimate of the possible range of values a computation will produce, given the set of possible values of the input. -@ifinfo +@ifnottex Calc supports several varieties of intervals, including @dfn{closed} intervals of the type shown above, @dfn{open} intervals such as @samp{(2 ..@: 4)}, which represents the range of numbers from 2 to 4 @@ -11296,7 +11292,7 @@ terms, @samp{[2 ..@: 4)} represents @expr{2 <= x < 4}, @samp{(2 ..@: 4]} represents @expr{2 < x <= 4}, and @samp{(2 ..@: 4)} represents @expr{2 < x < 4}. -@end ifinfo +@end ifnottex @tex Calc supports several varieties of intervals, including \dfn{closed} intervals of the type shown above, \dfn{open} intervals such as @@ -11929,14 +11925,14 @@ commands, @kbd{t h} works only when Calc Trail is the selected window. @pindex calc-trail-isearch-forward @kindex t r @pindex calc-trail-isearch-backward -@ifinfo +@ifnottex The @kbd{t s} (@code{calc-trail-isearch-forward}) and @kbd{t r} (@code{calc-trail-isearch-backward}) commands perform an incremental search forward or backward through the trail. You can press @key{RET} to terminate the search; the trail pointer moves to the current line. If you cancel the search with @kbd{C-g}, the trail pointer stays where it was when the search began. -@end ifinfo +@end ifnottex @tex The @kbd{t s} (@code{calc-trail-isearch-forward}) and @kbd{t r} (@code{calc-trail-isearch-backward}) com\-mands perform an incremental @@ -14237,10 +14233,10 @@ font information. Also, the ``discretionary multiplication sign'' @samp{\*} is read the same as @samp{*}. -@ifinfo +@ifnottex The @TeX{} version of this manual includes some printed examples at the end of this section. -@end ifinfo +@end ifnottex @iftex Here are some examples of how various Calc formulas are formatted in @TeX{}: @@ -15975,9 +15971,28 @@ whereas @w{@samp{[-2 ..@: 3] ^ 2}} is @samp{[0 ..@: 9]}. @mindex @null @end ignore @tindex / -The @kbd{/} (@code{calc-divide}) command divides two numbers. Note that -when using algebraic entry, @samp{/} has lower precedence than @samp{*}, -so that @samp{a/b*c} is interpreted as @samp{a/(b*c)}. +The @kbd{/} (@code{calc-divide}) command divides two numbers. + +When combining multiplication and division in an algebraic formula, it +is good style to use parentheses to distinguish between possible +interpretations; the expression @samp{a/b*c} should be written +@samp{(a/b)*c} or @samp{a/(b*c)}, as appropriate. Without the +parentheses, Calc will interpret @samp{a/b*c} as @samp{a/(b*c)}, since +in algebraic entry Calc gives division a lower precedence than +multiplication. (This is not standard across all computer languages, and +Calc may change the precedence depending on the language mode being used. +@xref{Language Modes}.) This default ordering can be changed by setting +the customizable variable @code{calc-multiplication-has-precedence} to +@code{nil} (@pxref{Customizing Calc}); this will give multiplication and +division equal precedences. Note that Calc's default choice of +precedence allows @samp{a b / c d} to be used as a shortcut for +@smallexample +@group +a b +---. +c d +@end group +@end smallexample When dividing a scalar @expr{B} by a square matrix @expr{A}, the computation performed is @expr{B} times the inverse of @expr{A}. This @@ -17637,7 +17652,7 @@ formulas below for symbolic arguments only when you use the @kbd{a "} (@code{calc-expand-formula}) command, or when taking derivatives or integrals or solving equations involving the functions. -@ifinfo +@ifnottex These formulas are shown using the conventions of Big display mode (@kbd{d B}); for example, the formula for @code{fv} written linearly is @samp{pmt * ((1 + rate)^n) - 1) / rate}. @@ -17717,7 +17732,7 @@ syd(cost, salv, life, per) = -------------------------------- ddb(cost, salv, life, per) = --------, book = cost - depreciation so far life @end example -@end ifinfo +@end ifnottex @tex \turnoffactive $$ \code{fv}(r, n, p) = p { (1 + r)^n - 1 \over r } $$ @@ -18366,14 +18381,14 @@ some authors, is computed by the @kbd{I f G} [@code{gammaQ}] command. You can think of this as taking the other half of the integral, from @expr{x} to infinity. -@ifinfo +@ifnottex The functions corresponding to the integrals that define @expr{P(a,x)} and @expr{Q(a,x)} but without the normalizing @expr{1/gamma(a)} factor are called @expr{g(a,x)} and @expr{G(a,x)}, respectively (where @expr{g} and @expr{G} represent the lower- and upper-case Greek letter gamma). You can obtain these using the @kbd{H f G} [@code{gammag}] and @kbd{H I f G} [@code{gammaG}] commands. -@end ifinfo +@end ifnottex @tex \turnoffactive The functions corresponding to the integrals that define $P(a,x)$ @@ -18889,10 +18904,10 @@ real numbers by @kindex H k c @pindex calc-perm @tindex perm -@ifinfo +@ifnottex The @kbd{H k c} (@code{calc-perm}) [@code{perm}] command computes the number-of-permutations function @expr{N! / (N-M)!}. -@end ifinfo +@end ifnottex @tex The \kbd{H k c} (\code{calc-perm}) [\code{perm}] command computes the number-of-perm\-utations function $N! \over (N-M)!\,$. @@ -23132,13 +23147,13 @@ integral of the expression on top of the stack. In this case, the command will again prompt for an integration variable, then prompt for a lower limit and an upper limit. -@ifinfo +@ifnottex If you use the @code{integ} function directly in an algebraic formula, you can also write @samp{integ(f,x,v)} which expresses the resulting indefinite integral in terms of variable @code{v} instead of @code{x}. With four arguments, @samp{integ(f(x),x,a,b)} represents a definite integral from @code{a} to @code{b}. -@end ifinfo +@end ifnottex @tex If you use the @code{integ} function directly in an algebraic formula, you can also write @samp{integ(f,x,v)} which expresses the resulting @@ -24019,14 +24034,14 @@ name only those and let the parameters use default names. For example, suppose the data matrix -@ifinfo +@ifnottex @example @group [ [ 1, 2, 3, 4, 5 ] [ 5, 7, 9, 11, 13 ] ] @end group @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \turnoffactive @@ -24083,11 +24098,11 @@ Calc has chosen a line that best approximates the data points using the method of least squares. The idea is to define the @dfn{chi-square} error measure -@ifinfo +@ifnottex @example chi^2 = sum((y_i - (a + b x_i))^2, i, 1, N) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -24272,11 +24287,11 @@ then the @infoline @expr{chi^2} statistic is now, -@ifinfo +@ifnottex @example chi^2 = sum(((y_i - (a + b x_i)) / sigma_i)^2, i, 1, N) @end example -@end ifinfo +@end ifnottex @tex \turnoffactive \beforedisplay @@ -27594,9 +27609,9 @@ The unit @code{A} stands for Amperes; the name @code{Ang} is used @tex for \AA ngstroms. @end tex -@ifinfo +@ifnottex for Angstroms. -@end ifinfo +@end ifnottex The unit @code{pt} stands for pints; the name @code{point} stands for a typographical point, defined by @samp{72 point = 1 in}. This is @@ -34516,9 +34531,9 @@ modification follow. @iftex @unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION @end iftex -@ifinfo +@ifnottex @center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION -@end ifinfo +@end ifnottex @enumerate 0 @item @@ -34741,9 +34756,9 @@ of promoting the sharing and reuse of software generally. @iftex @heading NO WARRANTY @end iftex -@ifinfo +@ifnottex @center NO WARRANTY -@end ifinfo +@end ifnottex @item BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY @@ -34771,9 +34786,9 @@ POSSIBILITY OF SUCH DAMAGES. @iftex @heading END OF TERMS AND CONDITIONS @end iftex -@ifinfo +@ifnottex @center END OF TERMS AND CONDITIONS -@end ifinfo +@end ifnottex @page @unnumberedsec Appendix: How to Apply These Terms to Your New Programs @@ -34899,10 +34914,9 @@ See @ref{Graphics}.@* The variable @code{calc-gnuplot-name} should be the name of the GNUPLOT program (a string). If you have GNUPLOT installed on your system but Calc is unable to find it, you may need to set this -variable. (@pxref{Customizing Calc}) -You may also need to set some Lisp variables to show Calc how to run -GNUPLOT on your system, see @ref{Devices, ,Graphical Devices} . The default value -of @code{calc-gnuplot-name} is @code{"gnuplot"}. +variable. You may also need to set some Lisp variables to show Calc how +to run GNUPLOT on your system, see @ref{Devices, ,Graphical Devices} . +The default value of @code{calc-gnuplot-name} is @code{"gnuplot"}. @end defvar @defvar calc-gnuplot-plot-command @@ -35158,6 +35172,18 @@ should also be added to @code{calc-embedded-announce-formula-alist} and @code{calc-embedded-open-close-plain-alist}. @end defvar +@defvar calc-multiplication-has-precedence +The variable @code{calc-multiplication-has-precedence} determines +whether multiplication has precedence over division in algebraic formulas +in normal language modes. If @code{calc-multiplication-has-precedence} +is non-@code{nil}, then multiplication has precedence, and so for +example @samp{a/b*c} will be interpreted as @samp{a/(b*c)}. If +@code{calc-multiplication-has-precedence} is @code{nil}, then +multiplication has the same precedence as division, and so for example +@samp{a/b*c} will be interpreted as @samp{(a/b)*c}. The default value +of @code{calc-multiplication-has-precedence} is @code{t}. +@end defvar + @node Reporting Bugs, Summary, Customizing Calc, Top @appendix Reporting Bugs diff --git a/man/emacs.texi b/man/emacs.texi index 54725305e1f..e6c6643effb 100644 --- a/man/emacs.texi +++ b/man/emacs.texi @@ -25,9 +25,9 @@ Manual,'' and with the Back-Cover Texts as in (a) below. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' -(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify -this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development.'' +(a) The FSF's Back-Cover Text is: ``You are free to copy and modify +this GNU Manual. Buying copies from GNU Press supports the FSF in +developing GNU and promoting software freedom.'' @end quotation @end copying @@ -37,7 +37,7 @@ Software Foundation raise funds for GNU development.'' @end direntry @c in general, keep the following line commented out, unless doing a -@c copy of this manual that will be published. the manual should go +@c copy of this manual that will be published. The manual should go @c onto the distribution in the full, 8.5 x 11" size. @c set smallbook diff --git a/man/org.texi b/man/org.texi index 22d217c1c89..c82df74148b 100644 --- a/man/org.texi +++ b/man/org.texi @@ -3,8 +3,8 @@ @setfilename ../info/org @settitle Org Mode Manual -@set VERSION 4.77 -@set DATE June 2007 +@set VERSION 5.01 +@set DATE July 2007 @dircategory Emacs @direntry @@ -80,8 +80,9 @@ Software Foundation raise funds for GNU development.'' * Tables:: Pure magic for quick formatting * Hyperlinks:: Notes in context * TODO items:: Every tree branch can be a TODO item -* Timestamps:: Assign date and time to items * Tags:: Tagging headlines and matching sets of tags +* Properties:: +* Timestamps:: Assign date and time to items * Agenda views:: Collecting information into views * Embedded LaTeX:: LaTeX fragments and formulas * Exporting:: Sharing and publishing of notes @@ -112,6 +113,7 @@ Document Structure * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context * Plain lists:: Additional structure within an entry +* Drawers:: Archiving @@ -173,6 +175,25 @@ Extended use of TODO keywords * Multiple sets in one file:: Mixing it all, and still finding your way * Per file keywords:: Different files, different requirements +Tags + +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags + +Properties + +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers + +Column View + +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view + Timestamps * Time stamps:: Assigning a time to a tree entry @@ -196,12 +217,6 @@ Progress Logging * Tracking TODO state changes:: When did the status change? * Clocking work time:: When exactly did you work on this item? -Tags - -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags - Agenda Views * Agenda files:: Files being searched for agenda information @@ -215,7 +230,7 @@ The built-in agenda views * Weekly/Daily agenda:: The calendar page with current tasks * Global TODO list:: All unfinished action items -* Matching headline tags:: Structured information with fine-tuned search +* Matching tags and properties:: Structured information with fine-tuned search * Timeline:: Time-sorted view for single file * Stuck projects:: Find projects you need to review @@ -308,6 +323,7 @@ Extensions, Hooks and Hacking * Tables in arbitrary syntax:: Orgtbl for LaTeX and other programs * Dynamic blocks:: Automatically filled blocks * Special agenda views:: Customized views +* Using the property API:: Writing programs that use entry properties Tables in arbitrary syntax @@ -333,7 +349,7 @@ Tables in arbitrary syntax @section Summary @cindex summary -Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing +Org-mode is a mode for keeping notes, maintaining TODO lists, and doing project planning with a fast and effective plain-text system. Org-mode develops organizational tasks around NOTES files that contain @@ -341,7 +357,7 @@ lists or information about projects as plain text. Org-mode is implemented on top of outline-mode, which makes it possible to keep the content of large files well structured. Visibility cycling and structure editing help to work with the tree. Tables are easily created -with a built-in table editor. Org-mode supports ToDo items, deadlines, +with a built-in table editor. Org-mode supports TODO items, deadlines, time stamps, and scheduling. It dynamically compiles entries into an agenda that utilizes and smoothly integrates much of the Emacs calendar and diary. Plain text URL-like links connect to websites, emails, @@ -564,6 +580,7 @@ edit the structure of the document. * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context * Plain lists:: Additional structure within an entry +* Drawers:: @end menu @node Outlines, Headlines, Document structure, Document structure @@ -991,7 +1008,7 @@ XEmacs uses selective display for outlining, not text properties.}. Or you can use the command @kbd{C-c C-e v} to export only the visible part of the document and print the resulting file. -@node Plain lists, , Sparse trees, Document structure +@node Plain lists, Drawers, Sparse trees, Document structure @section Plain lists @cindex plain lists @cindex lists, plain @@ -1017,9 +1034,9 @@ 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 emtpy line to +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 for example: +@code{org-empty-line-terminates-plain-lists}. Here is an example: @example @group @@ -1040,10 +1057,7 @@ Org-mode supports these lists by tuning filling and wrapping commands to deal with them correctly@footnote{Org-mode only changes the filling settings for Emacs. For XEmacs, you should use Kyle E. Jones' @file{filladapt.el}. To turn this on, put into @file{.emacs}: -@example -(require 'filladapt) -@end example -}. +@code{(require 'filladapt)}}. The following commands act on items when the cursor is in the first line of an item (the line with the bullet or number). @@ -1056,6 +1070,9 @@ Items can be folded just like headline levels if you set the variable 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 curent line in a heuristic way. @kindex M-@key{RET} @item M-@key{RET} Insert new item at current level. With prefix arg, force a new heading @@ -1094,10 +1111,40 @@ the command chain with a cursor motion or so. @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. Otherwise, if this is an ordered list, renumber -the ordered list at the cursor. +state of the checkbox. If not, make 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. +@kindex C-c - +@item C-c - +Cycle the entire list level through the different itemize/enumerate +bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}). +With prefix arg, select the nth bullet from this list. @end table +@node Drawers, , Plain lists, Document structure +@section Drawers +@cindex drawers + +Sometimes you want to keep information associated with an entry, but you +normally don't want to see it, except when explicitly asking for it. +For this, Org-mode has @emph{drawers}. Drawers need to be configured +with the variable @code{org-drawers}, and look like this: + +@example +** This is a headline + Still outside the drawer + :DRAWERNAME: + This is inside the drawer. + :END: + After the drawer. +@end example + +Visibility cycling (@pxref{Visibility cycling}) on the headline will +hide and show the entry, but keep the drawer collapsed to a single line. +In order to look inside the drawer, you need to move the cursor to the +drawer line and press @key{TAB} there. Org-mode uses a drawer for +storing properties (@pxref{Properties}). + @node Tables, Hyperlinks, Document structure, Top @chapter Tables @cindex tables @@ -1556,12 +1603,23 @@ see the @samp{E} mode switch below). If there are no non-empty fields, @samp{$name} is interpreted as the name of a column, parameter or constant. Constants are defined globally through the variable -@code{org-table-formula-constants}. If you have the @file{constants.el} -package, it will also be used to resolve constants, including natural -constants like @samp{$h} for Planck's constant, and units like -@samp{$km} for kilometers@footnote{@file{Constant.el} can supply the -values of constants in two different unit systems, @code{SI} and -@code{cgs}. Which one is used depends on the value of the variable +@code{org-table-formula-constants}, and locally (for the file) through a +line like + +@example +#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6 +@end example + +@noindent +Also properties (@pxref{Properties}) can be used as constants in table +formulas: For a property @samp{:XYZ:} use the name @samp{$PROP_XYZ}, and +the property will be searched in the current outline entry and in the +hierarchy above it. If you have the @file{constants.el} package, it +will also be used to resolve constants, including natural constants like +@samp{$h} for Planck's constant, and units like @samp{$km} for +kilometers@footnote{@file{Constant.el} can supply the values of +constants in two different unit systems, @code{SI} and @code{cgs}. +Which one is used depends on the value of the variable @code{constants-unit-system}. You can use the @code{#+STARTUP} options @code{constSI} and @code{constcgs} to set this value for the current buffer.}. Column names and parameters can be specified in special table @@ -1641,12 +1699,18 @@ functionality is not enough. If a formula starts with a single quote followed by an opening parenthesis, then it is evaluated as a lisp form. The evaluation should return either a string or a number. Just as with @file{calc} formulas, you can specify modes and a printf format after a -semicolon. A reference will be replaced with a string (in double -quotes) containing the field. If you provide the @samp{N} mode switch, -all referenced elements will be numbers. Ranges are inserted as -space-separated fields, so you can embed them in list or vector syntax. -A few examples, note how the @samp{N} mode is used when we do -computations in lisp. +semicolon. With Emacs Lisp forms, you need to be concious about the way +field references are interpolated into the form. By default, a +reference will be interpolated as a Lisp string (in double quotes) +containing the field. If you provide the @samp{N} mode switch, all +referenced elements will be numbers (non-number fields will be zero) and +interpolated as Lisp numbers, without quotes. If you provide the +@samp{L} flag, all fields will be interpolated literally, without quotes. +I.e., if you want a reference to be interpreted as a string by the Lisp +form, enclode the reference operator itself in double quotes, like +@code{"$3"}. Ranges are inserted as space-separated fields, so you can +embed them in list or vector syntax. A few examples, note how the +@samp{N} mode is used when we do computations in lisp. @example @r{Swap the first two characters of the content of column 1} @@ -2042,8 +2106,8 @@ convenient to put them into a comment line. For example @noindent In HTML export (@pxref{HTML export}), such targets will become named anchors for direct access through @samp{http} links@footnote{Note -that text before the first headline will never be exported, so the first -such target must be after the first headline.}. +that text before the first headline is usually not exported, so the +first such target should be after the first headline.}. If no dedicated target exists, Org-mode will search for the words in the link. In the above example the search would be for @samp{my target}. @@ -2504,6 +2568,8 @@ insertion of content: %a @r{annotation, normally the link created with @code{org-store-link}} %i @r{initial content, the region when remember is called with C-u.} @r{The entire text will be indented like @code{%i} itself.} +%^g @r{prompt for tags, with completion on tags in target file.} +%^G @r{prompt for tags, with completion all tags in all agenda files.} %:keyword @r{specific information for certain link types, see below} @end example @@ -2581,7 +2647,7 @@ non-nil, the entire text is also indented so that it starts in the same column as the headline (after the asterisks). -@node TODO items, Timestamps, Hyperlinks, Top +@node TODO items, Tags, Hyperlinks, Top @chapter TODO items @cindex TODO items @@ -2656,6 +2722,9 @@ the TODO entries directly from that buffer (@pxref{Agenda commands}). @c @item @code{org-agenda-include-all-todo} @c If you would like to have all your TODO items listed as part of your @c agenda, customize the variable @code{org-agenda-include-all-todo}. +@kindex S-M-@key{RET} +@item S-M-@key{RET} +Insert a new TODO entry below the current one. @end table @node TODO extensions, Priorities, TODO basics, TODO items @@ -2960,7 +3029,472 @@ delete boxes or add/change them by hand, use this command to get things back into synch. Or simply toggle any checkbox twice with @kbd{C-c C-c}. @end table -@node Timestamps, Tags, TODO items, Top + +@node Tags, Properties, TODO items, Top +@chapter Tags +@cindex tags +@cindex headline tagging +@cindex matching, tags +@cindex sparse tree, tag based + +If you wish to implement a system of labels and contexts for +cross-correlating information, an excellent way is to assign @i{tags} to +headlines. Org-mode has extensive support for using tags. + +Every headline can contain a list of tags, at the end of the headline. +Tags are normal words containing letters, numbers, @samp{_}, and +@samp{@@}. Tags must be preceded and followed by a single colon; like +@samp{:WORK:}. Several tags can be specified like @samp{:WORK:URGENT:}. + +@menu +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags +@end menu + +@node Tag inheritance, Setting tags, Tags, Tags +@section Tag inheritance +@cindex inheritance, of tags +@cindex sublevels, inclusion into tags match + +@i{Tags} make use of the hierarchical structure of outline trees. If a +heading has a certain tag, all subheadings will inherit the tag as +well. For example, in the list + +@example +* Meeting with the French group :WORK: +** Summary by Frank :BOSS:NOTES: +*** TODO Prepare slides for him :ACTION: +@end example + +@noindent +the final heading will have the tags @samp{:WORK:}, @samp{:BOSS:}, +@samp{:NOTES:}, and @samp{:ACTION:}. When executing tag searches and +Org-mode finds that a certain headline matches the search criterion, it +will not check any sublevel headline, assuming that these likely also +match, and that the list of matches can become very long. This may +not be what you want, however, and you can influence inheritance and +searching using the variables @code{org-use-tag-inheritance} and +@code{org-tags-match-list-sublevels}. + +@node Setting tags, Tag searches, Tag inheritance, Tags +@section Setting tags +@cindex setting tags +@cindex tags, setting + +@kindex M-@key{TAB} +Tags can simply be typed into the buffer at the end of a headline. +After a colon, @kbd{M-@key{TAB}} offers completion on tags. There is +also a special command for inserting tags: + +@table @kbd +@kindex C-c C-c +@item C-c C-c +@cindex completion, of tags +Enter new tags for the current headline. Org-mode will either offer +completion or a special single-key interface for setting tags, see +below. After pressing @key{RET}, the tags will be inserted and aligned +to @code{org-tags-column}. When called with a @kbd{C-u} prefix, all +tags in the current buffer will be aligned to that column, just to make +things look nice. TAGS are automatically realigned after promotion, +demotion, and TODO state changes (@pxref{TODO basics}). +@end table + +Org will support tag insertion based on a @emph{list of tags}. By +default this list is constructed dynamically, containing all tags +currently used in the buffer. You may also globally specify a hard list +of tags with the variable @code{org-tag-alist}. Finally you can set +the default tags for a given file with lines like + +@example +#+TAGS: @@WORK @@HOME @@TENNISCLUB +#+TAGS: Laptop Car PC Sailboat +@end example + +If you have globally defined your preferred set of tags using the +variable @code{org-tag-alist}, but would like to use a dynamic tag list +in a specific file: Just add an empty TAGS option line to that file: + +@example +#+TAGS: +@end example + +The default support method for entering tags is minibuffer completion. +However, Org-mode also implements a much better method: @emph{fast tag +selection}. This method allows to select and deselect tags with a +single key per tag. To function efficiently, you should assign unique +keys to most tags. This can be done globally with + +@lisp +(setq org-tag-alist '(("@@WORK" . ?w) ("@@HOME" . ?h) ("Laptop" . ?l))) +@end lisp + +@noindent or on a per-file basis with + +@example +#+TAGS: @@WORK(w) @@HOME(h) @@TENNISCLUB(t) Laptop(l) PC(p) +@end example + +@noindent +You can also group together tags that are mutually exclusive. With +curly braces@footnote{In @code{org-mode-alist} use +@code{'(:startgroup)} and @code{'(:endgroup)}, respectively. Several +groups are allowed.} + +@example +#+TAGS: @{ @@WORK(w) @@HOME(h) @@TENNISCLUB(t) @} Laptop(l) PC(p) +@end example + +@noindent you indicate that at most one of @samp{@@WORK}, @samp{@@HOME}, +and @samp{@@TENNISCLUB} should be selected. + +@noindent Don't forget to press @kbd{C-c C-c} with the cursor in one of +these lines to activate any changes. + +If at least one tag has a selection key, pressing @kbd{C-c C-c} will +automatically present you with a special interface, listing inherited +tags, the tags of the current headline, and a list of all legal tags +with corresponding keys@footnote{Keys will automatically be assigned to +tags which have no configured keys.}. In this interface, you can use +the following keys: + +@table @kbd +@item a-z... +Pressing keys assigned to tags will add or remove them from the list of +tags in the current line. Selecting a tag in a group of mutually +exclusive tags will turn off any other tags from that group. +@kindex @key{TAB} +@item @key{TAB} +Enter a tag in the minibuffer, even if the tag is not in the predefined +list. You will be able to complete on all tags present in the buffer. +@kindex @key{SPC} +@item @key{SPC} +Clear all tags for this line. +@kindex @key{RET} +@item @key{RET} +Accept the modified set. +@item C-g +Abort without installing changes. +@item q +If @kbd{q} is not assigned to a tag, it aborts like @kbd{C-g}. +@item ! +Turn off groups of mutually exclusive tags. Use this to (as an +exception) assign several tags from such a group. +@item C-c +Toggle auto-exit after the next change (see below). +If you are using expert mode, the first @kbd{C-c} will display the +selection window. +@end table + +@noindent +This method lets you assign tags to a headline with very few keys. With +the above setup, you could clear the current tags and set @samp{@@HOME}, +@samp{Laptop} and @samp{PC} tags with just the following keys: @kbd{C-c +C-c @key{SPC} h l p @key{RET}}. Switching from @samp{@@HOME} to +@samp{@@WORK} would be done with @kbd{C-c C-c w @key{RET}} or +alternatively with @kbd{C-c C-c C-c w}. Adding the non-predefined tag +@samp{Sarah} could be done with @kbd{C-c C-c @key{TAB} S a r a h +@key{RET} @key{RET}}. + +If you find that most of the time, you need only a single keypress to +modify your list of tags, set the variable +@code{org-fast-tag-selection-single-key}. Then you no longer have to +press @key{RET} to exit fast tag selection - it will immediately exit +after the first change. If you then occasionally need more keys, press +@kbd{C-c} to turn off auto-exit for the current tag selection process +(in effect: start selection with @kbd{C-c C-c C-c} instead of @kbd{C-c +C-c}). If you set the variable to the value @code{expert}, the special +window is not even shown for single-key tag selection, it comes up only +when you press an extra @kbd{C-c}. + +@node Tag searches, , Setting tags, Tags +@section Tag searches +@cindex tag searches +@cindex searching for tags + +Once a tags system has been set up, it can be used to collect related +information into special lists. + +@table @kbd +@kindex C-c \ +@item C-c \ +Create a sparse tree with all headlines matching a tags search. With a +@kbd{C-u} prefix argument, ignore headlines that are not a TODO line. +@kindex C-c a m +@item C-c a m +Create a global list of tag matches from all agenda files. +@xref{Matching tags and properties}. +@kindex C-c a M +@item C-c a M +Create a global list of tag matches from all agenda files, but check +only TODO items and force checking subitems (see variable +@code{org-tags-match-list-sublevels}). +@end table + +@cindex Boolean logic, for tag searches +A @i{tags} search string can use Boolean operators @samp{&} for AND and +@samp{|} for OR. @samp{&} binds more strongly than @samp{|}. +Parenthesis are currently not implemented. A tag may also be preceded +by @samp{-}, to select against it, and @samp{+} is syntactic sugar for +positive selection. The AND operator @samp{&} is optional when @samp{+} +or @samp{-} is present. Examples: + +@table @samp +@item +WORK-BOSS +Select headlines tagged @samp{:WORK:}, but discard those also tagged +@samp{:BOSS:}. +@item WORK|LAPTOP +Selects lines tagged @samp{:WORK:} or @samp{:LAPTOP:}. +@item WORK|LAPTOP&NIGHT +Like before, but require the @samp{:LAPTOP:} lines to be tagged also +@samp{NIGHT}. +@end table + +@cindex TODO keyword matching, with tags search +If you are using multi-state TODO keywords (@pxref{TODO extensions}), it +can be useful to also match on the TODO keyword. This can be done by +adding a condition after a slash to a tags match. The syntax is similar +to the tag matches, but should be applied with consideration: For +example, a positive selection on several TODO keywords can not +meaningfully be combined with boolean AND. However, @emph{negative +selection} combined with AND can be meaningful. To make sure that only +lines are checked that actually have any TODO keyword, use @kbd{C-c a +M}, or equivalently start the todo part after the slash with @samp{!}. +Examples: + +@table @samp +@item WORK/WAITING +Select @samp{:WORK:}-tagged TODO lines with the specific TODO +keyword @samp{WAITING}. +@item WORK/!-WAITING-NEXT +Select @samp{:WORK:}-tagged TODO lines that are neither @samp{WAITING} +nor @samp{NEXT} +@item WORK/+WAITING|+NEXT +Select @samp{:WORK:}-tagged TODO lines that are either @samp{WAITING} or +@samp{NEXT}. +@end table + +@cindex regular expressions, with tags search +Any element of the tag/todo match can be a regular expression - in this +case it must be enclosed in curly braces. For example, +@samp{WORK+@{^BOSS.*@}} matches headlines that contain the tag +@samp{WORK} and any tag @i{starting} with @samp{BOSS}. + +@cindex level, require for tags match +You can also require a headline to be of a certain level, by writing +instead of any TAG an expression like @samp{LEVEL=3}. For example, a +search @samp{+LEVEL=3+BOSS/-DONE} lists all level three headlines that +have the tag BOSS and are @emph{not} marked with the todo keyword DONE. + +@node Properties, Timestamps, Tags, Top +@chapter Properties +@cindex properties + +Properties are a set of key-value pairs associated with an entry. There +are two main applications for properties in Org-mode. First, properties +are like tags, but with a value. For example, in a file where you +document bugs and plan releases of a piece of software, instead of using +tags like @code{:release_1:}, @code{:release_2:}, it can be more +efficient to use a property @code{RELEASE} with a value @code{1.0} or +@code{2.0}. Second, you can use properties to implement (very basic) +database capabilities in an Org-mode buffer, for example to create a +list of Music CD's you own. + +@menu +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers +@end menu + +@node Property syntax, Special properties, Properties, Properties +@section Property Syntax + +Properties are key-value pairs. They need to be inserted into a special +drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property +is specified on a single line, with the key (surrounded by colons) +first, and the value after it. Here is an example: + +@example +* CD collection +** Classic +*** Goldberg Variations + :PROPERTIES: + :Title: Goldberg Variations + :Composer: J.S. Bach + :Artist: Glen Gould + :END: +@end example + +@noindent +The following commands help to insert properties: + +@table @kbd +@kindex M-@key{TAB} +@item M-@key{TAB} +After an initial colon in a line, complete property keys. All keys used +in the current file will be offered as possible completions. +@end table + + + +@node Special properties, Property searches, Property syntax, Properties +@section Special Properties + +Several properties are special, because they can be used to access other +features of Org-mode like the TODO status: + +@example +TODO @r{The TODO keyword of the entry.} +TAGS @r{The tags defined directly in the headline.} +ALLTAGS @r{All tags, including inherited ones.} +PRIORITY @r{The priority of the entry, a string with a single letter.} +DEADLINE @r{The deadline time string, without the angular brackets.} +SCHEDULED @r{The scheduling time stamp, without the angular brackets.} +@end example + +@node Property searches, Column view, Special properties, Properties +@section Property searches + +To create sparse trees and special lists with selection based on +properties, the same commands are used as for tag searches (@pxref{Tag +searches}), and the same logic applies. For example, a search string + +@example ++WORK-BOSS+PRIORITY="A"+coffee="unlimited"+with=@{Sarah\|Denny@} +@end example + +@noindent +finds entries tagged @samp{:WORK:} but not @samp{:BOSS:}, which +also have a priority value @samp{A}, a @samp{:coffee:} property with the +value @samp{unlimited}, and a @samp{:with:} property that is matched by +the regular expression @samp{Sarah\|Denny}. + +@node Column view, Property API, Property searches, Properties +@section Column View + +If different items in a document have similar properties, it can be nice +to view and edit those properties in a table-like format, in +@emph{column view}. Org-mode implements columns by overlaying a tabular +structure over the headline of an item. So the column view does not use +a special buffer, it happens in exactly the same buffer where the +outline is, and only temporarily changes the look of this buffer - not +the content. This has the advantage that you can still change the +visibility of the outline tree. For example, you get a compact table by +switching to CONTENTS view, but you can still open, read, and edit the +entry below each headline. Or, you can switch to column view after +executing a sparse tree command and in this way get a table only for the +selected items. Column view also works in agenda buffers (@pxref{Agenda +views}) where queries have collected selected items, possibly from a +number of files. + +@menu +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +@end menu + +@node Defining columns, Using column view, Column view, Column view +@subsection Defining Columns + +Setting up a column view first requires defining the columns. A column +definition is a property itself and looks like this: + +@example +:COLUMNS: %25ITEM %TAGS %PRIORITY %TODO +@end example + +This definition means that column 1 should be the first 25 characters of +the item itself, i.e. of the headline. You probably always should start +the column definition with the ITEM specifier - just select a useful +width for it. The other specifiers create columns for the local tags, +for the priority and for the TODO state. When no width is given after +the @samp{%} character, the column will be exactly as wide as it need to +be in order to fully display all values. + +If a @code{COLUMNS} property is present in an entry, it defines +columns for the entry itself, and for the entire subtree below it. +Since the column definition is part of the hierarchical structure of the +document, you can define columns on level 1 that are general enough for +all sublevels, and more specific columns further down, when you edit a deeper +part of the tree. Here is an example: + +@example +* People + :PROPERTIES: + :COLUMNS: %25ITEM %Name + :END: +** Family + :PROPERTIES: + :COLUMNS: %25ITEM %Name %3Age + :END: +*** Sam + Info about Sam, including a property list with Name and Age. +*** Sarah + Info about Sarah, including a property list with Name and Age. +** Office + :PROPERTIES: + :COLUMNS: %25ITEM %Name %Function %Salary + :END: +*** Boss + Info about the Boss, including a property list with Name, + Function and Salary (if only we knew....). +@end example + +Now we have defined three different sets of columns. If you switch to +column view in the @emph{Family} section, you will get a different table +than if you do it in the @emph{Office} section. However, if you switch +to column view with the cursor on the @emph{People} section, the table +will cover all entries, but contain only the @emph{Name} column. + +If no COLUMNS property applies to a given location, Org-mode uses a +default format specified in the variable +@code{org-default-columns-format}. This format in particular also +applies when column view is invoked with the cursor before the first +headline. You can set the default format on a per-file basis with a +line (don't forget to press @kbd{C-c C-c} to activate any changes to +this line). + +@example +#+COLUMNS: %25ITEM ....." +@end example + +@node Using column view, , Defining columns, Column view +@subsection Using Column View + +@table @kbd +@kindex C-c C-x C-c +@item C-c C-x C-c +Create the column view for the local environment. This command searches +the hierarchy, up from point, for a @code{COLUMNS} property that defines +a format. When one is found, the column view table is established for +the entire subtree. +@item @key{left} @key{right} @key{up} @key{down} +Move through the column view from field to field. +@kindex e +@item e +Edit the property at point. For the special properties, this will +invoke the same interface that you normally use to change that +property. For example, when editing a TAGS property, the tag completion +or fast selection interface will pop up. +@kindex v +@item v +View the full value of this property. This is useful if the width of +the column is smaller than that of the value. +@kindex q +@item q +Exit column view. +@end table + +@node Property API, , Column view, Properties +@section The Property API + +There is a full API for accessing and changing properties. This API can +be used by Emacs Lisp programs to work with properties and to implement +features based on them. For more information see @ref{Using the +property API}. + +@node Timestamps, Agenda views, Properties, Top @chapter Timestamps @cindex time stamps @cindex date stamps @@ -2984,12 +3518,13 @@ planning. @cindex deadlines @cindex scheduling -A time stamp is a specification of a date (possibly with time) in a -special format, either @samp{<2003-09-16 Tue>} or @samp{<2003-09-16 Tue -09:39>}@footnote{This is the standard ISO date/time format. If you -cannot get used to these, see @ref{Custom time format}}. A time stamp -can appear anywhere in the headline or body of an org-tree entry. Its -presence causes entries to be shown on specific dates in the agenda +A time stamp is a specification of a date (possibly with time or a range +of times) in a special format, either @samp{<2003-09-16 Tue>} or +@samp{<2003-09-16 Tue 09:39>} or @samp{<2003-09-16 Tue +12:00-12:30>}@footnote{This is the standard ISO date/time format. If +you cannot get used to these, see @ref{Custom time format}}. A time +stamp can appear anywhere in the headline or body of an org-tree entry. +Its presence causes entries to be shown on specific dates in the agenda (@pxref{Weekly/Daily agenda}). We distinguish: @table @var @@ -3003,6 +3538,7 @@ associated with a plain time stamp will be shown exactly on that date. @example * Meet Peter at the movies <2006-11-01 Wed 19:15> +* Discussion on climate change <2006-11-02 Thu 20:00-22:00> @end example @item Time stamp with repeater interval @@ -3227,6 +3763,9 @@ the stamp, @kbd{S-@key{up}/@key{down}} will change the stamp by one day, just like @kbd{S-@key{left}/@key{right}}. At the end of the stamp, the time will be changed by one minute. @item +If the time stamp contains a range of clock times or a repeater, these +will not be overlayed, but remain in the buffer as they were. +@item When you delete a time stamp character-by-character, it will only disappear from the buffer after @emph{all} (invisible) characters belonging to the ISO timestamp have been removed. @@ -3508,263 +4047,7 @@ The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in the agenda (@pxref{Weekly/Daily agenda}) to show which tasks have been worked on or closed during a day. -@node Tags, Agenda views, Timestamps, Top -@chapter Tags -@cindex tags -@cindex headline tagging -@cindex matching, tags -@cindex sparse tree, tag based - -If you wish to implement a system of labels and contexts for -cross-correlating information, an excellent way is to assign @i{tags} to -headlines. Org-mode has extensive support for using tags. - -Every headline can contain a list of tags, at the end of the headline. -Tags are normal words containing letters, numbers, @samp{_}, and -@samp{@@}. Tags must be preceded and followed by a single colon; like -@samp{:WORK:}. Several tags can be specified like @samp{:WORK:URGENT:}. - -@menu -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags -@end menu - -@node Tag inheritance, Setting tags, Tags, Tags -@section Tag inheritance -@cindex inheritance, of tags -@cindex sublevels, inclusion into tags match - -@i{Tags} make use of the hierarchical structure of outline trees. If a -heading has a certain tag, all subheadings will inherit the tag as -well. For example, in the list - -@example -* Meeting with the French group :WORK: -** Summary by Frank :BOSS:NOTES: -*** TODO Prepare slides for him :ACTION: -@end example - -@noindent -the final heading will have the tags @samp{:WORK:}, @samp{:BOSS:}, -@samp{:NOTES:}, and @samp{:ACTION:}. When executing tag searches and -Org-mode finds that a certain headline matches the search criterion, it -will not check any sublevel headline, assuming that these likely also -match, and that the list of matches can become very long. This may -not be what you want, however, and you can influence inheritance and -searching using the variables @code{org-use-tag-inheritance} and -@code{org-tags-match-list-sublevels}. - -@node Setting tags, Tag searches, Tag inheritance, Tags -@section Setting tags -@cindex setting tags -@cindex tags, setting - -@kindex M-@key{TAB} -Tags can simply be typed into the buffer at the end of a headline. -After a colon, @kbd{M-@key{TAB}} offers completion on tags. There is -also a special command for inserting tags: - -@table @kbd -@kindex C-c C-c -@item C-c C-c -@cindex completion, of tags -Enter new tags for the current headline. Org-mode will either offer -completion or a special single-key interface for setting tags, see -below. After pressing @key{RET}, the tags will be inserted and aligned -to @code{org-tags-column}. When called with a @kbd{C-u} prefix, all -tags in the current buffer will be aligned to that column, just to make -things look nice. TAGS are automatically realigned after promotion, -demotion, and TODO state changes (@pxref{TODO basics}). -@end table - -Org will support tag insertion based on a @emph{list of tags}. By -default this list is constructed dynamically, containing all tags -currently used in the buffer. You may also globally specify a hard list -of tags with the variable @code{org-tag-alist}. Finally you can set -the default tags for a given file with lines like - -@example -#+TAGS: @@WORK @@HOME @@TENNISCLUB -#+TAGS: Laptop Car PC Sailboat -@end example - -If you have globally defined your preferred set of tags using the -variable @code{org-tag-alist}, but would like to use a dynamic tag list -in a specific file: Just add an empty TAGS option line to that file: - -@example -#+TAGS: -@end example - -The default support method for entering tags is minibuffer completion. -However, Org-mode also implements a much better method: @emph{fast tag -selection}. This method allows to select and deselect tags with a -single key per tag. To function efficiently, you should assign unique -keys to most tags. This can be done globally with - -@lisp -(setq org-tag-alist '(("@@WORK" . ?w) ("@@HOME" . ?h) ("Laptop" . ?l))) -@end lisp - -@noindent or on a per-file basis with - -@example -#+TAGS: @@WORK(w) @@HOME(h) @@TENNISCLUB(t) Laptop(l) PC(p) -@end example - -@noindent -You can also group together tags that are mutually exclusive. With -curly braces@footnote{In @code{org-mode-alist} use -@code{'(:startgroup)} and @code{'(:endgroup)}, respectively. Several -groups are allowed.} - -@example -#+TAGS: @{ @@WORK(w) @@HOME(h) @@TENNISCLUB(t) @} Laptop(l) PC(p) -@end example - -@noindent you indicate that at most one of @samp{@@WORK}, @samp{@@HOME}, -and @samp{@@TENNISCLUB} should be selected. - -@noindent Don't forget to press @kbd{C-c C-c} with the cursor in one of -these lines to activate any changes. - -If at least one tag has a selection key, pressing @kbd{C-c C-c} will -automatically present you with a special interface, listing inherited -tags, the tags of the current headline, and a list of all legal tags -with corresponding keys@footnote{Keys will automatically be assigned to -tags which have no configured keys.}. In this interface, you can use -the following keys: - -@table @kbd -@item a-z... -Pressing keys assigned to tags will add or remove them from the list of -tags in the current line. Selecting a tag in a group of mutually -exclusive tags will turn off any other tags from that group. -@kindex @key{TAB} -@item @key{TAB} -Enter a tag in the minibuffer, even if the tag is not in the predefined -list. You will be able to complete on all tags present in the buffer. -@kindex @key{SPC} -@item @key{SPC} -Clear all tags for this line. -@kindex @key{RET} -@item @key{RET} -Accept the modified set. -@item C-g -Abort without installing changes. -@item q -If @kbd{q} is not assigned to a tag, it aborts like @kbd{C-g}. -@item ! -Turn off groups of mutually exclusive tags. Use this to (as an -exception) assign several tags from such a group. -@item C-c -Toggle auto-exit after the next change (see below). -If you are using expert mode, the first @kbd{C-c} will display the -selection window. -@end table - -@noindent -This method lets you assign tags to a headline with very few keys. With -the above setup, you could clear the current tags and set @samp{@@HOME}, -@samp{Laptop} and @samp{PC} tags with just the following keys: @kbd{C-c -C-c @key{SPC} h l p @key{RET}}. Switching from @samp{@@HOME} to -@samp{@@WORK} would be done with @kbd{C-c C-c w @key{RET}} or -alternatively with @kbd{C-c C-c C-c w}. Adding the non-predefined tag -@samp{Sarah} could be done with @kbd{C-c C-c @key{TAB} S a r a h -@key{RET} @key{RET}}. - -If you find that most of the time, you need only a single keypress to -modify your list of tags, set the variable -@code{org-fast-tag-selection-single-key}. Then you no longer have to -press @key{RET} to exit fast tag selection - it will immediately exit -after the first change. If you then occasionally need more keys, press -@kbd{C-c} to turn off auto-exit for the current tag selection process -(in effect: start selection with @kbd{C-c C-c C-c} instead of @kbd{C-c -C-c}). If you set the variable to the value @code{expert}, the special -window is not even shown for single-key tag selection, it comes up only -when you press an extra @kbd{C-c}. - -@node Tag searches, , Setting tags, Tags -@section Tag searches -@cindex tag searches -@cindex searching for tags - -Once a tags system has been set up, it can be used to collect related -information into special lists. - -@table @kbd -@kindex C-c \ -@item C-c \ -Create a sparse tree with all headlines matching a tags search. With a -@kbd{C-u} prefix argument, ignore headlines that are not a TODO line. -@kindex C-c a m -@item C-c a m -Create a global list of tag matches from all agenda files. -@xref{Matching headline tags}. -@kindex C-c a M -@item C-c a M -Create a global list of tag matches from all agenda files, but check -only TODO items and force checking subitems (see variable -@code{org-tags-match-list-sublevels}). -@end table - -@cindex Boolean logic, for tag searches -A @i{tags} search string can use Boolean operators @samp{&} for AND and -@samp{|} for OR. @samp{&} binds more strongly than @samp{|}. -Parenthesis are currently not implemented. A tag may also be preceded -by @samp{-}, to select against it, and @samp{+} is syntactic sugar for -positive selection. The AND operator @samp{&} is optional when @samp{+} -or @samp{-} is present. Examples: - -@table @samp -@item +WORK-BOSS -Select headlines tagged @samp{:WORK:}, but discard those also tagged -@samp{:BOSS:}. -@item WORK|LAPTOP -Selects lines tagged @samp{:WORK:} or @samp{:LAPTOP:}. -@item WORK|LAPTOP&NIGHT -Like before, but require the @samp{:LAPTOP:} lines to be tagged also -@samp{NIGHT}. -@end table - -@cindex TODO keyword matching, with tags search -If you are using multi-state TODO keywords (@pxref{TODO extensions}), it -can be useful to also match on the TODO keyword. This can be done by -adding a condition after a slash to a tags match. The syntax is similar -to the tag matches, but should be applied with consideration: For -example, a positive selection on several TODO keywords can not -meaningfully be combined with boolean AND. However, @emph{negative -selection} combined with AND can be meaningful. To make sure that only -lines are checked that actually have any TODO keyword, use @kbd{C-c a -M}, or equivalently start the todo part after the slash with @samp{!}. -Examples: - -@table @samp -@item WORK/WAITING -Select @samp{:WORK:}-tagged TODO lines with the specific TODO -keyword @samp{WAITING}. -@item WORK/!-WAITING-NEXT -Select @samp{:WORK:}-tagged TODO lines that are neither @samp{WAITING} -nor @samp{NEXT} -@item WORK/+WAITING|+NEXT -Select @samp{:WORK:}-tagged TODO lines that are either @samp{WAITING} or -@samp{NEXT}. -@end table - -@cindex regular expressions, with tags search -Any element of the tag/todo match can be a regular expression - in this -case it must be enclosed in curly braces. For example, -@samp{WORK+@{^BOSS.*@}} matches headlines that contain the tag -@samp{WORK} and any tag @i{starting} with @samp{BOSS}. - -@cindex level, require for tags match -You can also require a headline to be of a certain level, by writing -instead of any TAG an expression like @samp{LEVEL=3}. For example, a -search @samp{+LEVEL=3+BOSS/-DONE} lists all level three headlines that -have the tag BOSS and are @emph{not} marked with the todo keyword DONE. - -@node Agenda views, Embedded LaTeX, Tags, Top +@node Agenda views, Embedded LaTeX, Timestamps, Top @chapter Agenda Views @cindex agenda views @@ -3872,7 +4155,7 @@ Create the calendar-like agenda (@pxref{Weekly/Daily agenda}). Create a list of all TODO items (@pxref{Global TODO list}). @item m @r{/} M Create a list of headlines matching a TAGS expression (@pxref{Matching -headline tags}). +tags and properties}). @item L Create the timeline view for the current buffer (@pxref{Timeline}). @item # @r{/} ! @@ -3901,7 +4184,7 @@ In this section we describe the built-in views. @menu * Weekly/Daily agenda:: The calendar page with current tasks * Global TODO list:: All unfinished action items -* Matching headline tags:: Structured information with fine-tuned search +* Matching tags and properties:: Structured information with fine-tuned search * Timeline:: Time-sorted view for single file * Stuck projects:: Find projects you need to review @end menu @@ -3975,11 +4258,11 @@ will be made in the agenda: #+CATEGORY: Holiday %%(org-calendar-holiday) ; special function for holiday names #+CATEGORY: Ann -%%(diary-anniversary 14 5 1956) Artur Dent %d is years old +%%(diary-anniversary 14 5 1956) Arthur Dent is %d years old %%(diary-anniversary 2 10 1869) Mahatma Gandhi would be %d years old @end example -@node Global TODO list, Matching headline tags, Weekly/Daily agenda, Built-in agenda views +@node Global TODO list, Matching tags and properties, Weekly/Daily agenda, Built-in agenda views @subsection The global TODO list @cindex global TODO list @cindex TODO list, global @@ -4033,9 +4316,10 @@ and omit the sublevels from the global list. Configure the variable @code{org-agenda-todo-list-sublevels} to get this behavior. @end itemize -@node Matching headline tags, Timeline, Global TODO list, Built-in agenda views -@subsection Matching headline tags +@node Matching tags and properties, Timeline, Global TODO list, Built-in agenda views +@subsection Matching Tags and Properties @cindex matching, of tags +@cindex matching, of properties @cindex tags view If headlines in the agenda files are marked with @emph{tags} @@ -4061,7 +4345,7 @@ together with a tags match is also possible, see @ref{Tag searches}. The commands available in the tags list are described in @ref{Agenda commands}. -@node Timeline, Stuck projects, Matching headline tags, Built-in agenda views +@node Timeline, Stuck projects, Matching tags and properties, Built-in agenda views @subsection Timeline for a single file @cindex timeline, single file @cindex time-sorted view @@ -4315,13 +4599,12 @@ as are entries that have been clocked on that day. @item o Delete other windows. @c -@kindex w -@item w -Switch to weekly view (7 days displayed together). -@c @kindex d -@item d -Switch to daily view (just one day displayed). +@kindex w +@kindex m +@kindex y +@item d w m y +Switch to day/week/month/year view. @c @kindex D @item D @@ -5578,8 +5861,8 @@ separator line will be formatted as table header fields. @item If a headline starts with the word @samp{QUOTE}, the text below the headline will be typeset as fixed-width, to allow quoting of computer -codes etc. Lines starting with @samp{:} are also typeset in -fixed-width font. +codes etc. Lines starting with @samp{:} are also typeset in fixed-width +font. @table @kbd @kindex C-c : @item C-c : @@ -5624,7 +5907,7 @@ Insert template with export options, see example below. #+LANGUAGE: language for HTML, e.g. @samp{en} (@code{org-export-default-language}) #+TEXT: Some descriptive text to be inserted at the beginning. #+TEXT: Several lines may be given. -#+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t *:nil TeX:t LaTeX:t skip:t +#+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t *:nil TeX:t LaTeX:t skip:t @end example @noindent @@ -5638,6 +5921,7 @@ you can: @cindex fixed-width sections @cindex tables @cindex @TeX{}-like syntax for sub- and superscripts +@cindex footnotes @cindex emphasized text @cindex @TeX{} macros @cindex La@TeX{} fragments @@ -5652,6 +5936,7 @@ toc: @r{turn on/off table of contents, or set level limit (integer)} ^: @r{turn on/off @TeX{}-like syntax for sub- and superscripts. If} @r{you write "^:@{@}", @code{a_@{b@}} will be interpreted, but} @r{the simple @code{a_b} will be left as it is.} +f: @r{turn on/off foototes like this[1].} *: @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} @@ -6018,6 +6303,7 @@ force publishing of all files by giving a prefix argument. @cindex completion, of dictionary words @cindex completion, of option keywords @cindex completion, of tags +@cindex completion, of property keys @cindex completion, of link abbreviations @cindex @TeX{} symbol completion @cindex TODO keywords completion @@ -6043,10 +6329,14 @@ After @samp{\}, complete @TeX{} symbols supported by the exporter. After @samp{*}, complete headlines in the current buffer so that they can be used in search links like @samp{[[*find this headline]]}. @item -After @samp{:}, complete tags. The list of tags is taken from the -variable @code{org-tag-alist} (possibly set through the @samp{#+TAGS} -in-buffer option, @pxref{Setting tags}), or it is created dynamically -from all tags used in the current buffer. +After @samp{:} in a headline, complete tags. The list of tags is taken +from the variable @code{org-tag-alist} (possibly set through the +@samp{#+TAGS} in-buffer option, @pxref{Setting tags}), or it is created +dynamically from all tags used in the current buffer. +@item +After @samp{:} and not in a headline, complete property keys. The list +of keys is constructed dynamically from all keys used in the current +buffer. @item After @samp{[}, complete link abbreviations (@pxref{Link abbreviations}). @item @@ -6092,6 +6382,32 @@ activate the changes immediately. Otherwise they become effective only when the file is visited again in a new Emacs session. @table @kbd +@item #+ARCHIVE: %s_done:: +This line sets the archive location for the agenda file. It applies for +all subsequent lines until the next @samp{#+CATEGORY} line, or the end +of the file. The first such line also applies to any entries before it. +The corresponding variable is @code{org-archive-location}. +@item #+CATEGORY: +This line sets the category for the agenda file. The category applies +for all subsequent lines until the next @samp{#+CATEGORY} line, or the +end of the file. The first such line also applies to any entries before it. +@item #+COLUMNS: %25ITEM ..... +Set the default format for columns view. This format applies when +columns view is invoked in location where no COLUMNS property applies. +@item #+CONSTANTS: name1=value1 ... +Set file-local values for constants to be used in table formulas. This +line set the local variable @code{org-table-formula-constants-local}. +The global version of theis variable is +@code{org-table-formula-constants}. +corresponding +@item #+LINK: linkword replace +These lines (several are allowed) specify link abbreviations. +@xref{Link abbreviations}. The corresponding variable is +@code{org-link-abbrev-alist}. +@item #+PRIORITIES: highest lowest default +This line sets the limits and the default for the priorities. All three +must be either letters A-Z or numbers 0-9. The highest priority must +have a lower ASCII number that the lowest priority. @item #+STARTUP: This line sets options to be used at startup of org-mode, when an Org-mode file is being visited. The first set of options deals with the @@ -6163,36 +6479,19 @@ The following options influence the table spreadsheet (variable constcgs @r{@file{constants.el} should use the c-g-s unit system} constSI @r{@file{constants.el} should use the SI unit system} @end example -@item #+SEQ_TODO: #+TYP_TODO: -These lines set the TODO keywords and their interpretation in the -current file. The corresponding variables are @code{org-todo-keywords} -and @code{org-todo-interpretation}. @item #+TAGS: TAG1(c1) TAG2(c2) These lines (several such lines are allowed) specify the legal tags in this file, and (potentially) the corresponding @emph{fast tag selection} keys. The corresponding variable is @code{org-tag-alist}. -@item #+LINK: linkword replace -These lines (several are allowed) specify link abbreviations. -@xref{Link abbreviations}. The corresponding variable is -@code{org-link-abbrev-alist}. -@item #+CATEGORY: -This line sets the category for the agenda file. The category applies -for all subsequent lines until the next @samp{#+CATEGORY} line, or the -end of the file. The first such line also applies to any entries before it. -@item #+ARCHIVE: %s_done:: -This line sets the archive location for the agenda file. It applies for -all subsequent lines until the next @samp{#+CATEGORY} line, or the end -of the file. The first such line also applies to any entries before it. -The corresponding variable is @code{org-archive-location}. -@item #+PRIORITIES: highest lowest default -This line sets the limits and the default for the priorities. All three -must be either letters A-Z or numbers 0-9. The highest priority must -have a lower ASCII number that the lowest priority. @item #+TBLFM: This line contains the formulas for the table directly above the line. @item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+OPTIONS: These lines provide settings for exporting files. For more details see @ref{Export options}. +@item #+SEQ_TODO: #+TYP_TODO: +These lines set the TODO keywords and their interpretation in the +current file. The corresponding variables are @code{org-todo-keywords} +and @code{org-todo-interpretation}. @end table @node The very busy C-c C-c key, Clean view, In-buffer settings, Miscellaneous @@ -6560,6 +6859,7 @@ Org-mode. * Tables in arbitrary syntax:: Orgtbl for LaTeX and other programs * Dynamic blocks:: Automatically filled blocks * Special agenda views:: Customized views +* Using the property API:: Writing programs that use entry properties @end menu @node Extensions, Tables in arbitrary syntax, Extensions and Hacking, Extensions and Hacking @@ -6933,7 +7233,7 @@ you could add the function @code{org-update-all-dblocks} to a hook, for example @code{before-save-hook}. @code{org-update-all-dblocks} is written in a way that is does nothing in buffers that are not in Org-mode. -@node Special agenda views, , Dynamic blocks, Extensions and Hacking +@node Special agenda views, Using the property API, Dynamic blocks, Extensions and Hacking @section Special Agenda Views @cindex agenda views, user-defined @@ -6986,6 +7286,44 @@ MATCH is being ignored." (org-todo-list "PROJECT"))) @end lisp +@node Using the property API, , Special agenda views, Extensions and Hacking +@section Using the property API +@cindex API, for properties + +Here is a description of the functions that can be used to work with +properties. + +@defun org-entry-properties &optional pom which +Get all properties of the entry at point-or-marker POM. +This includes the TODO keyword, the tags, time strings for deadline, +scheduled, and clocking, and any additional properties defined in the +entry. The return value is an alist, keys may occur multiple times +if the property key was used several times. +POM may also be nil, in which case the current entry is used. +If WHICH is nil or `all', get all properties. If WHICH is +`special' or `standard', only get that subclass. +@end defun +@defun org-entry-get pom property &optional inherit +Get value of PROPERTY for entry at point-or-marker POM. +If INHERIT is non-nil and the entry does not have the property, +then also check higher levels of the hierarchy. +@end defun + +@defun org-entry-delete pom property +Delete the property PROPERTY from entry at point-or-marker POM. +@end defun + +@defun org-entry-put pom property value +Set PROPERTY to VALUE for entry at point-or-marker POM. +@end defun + +@defun org-buffer-property-keys &optional include-specials +Get all property keys in the current buffer. +@end defun + +@defun org-insert-property-drawer +Insert a property drawer at point. +@end defun @node History and Acknowledgments, Index, Extensions and Hacking, Top @appendix History and Acknowledgments @@ -7010,7 +7348,7 @@ goals that Org-mode still has today: To create a new, outline-based, plain text mode with innovative and intuitive editing features, and to incorporate project planning functionality directly into a notes file. -Since the first release, hundreds of emails to me or on +Since the first release, literally thousands of emails to me or on @code{emacs-orgmode@@gnu.org} have provided a constant stream of bug reports, feedback, new ideas, and sometimes patches and add-on code. Many thanks to everyone who has helped to improve this package. I am @@ -7022,6 +7360,8 @@ let me know. @itemize @bullet @item +@i{Russel Adams} came up with the idea for drawers. +@item @i{Thomas Baumann} contributed the code for links to the MH-E email system. @item @@ -7039,7 +7379,9 @@ calculations and improved XEmacs compatibility, in particular by porting @item @i{Sacha Chua} suggested to copy some linking code from Planner. @item -@i{Eddward DeVilla} proposed and tested checkbox statistics. +@i{Eddward DeVilla} proposed and tested checkbox statistics. He also +came up with the idea of properties, and that there should be an API for +them. @item @i{Kees Dullemond} used to edit projects lists directly in HTML and so inspired some of the early development, including HTML export. He also @@ -7063,6 +7405,9 @@ translated David O'Toole's tutorial into French. @item @i{Kai Grossjohann} pointed out key-binding conflicts with other packages. @item +@i{Scott Jaderholm} proposed footnotes, control over whitespace between +folded entries, and column view for properties. +@item @i{Shidai Liu} ("Leo") asked for embedded LaTeX and tested it. He also provided frequent feedback and some patches. @item diff --git a/man/texinfo.tex b/man/texinfo.tex index 0f3c750a645..017eeac5d6d 100644 --- a/man/texinfo.tex +++ b/man/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2007-05-04.09} +\def\texinfoversion{2007-06-16.10} % % Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -5765,11 +5765,11 @@ end % regular 0x27. % \def\codequoteright{% - \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax - '% - \else - \char'15 - \fi + \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax + \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax + '% + \else \char'15 \fi + \else \char'15 \fi } % % and a similar option for the left quote char vs. a grave accent. @@ -5777,11 +5777,11 @@ end % the code environments to do likewise. % \def\codequoteleft{% - \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax - `% - \else - \char'22 - \fi + \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax + \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax + `% + \else \char'22 \fi + \else \char'22 \fi } % \begingroup diff --git a/nt/ChangeLog b/nt/ChangeLog index c1f5293059b..65f3bc7b622 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,11 @@ +2007-06-25 Jason Rumney <jasonr@gnu.org> + + * cmdproxy.c (main): Set console codepages to "ANSI". + +2007-06-20 Jason Rumney <jasonr@gnu.org> + + * configure.bat: Complain if image libraries are missing. + 2007-06-15 Jason Rumney <jasonr@gnu.org> * emacs.manifest: New file. diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c index 4e4f1ef5c91..d01e7f39724 100644 --- a/nt/cmdproxy.c +++ b/nt/cmdproxy.c @@ -466,6 +466,12 @@ main (int argc, char ** argv) SetCurrentDirectory (modname); *progname = '\\'; + /* Due to problems with interaction between API functions that use "OEM" + codepage vs API functions that use the "ANSI" codepage, we need to + make things consistent by choosing one and sticking with it. */ + SetConsoleCP (GetACP()); + SetConsoleOutputCP (GetACP()); + /* Although Emacs always sets argv[0] to an absolute pathname, we might get run in other ways as well, so convert argv[0] to an absolute name before comparing to the module name. Don't get diff --git a/nt/configure.bat b/nt/configure.bat index 123da0b21cd..3979065ab96 100755 --- a/nt/configure.bat +++ b/nt/configure.bat @@ -119,11 +119,11 @@ echo. --no-opt disable optimization echo. --no-cygwin use -mno-cygwin option with GCC
echo. --cflags FLAG pass FLAG to compiler
echo. --ldflags FLAG pass FLAG to compiler when linking
-echo. --without-png do not use libpng even if it is installed
-echo. --without-jpeg do not use jpeg-6b even if it is installed
-echo. --without-gif do not use libungif even if it is installed
-echo. --without-tiff do not use libtiff even if it is installed
-echo. --without-xpm do not use libXpm even if it is installed
+echo. --without-png do not use libpng
+echo. --without-jpeg do not use jpeg-6b
+echo. --without-gif do not use giflib or libungif
+echo. --without-tiff do not use libtiff
+echo. --without-xpm do not use libXpm
echo. --enable-font-backend build with font backend support
goto end
rem ----------------------------------------------------------------------
@@ -542,6 +542,51 @@ copy subdirs.el ..\site-lisp\subdirs.el :dontUpdateSubdirs
echo.
+
+rem check that we have all the libraries we need.
+set libsOK=1
+
+if not "(%HAVE_XPM%)" == "()" goto checkpng
+if (%xpmsupport%) == (N) goto checkpng
+ set libsOK=0
+ echo XPM support is missing. It is required for color icons in the toolbar.
+ echo Install libXpm development files or use --without-xpm
+
+:checkpng
+if not "(%HAVE_PNG%)" == "()" goto checkjpeg
+if (%pngsupport%) == (N) goto checkjpeg
+ set libsOK=0
+ echo PNG support is missing.
+ echo Install libpng development files or use --without-png
+
+:checkjpeg
+if not "(%HAVE_JPEG%)" == "()" goto checktiff
+if (%jpegsupport%) == (N) goto checktiff
+ set libsOK=0
+ echo JPEG support is missing.
+ echo Install jpeg development files or use --without-jpeg
+
+:checktiff
+if not "(%HAVE_TIFF%)" == "()" goto checkgif
+if (%tiffsupport%) == (N) goto checkgif
+ set libsOK=0
+ echo TIFF support is missing.
+ echo Install libtiff development files or use --without-tiff
+
+:checkgif
+if not "(%HAVE_GIF%)" == "()" goto donelibchecks
+if (%gifsupport%) == (N) goto donelibchecks
+ set libsOK=0
+ echo GIF support is missing.
+ echo Install giflib or libungif development files or use --without-gif
+
+:donelibchecks
+if (%libsOK%) == (1) goto success
+echo.
+echo Important libraries are missing. Fix these issues before running make.
+goto end
+
+:success
echo Emacs successfully configured.
echo Emacs successfully configured. >>config.log
echo Run `%MAKECMD%' to build, then run `%MAKECMD% install' to install.
diff --git a/src/ChangeLog b/src/ChangeLog index 8d9793287bd..05bb5c9e74a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -38,6 +38,127 @@ * src/xmenu.c: * src/xterm.c: Replace uses of GC_* macros with the non-GC_ versions. +2007-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuf.c (Fcompleting_read): New value `confirm-only' + for `require-match'. + +2007-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * fileio.c (Fdo_auto_save): Revert last patch installed unwillingly as + part of the 2007-06-27 change to syms_of_fileio. + +2007-06-28 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c [USE_MAC_TSM] (mac_handle_text_input_event): + Check WINDOWP before using XWINDOW. Consolidate return statements. + +2007-06-27 Richard Stallman <rms@gnu.org> + + * fileio.c (syms_of_fileio) <after-insert-file-functions>: Doc fix. + +2007-06-27 Juanma Barranquero <lekktu@gmail.com> + + * buffer.c (syms_of_buffer) <selective-display>: Fix typo in docstring. + +2007-06-26 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * gmalloc.c [HAVE_GTK_AND_PTHREAD]: Check this after including config.h. + (_aligned_blocks_mutex) [USE_PTHREAD]: New variable. + (LOCK_ALIGNED_BLOCKS, UNLOCK_ALIGNED_BLOCKS): New macros. + (_free_internal, memalign): Use them. + (_malloc_mutex, _aligned_blocks_mutex) [USE_PTHREAD]: + Initialize to PTHREAD_MUTEX_INITIALIZER. + (malloc_initialize_1) [USE_PTHREAD]: Don't use recursive mutex. + (morecore_nolock): Rename from morecore. All uses changed. + Use only nolock versions of internal allocation functions. + (_malloc_internal_nolock, _realloc_internal_nolock) + (_free_internal_nolock): New functions created from + _malloc_internal, _realloc_internal, and _free_internal. + (_malloc_internal, _realloc_internal, _free_internal): Use them. + Copy hook value to automatic variable before its use. + (memalign): Copy hook value to automatic variable before its use. + +2007-06-26 Kenichi Handa <handa@m17n.org> + + * coding.c (Ffind_operation_coding_system): Docstring improved. + (syms_of_coding): Docstring of `file-coding-system-alist' improved. + +2007-06-25 David Kastrup <dak@gnu.org> + + * keymap.c (Fcurrent_active_maps): Add `position' argument. + (Fwhere_is_internal): Adjust call to `current-active-maps' to + cater for additional parameter. + + * keymap.h: Adjust number of parameters to `current-active-maps'. + + * doc.c (Fsubstitute_command_keys): Adjust call of + `current-active-maps'. + +2007-06-25 David Kastrup <dak@gnu.org> + + * callint.c (Fcall_interactively): Make the parsing of interactive + specs somewhat more readable. + +2007-06-23 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (x_draw_fringe_bitmap) [MAC_OSX]: Extend fringe background + to scroll bar gap also when bitmap fills fringe. Draw only foreground + if extended background has already been filled. + +2007-06-22 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macgui.h (USE_CG_DRAWING): Don't require USE_ATSUI. + (USE_MAC_TOOLBAR): Require USE_CG_DRAWING. + + * macmenu.c (mac_dialog_modal_filter, Fx_popup_dialog) [MAC_OSX]: + Put special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p + in #if 0 as it is not compatible with y-or-n-p-with-timeout. + (timer_check) [TARGET_API_MAC_CARBON]: Add extern. + [TARGET_API_MAC_CARBON] (mac_handle_dialog_event): Use QuitEventLoop + instead of QuitAppModalLoopForWindow. Consolidate QuitEventLoop calls. + (pop_down_dialog) [TARGET_API_MAC_CARBON]: New function. + [TARGET_API_MAC_CARBON] (create_and_show_dialog): Use it for unwind. + Run timers during dialog popup. + (Fmenu_or_popup_active_p) [TARGET_API_MAC_CARBON]: Use popup_activated. + +2007-06-21 Jason Rumney <jasonr@gnu.org> + + * image.c (convert_mono_to_color_image): Swap fore and background. + +2007-06-20 Jason Rumney <jasonr@gnu.org> + + * w32bdf.c (w32_BDF_to_x_font): Unmap memory when finished. + (w32_free_bdf_font): Unmap memory not handle. + +2007-06-20 Sam Steingold <sds@gnu.org> + + * gmalloc.c (__morecore): Fix the declaration to comply with the + definition. + +2007-06-20 Juanma Barranquero <lekktu@gmail.com> + + * w32term.c (w32_delete_display): Remove leftover declaration. + (w32_define_cursor, w32_initialize): Make static. + + * w32.c (_wsa_errlist): Fix typo in error message. + (init_environment): Ignore any environment variable from the + registry having a null value. + +2007-06-20 Glenn Morris <rgm@gnu.org> + + * Makefile.in (LIBGIF): Default to -lgif. + +2007-06-17 Jason Rumney <jasonr@gnu.org> + + * w32menu.c (add_menu_item): Don't use multibyte string functions on + unicode strings. + +2007-06-16 Juanma Barranquero <lekktu@gmail.com> + + * xdisp.c (syms_of_xdisp) <auto-resize-tool-bars>: + Fix typo in docstring. + 2007-06-16 Eli Zaretskii <eliz@gnu.org> * w32menu.c (add_menu_item): Escape `&' characters in menu items @@ -132,7 +253,7 @@ * w32fns.c (Fx_file_dialog): Take size from struct not pointer. -2007-06-08 Juanma Barranquero <lekktu@gmail.com> +2007-06-08 Juanma Barranquero <lekktu@gmail.com> * callint.c (Fcall_interactively): * editfns.c (Fdelete_and_extract_region): @@ -150,7 +271,7 @@ * xselect.c (Fx_get_atom_name): * xterm.c (x_term_init): Use empty_unibyte_string. -2007-06-08 Dmitry Antipov <dmitry.antipov@mail.ru> (tiny change) +2007-06-08 Dmitry Antipov <dmantipov@yandex.ru> (tiny change) * alloc.c (init_strings): Initialize canonical empty strings. (make_uninit_string, make_uninit_multibyte_string): Return appropriate @@ -185,7 +306,7 @@ [TARGET_API_MAC_CARBON] (install_menu_target_item_handler): Remove argument. Install handler to application. (set_frame_menubar): Don't change deep_p. - (mac_menu_show): Use FRAME_OUTER_TO_INNER_DIFF_X and + (mac_menu_show): Use FRAME_OUTER_TO_INNER_DIFF_X and FRAME_OUTER_TO_INNER_DIFF_Y. (DIALOG_BUTTON_COMMAND_ID_OFFSET, DIALOG_BUTTON_COMMAND_ID_P) (DIALOG_BUTTON_COMMAND_ID_VALUE, DIALOG_BUTTON_MAKE_COMMAND_ID) @@ -537,6 +658,10 @@ 2007-04-24 Chong Yidong <cyd@stupidchicken.com> + * Branch for 22.1. + +2007-04-24 Chong Yidong <cyd@stupidchicken.com> + * xdisp.c (redisplay_window): Use BEG_UNCHANGED and END_UNCHANGED values of the actual window. @@ -10557,7 +10682,7 @@ (XTread_socket) [!MAC_OSX]: Don't pass keyboard events to TSM. [MAC_OS8] (make_mac_terminal_frame) [TARGET_API_MAC_CARBON]: Set default cursors. - (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX] : Don't call + (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX]: Don't call init_service_handler or init_quit_char_handler. (mac_initialize) [!MAC_OSX]: Don't call MakeMeTheFrontProcess. @@ -11494,7 +11619,7 @@ (install_window_handler) [TARGET_API_MAC_CARBON]: Register handlers for tracking/receiving drag-and-drop items. (do_ae_open_documents): Generate unibyte strings for filenames. - (mac_do_receive_drag) [TARGET_API_MAC_CARBON] : Likewise. + (mac_do_receive_drag) [TARGET_API_MAC_CARBON]: Likewise. Reject only non-filename items. Set event modifiers, and return value. 2004-12-28 Dan Nicolaescu <dann@ics.uci.edu> @@ -15879,7 +16004,7 @@ * macgui.h [MAC_OSX]: Include Carbon/Carbon.h. (mktime, DEBUG, Z, free, malloc, realloc, max, min) - (init_process) [MAC_OSX] : Avoid conflicts with Carbon/Carbon.h. + (init_process) [MAC_OSX]: Avoid conflicts with Carbon/Carbon.h. [!MAC_OSX]: Include QDOffscreen.h and Controls.h. (INFINITY) [MAC_OSX]: Avoid conflict with definition in math.h. (Bitmap): Remove typedef. @@ -16184,7 +16309,7 @@ * cmds.c (Fend_of_line): Doc fix. -2004-02-16 Dmitry Antipov <dmitry.antipov@mail.ru> (tiny change) +2004-02-16 Dmitry Antipov <dmantipov@yandex.ru> (tiny change) * keyboard.c (prev_read): New static variable. (read_avail_input): Use it to zero out only those slots in buf[] @@ -22000,7 +22125,7 @@ (best_matching_font, choose_face_font): Add `needs_overstrike' argument, and use it to return whether overstriking is desirable for this face/font combo. - (set_font_frame_param: Pass new argument to choose_face_font. + (set_font_frame_param): Pass new argument to choose_face_font. 2002-11-17 Ben Key <BKey1@tampabay.rr.com> diff --git a/src/Makefile.in b/src/Makefile.in index a4750bc3503..54b6533cd36 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -441,7 +441,7 @@ XFT_LIBS=@XFT_LIBS@ #if HAVE_GIF #ifndef LIBGIF -#define LIBGIF -lungif +#define LIBGIF -lgif #endif /* not defined LIBGIF */ #else /* not HAVE_GIF */ #define LIBGIF diff --git a/src/buffer.c b/src/buffer.c index 5e4b091dfa2..925463a63c3 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5668,8 +5668,8 @@ Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, Qnil, doc: /* Non-nil enables selective display. -An Integer N as value means display only lines -that start with less than n columns of space. +An integer N as value means display only lines +that start with less than N columns of space. A value of t means that the character ^M makes itself and all the rest of the line invisible; also, when saving the buffer in a file, save the ^M as a newline. */); diff --git a/src/callint.c b/src/callint.c index a989f9afe6d..887f87630e3 100644 --- a/src/callint.c +++ b/src/callint.c @@ -473,16 +473,19 @@ invoke it. If KEYS is omitted or nil, the return value of /* Count the number of arguments the interactive spec would have us give to the function. */ tem = string; - for (j = 0; *tem; j++) + for (j = 0; *tem;) { /* 'r' specifications ("point and mark as 2 numeric args") produce *two* arguments. */ - if (*tem == 'r') j++; + if (*tem == 'r') + j += 2; + else + j++; tem = (unsigned char *) index (tem, '\n'); if (tem) - tem++; + ++tem; else - tem = (unsigned char *) ""; + break; } count = j; diff --git a/src/coding.c b/src/coding.c index e7ff19f3929..e4ecbf50f62 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8390,6 +8390,8 @@ They may specify a coding system, a cons of coding systems, or a function symbol to call. In the last case, we call the function with one argument, which is a list of all the arguments given to this function. +If the function can't decide a coding system, it can return +`undecided' so that the normal code-detection is performed. If OPERATION is `insert-file-contents', the argument corresponding to TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a @@ -9613,8 +9615,11 @@ the file contents. If VAL is a cons of coding systems, the car part is used for decoding, and the cdr part is used for encoding. If VAL is a function symbol, the function must return a coding system -or a cons of coding systems which are used as above. The function gets -the arguments with which `find-operation-coding-systems' was called. +or a cons of coding systems which are used as above. The function is +called with an argument that is a list of the arguments with which +`find-operation-coding-system' was called. If the function can't decide +a coding system, it can return `undecided' so that the normal +code-detection is performed. See also the function `find-operation-coding-system' and the variable `auto-coding-alist'. */); diff --git a/src/config.in b/src/config.in index db6b5ebaee3..1400931eb41 100644 --- a/src/config.in +++ b/src/config.in @@ -231,7 +231,7 @@ Boston, MA 02110-1301, USA. */ /* Define to 1 if you have the `get_current_dir_name' function. */ #undef HAVE_GET_CURRENT_DIR_NAME -/* Define to 1 if you have a gif library (default -lungif; otherwise specify +/* Define to 1 if you have a gif library (default -lgif; otherwise specify with LIBGIF). */ #undef HAVE_GIF @@ -778,7 +778,7 @@ Boston, MA 02110-1301, USA. */ Solaris, for example). */ #undef LD_SWITCH_X_SITE_AUX -/* Compiler option to link with the gif library (if not -lungif). */ +/* Compiler option to link with the gif library (if not -lgif). */ #undef LIBGIF /* Define to 1 if localtime caches TZ. */ diff --git a/src/doc.c b/src/doc.c index 74690ebba6b..6d62945c6c6 100644 --- a/src/doc.c +++ b/src/doc.c @@ -883,7 +883,7 @@ a new string, without any text properties, is returned. */) struct buffer *oldbuf; int start_idx; /* This is for computing the SHADOWS arg for describe_map_tree. */ - Lisp_Object active_maps = Fcurrent_active_maps (Qnil); + Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); Lisp_Object earlier_maps; changed = 1; diff --git a/src/fileio.c b/src/fileio.c index 55aaeaa6897..2cdc5323d8e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6599,8 +6599,9 @@ or local variable spec of the tailing lines with `coding:' tag. */); DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, doc: /* A list of functions to be called at the end of `insert-file-contents'. -Each is passed one argument, the number of characters inserted. -It should return the new character count, and leave point the same. +Each is passed one argument, the number of characters inserted, +with point at the start of the inserted text. Each function +should leave point the same, and return the new character count. If `insert-file-contents' is intercepted by a handler from `file-name-handler-alist', that handler is responsible for calling the functions in `after-insert-file-functions' if appropriate. */); diff --git a/src/gmalloc.c b/src/gmalloc.c index 50535d4940c..fcd9f655321 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -1,9 +1,6 @@ /* This file is no longer automatically generated from libc. */ #define _MALLOC_INTERNAL -#ifdef HAVE_GTK_AND_PTHREAD -#define USE_PTHREAD -#endif /* The malloc headers and source files from the C library follow here. */ @@ -40,6 +37,10 @@ Fifth Floor, Boston, MA 02110-1301, USA. #include <config.h> #endif +#ifdef HAVE_GTK_AND_PTHREAD +#define USE_PTHREAD +#endif + #if ((defined __cplusplus || (defined (__STDC__) && __STDC__) \ || defined STDC_HEADERS || defined PROTOTYPES) \ && ! defined (BROKEN_PROTOTYPES)) @@ -235,14 +236,21 @@ extern __malloc_size_t _bytes_free; extern __ptr_t _malloc_internal PP ((__malloc_size_t __size)); extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal PP ((__ptr_t __ptr)); +extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size)); +extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size)); +extern void _free_internal_nolock PP ((__ptr_t __ptr)); #ifdef USE_PTHREAD -extern pthread_mutex_t _malloc_mutex; +extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex; #define LOCK() pthread_mutex_lock (&_malloc_mutex) #define UNLOCK() pthread_mutex_unlock (&_malloc_mutex) +#define LOCK_ALIGNED_BLOCKS() pthread_mutex_lock (&_aligned_blocks_mutex) +#define UNLOCK_ALIGNED_BLOCKS() pthread_mutex_unlock (&_aligned_blocks_mutex) #else #define LOCK() #define UNLOCK() +#define LOCK_ALIGNED_BLOCKS() +#define UNLOCK_ALIGNED_BLOCKS() #endif #endif /* _MALLOC_INTERNAL. */ @@ -373,7 +381,7 @@ Fifth Floor, Boston, MA 02110-1301, USA. extern __ptr_t bss_sbrk PP ((ptrdiff_t __size)); extern int bss_sbrk_did_unexec; #endif -__ptr_t (*__morecore) PP ((ptrdiff_t __size)) = __default_morecore; +__ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) PP ((__malloc_size_t __size)); @@ -554,7 +562,8 @@ register_heapinfo () #ifdef USE_PTHREAD static pthread_once_t malloc_init_once_control = PTHREAD_ONCE_INIT; -pthread_mutex_t _malloc_mutex; +pthread_mutex_t _malloc_mutex = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t _aligned_blocks_mutex = PTHREAD_MUTEX_INITIALIZER; #endif static void @@ -567,7 +576,9 @@ malloc_initialize_1 () if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); -#ifdef USE_PTHREAD + /* We don't use recursive mutex because pthread_mutexattr_init may + call malloc internally. */ +#if 0 /* defined (USE_PTHREAD) */ { pthread_mutexattr_t attr; @@ -616,9 +627,9 @@ static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ -static __ptr_t morecore PP ((__malloc_size_t)); +static __ptr_t morecore_nolock PP ((__malloc_size_t)); static __ptr_t -morecore (size) +morecore_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -661,7 +672,7 @@ morecore (size) `morecore_recursing' flag and return null. */ int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; - newinfo = (malloc_info *) _realloc_internal + newinfo = (malloc_info *) _realloc_internal_nolock (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) @@ -717,7 +728,7 @@ morecore (size) /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; - _free_internal (oldinfo); + _free_internal_nolock (oldinfo); PROTECT_MALLOC_STATE (0); /* The new heap limit includes the new table just allocated. */ @@ -732,7 +743,7 @@ morecore (size) /* Allocate memory from the heap. */ __ptr_t -_malloc_internal (size) +_malloc_internal_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -752,7 +763,6 @@ _malloc_internal (size) return NULL; #endif - LOCK (); PROTECT_MALLOC_STATE (0); if (size < sizeof (struct list)) @@ -802,8 +812,10 @@ _malloc_internal (size) /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ #ifdef GC_MALLOC_CHECK - result = _malloc_internal (BLOCKSIZE); + result = _malloc_internal_nolock (BLOCKSIZE); PROTECT_MALLOC_STATE (0); +#elif defined (USE_PTHREAD) + result = _malloc_internal_nolock (BLOCKSIZE); #else result = malloc (BLOCKSIZE); #endif @@ -874,7 +886,7 @@ _malloc_internal (size) _heaplimit += wantblocks - lastblocks; continue; } - result = morecore (wantblocks * BLOCKSIZE); + result = morecore_nolock (wantblocks * BLOCKSIZE); if (result == NULL) goto out; block = BLOCK (result); @@ -932,7 +944,19 @@ _malloc_internal (size) PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_malloc_internal (size) + __malloc_size_t size; +{ + __ptr_t result; + + LOCK (); + result = _malloc_internal_nolock (size); UNLOCK (); + return result; } @@ -940,10 +964,21 @@ __ptr_t malloc (size) __malloc_size_t size; { + __ptr_t (*hook) (__malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); + /* Copy the value of __malloc_hook to an automatic variable in case + __malloc_hook is modified in another thread between its + NULL-check and the use. + + Note: Strictly speaking, this is not a right solution. We should + use mutexes to access non-read-only variables that are shared + among multiple threads. We just leave it for compatibility with + glibc malloc (i.e., assignments to __malloc_hook) for now. */ + hook = __malloc_hook; + return (hook != NULL ? *hook : _malloc_internal) (size); } #ifndef _LIBC @@ -1024,9 +1059,9 @@ void (*__free_hook) PP ((__ptr_t __ptr)); struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. - Like `free' but don't call a __free_hook if there is one. */ + Like `_free_internal' but don't lock mutex. */ void -_free_internal (ptr) +_free_internal_nolock (ptr) __ptr_t ptr; { int type; @@ -1043,9 +1078,9 @@ _free_internal (ptr) if (ptr == NULL) return; - LOCK (); PROTECT_MALLOC_STATE (0); + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { @@ -1053,6 +1088,7 @@ _free_internal (ptr) ptr = l->exact; break; } + UNLOCK_ALIGNED_BLOCKS (); block = BLOCK (ptr); @@ -1158,7 +1194,7 @@ _free_internal (ptr) table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; - _free_internal (_heapinfo); + _free_internal_nolock (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for @@ -1166,8 +1202,8 @@ _free_internal (ptr) _heapindex = 0; /* Allocate new space for the info table and move its data. */ - newinfo = (malloc_info *) _malloc_internal (info_blocks - * BLOCKSIZE); + newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks + * BLOCKSIZE); PROTECT_MALLOC_STATE (0); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; @@ -1230,8 +1266,8 @@ _free_internal (ptr) _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; -#ifdef GC_MALLOC_CHECK - _free_internal (ADDRESS (block)); +#if defined (GC_MALLOC_CHECK) || defined (USE_PTHREAD) + _free_internal_nolock (ADDRESS (block)); #else free (ADDRESS (block)); #endif @@ -1269,6 +1305,16 @@ _free_internal (ptr) } PROTECT_MALLOC_STATE (1); +} + +/* Return memory to the heap. + Like `free' but don't call a __free_hook if there is one. */ +void +_free_internal (ptr) + __ptr_t ptr; +{ + LOCK (); + _free_internal_nolock (ptr); UNLOCK (); } @@ -1278,8 +1324,10 @@ FREE_RETURN_TYPE free (ptr) __ptr_t ptr; { - if (__free_hook != NULL) - (*__free_hook) (ptr); + void (*hook) (__ptr_t) = __free_hook; + + if (hook != NULL) + (*hook) (ptr); else _free_internal (ptr); } @@ -1415,7 +1463,7 @@ __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size)); new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t -_realloc_internal (ptr, size) +_realloc_internal_nolock (ptr, size) __ptr_t ptr; __malloc_size_t size; { @@ -1425,15 +1473,14 @@ _realloc_internal (ptr, size) if (size == 0) { - _free_internal (ptr); - return _malloc_internal (0); + _free_internal_nolock (ptr); + return _malloc_internal_nolock (0); } else if (ptr == NULL) - return _malloc_internal (size); + return _malloc_internal_nolock (size); block = BLOCK (ptr); - LOCK (); PROTECT_MALLOC_STATE (0); type = _heapinfo[block].busy.type; @@ -1443,11 +1490,11 @@ _realloc_internal (ptr, size) /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result != NULL) { memcpy (result, ptr, size); - _free_internal (ptr); + _free_internal_nolock (ptr); goto out; } } @@ -1467,7 +1514,7 @@ _realloc_internal (ptr, size) Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; - _free_internal (ADDRESS (block + blocks)); + _free_internal_nolock (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) @@ -1482,8 +1529,8 @@ _realloc_internal (ptr, size) /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; - _free_internal (ptr); - result = _malloc_internal (size); + _free_internal_nolock (ptr); + result = _malloc_internal_nolock (size); PROTECT_MALLOC_STATE (0); if (_heaplimit == 0) _heaplimit = oldlimit; @@ -1493,13 +1540,13 @@ _realloc_internal (ptr, size) the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) - (void) _malloc_internal (blocks * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); else { __ptr_t previous - = _malloc_internal ((block - _heapindex) * BLOCKSIZE); - (void) _malloc_internal (blocks * BLOCKSIZE); - _free_internal (previous); + = _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); + _free_internal_nolock (previous); } goto out; } @@ -1519,18 +1566,31 @@ _realloc_internal (ptr, size) { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result == NULL) goto out; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); - _free_internal (ptr); + _free_internal_nolock (ptr); } break; } PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_realloc_internal (ptr, size) + __ptr_t ptr; + __malloc_size_t size; +{ + __ptr_t result; + + LOCK(); + result = _realloc_internal_nolock (ptr, size); UNLOCK (); + return result; } @@ -1539,11 +1599,13 @@ realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { + __ptr_t (*hook) (__ptr_t, __malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) - (ptr, size); + hook = __realloc_hook; + return (hook != NULL ? *hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. @@ -1681,9 +1743,10 @@ memalign (alignment, size) { __ptr_t result; unsigned long int adj, lastadj; + __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook; - if (__memalign_hook) - return (*__memalign_hook) (alignment, size); + if (hook) + return (*hook) (alignment, size); /* Allocate a block with enough extra space to pad the block with up to (ALIGNMENT - 1) bytes if necessary. */ @@ -1718,6 +1781,7 @@ memalign (alignment, size) of an allocated block. */ struct alignlist *l; + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ @@ -1725,16 +1789,23 @@ memalign (alignment, size) if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); - if (l == NULL) + if (l != NULL) { - free (result); - return NULL; + l->next = _aligned_blocks; + _aligned_blocks = l; } - l->next = _aligned_blocks; - _aligned_blocks = l; } - l->exact = result; - result = l->aligned = (char *) result + alignment - adj; + if (l != NULL) + { + l->exact = result; + result = l->aligned = (char *) result + alignment - adj; + } + UNLOCK_ALIGNED_BLOCKS (); + if (l == NULL) + { + free (result); + result = NULL; + } } return result; diff --git a/src/image.c b/src/image.c index 2dd578afc39..a1a908600ee 100644 --- a/src/image.c +++ b/src/image.c @@ -3120,8 +3120,8 @@ static void convert_mono_to_color_image (f, img, foreground, background) release_frame_dc (f, hdc); old_prev = SelectObject (old_img_dc, img->pixmap); new_prev = SelectObject (new_img_dc, new_pixmap); - SetTextColor (new_img_dc, foreground); - SetBkColor (new_img_dc, background); + SetTextColor (new_img_dc, background); + SetBkColor (new_img_dc, foreground); BitBlt (new_img_dc, 0, 0, img->width, img->height, old_img_dc, 0, 0, SRCCOPY); diff --git a/src/keymap.c b/src/keymap.c index 3649177d045..29898fe7a8e 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1574,14 +1574,47 @@ current_minor_maps (modeptr, mapptr) } DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, - 0, 1, 0, + 0, 2, 0, doc: /* Return a list of the currently active keymaps. OLP if non-nil indicates that we should obey `overriding-local-map' and -`overriding-terminal-local-map'. */) - (olp) - Lisp_Object olp; +`overriding-terminal-local-map'. POSITION can specify a click position +like in the respective argument of `key-binding'. */) + (olp, position) + Lisp_Object olp, position; { - Lisp_Object keymaps = Fcons (current_global_map, Qnil); + int count = SPECPDL_INDEX (); + + Lisp_Object keymaps; + + /* If a mouse click position is given, our variables are based on + the buffer clicked on, not the current buffer. So we may have to + switch the buffer here. */ + + if (CONSP (position)) + { + Lisp_Object window; + + window = POSN_WINDOW (position); + + if (WINDOWP (window) + && BUFFERP (XWINDOW (window)->buffer) + && XBUFFER (XWINDOW (window)->buffer) != current_buffer) + { + /* Arrange to go back to the original buffer once we're done + processing the key sequence. We don't use + save_excursion_{save,restore} here, in analogy to + `read-key-sequence' to avoid saving point. Maybe this + would not be a problem here, but it is easier to keep + things the same. + */ + + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + + set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); + } + } + + keymaps = Fcons (current_global_map, Qnil); if (!NILP (olp)) { @@ -1595,15 +1628,76 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and } if (NILP (XCDR (keymaps))) { - Lisp_Object local; Lisp_Object *maps; int nmaps, i; - /* This usually returns the buffer's local map, - but that can be overridden by a `local-map' property. */ - local = get_local_map (PT, current_buffer, Qlocal_map); - if (!NILP (local)) - keymaps = Fcons (local, keymaps); + Lisp_Object keymap, local_map; + EMACS_INT pt; + + pt = INTEGERP (position) ? XINT (position) + : MARKERP (position) ? marker_position (position) + : PT; + + /* Get the buffer local maps, possibly overriden by text or + overlay properties */ + + local_map = get_local_map (pt, current_buffer, Qlocal_map); + keymap = get_local_map (pt, current_buffer, Qkeymap); + + if (CONSP (position)) + { + Lisp_Object string; + + /* For a mouse click, get the local text-property keymap + of the place clicked on, rather than point. */ + + if (POSN_INBUFFER_P (position)) + { + Lisp_Object pos; + + pos = POSN_BUFFER_POSN (position); + if (INTEGERP (pos) + && XINT (pos) >= BEG && XINT (pos) <= Z) + { + local_map = get_local_map (XINT (pos), + current_buffer, Qlocal_map); + + keymap = get_local_map (XINT (pos), + current_buffer, Qkeymap); + } + } + + /* If on a mode line string with a local keymap, + or for a click on a string, i.e. overlay string or a + string displayed via the `display' property, + consider `local-map' and `keymap' properties of + that string. */ + + if (string = POSN_STRING (position), + (CONSP (string) && STRINGP (XCAR (string)))) + { + Lisp_Object pos, map; + + pos = XCDR (string); + string = XCAR (string); + if (INTEGERP (pos) + && XINT (pos) >= 0 + && XINT (pos) < SCHARS (string)) + { + map = Fget_text_property (pos, Qlocal_map, string); + if (!NILP (map)) + local_map = map; + + map = Fget_text_property (pos, Qkeymap, string); + if (!NILP (map)) + keymap = map; + } + } + + } + + if (!NILP (local_map)) + keymaps = Fcons (local_map, keymaps); /* Now put all the minor mode keymaps on the list. */ nmaps = current_minor_maps (0, &maps); @@ -1612,12 +1706,12 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and if (!NILP (maps[i])) keymaps = Fcons (maps[i], keymaps); - /* This returns nil unless there is a `keymap' property. */ - local = get_local_map (PT, current_buffer, Qkeymap); - if (!NILP (local)) - keymaps = Fcons (local, keymaps); + if (!NILP (keymap)) + keymaps = Fcons (keymap, keymaps); } + unbind_to (count, Qnil); + return keymaps; } @@ -2809,7 +2903,7 @@ remapped command in the returned list. */) else if (!NILP (keymap)) keymaps = Fcons (keymap, Fcons (current_global_map, Qnil)); else - keymaps = Fcurrent_active_maps (Qnil); + keymaps = Fcurrent_active_maps (Qnil, Qnil); /* Only use caching for the menubar (i.e. called with (def nil t nil). We don't really need to check `keymap'. */ diff --git a/src/keymap.h b/src/keymap.h index f55f76d5005..185ae70d945 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -34,7 +34,7 @@ EXFUN (Fkey_binding, 4); EXFUN (Fkey_description, 2); EXFUN (Fsingle_key_description, 2); EXFUN (Fwhere_is_internal, 5); -EXFUN (Fcurrent_active_maps, 1); +EXFUN (Fcurrent_active_maps, 2); extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int)); extern Lisp_Object get_keyelt P_ ((Lisp_Object, int)); extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int)); diff --git a/src/macgui.h b/src/macgui.h index a141a6563f0..fc00b74b007 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -100,7 +100,7 @@ typedef unsigned long Time; /* Whether to use Quartz 2D routines for drawing operations other than texts. */ #ifndef USE_CG_DRAWING -#if USE_ATSUI && MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 #define USE_CG_DRAWING 1 #endif #endif @@ -121,7 +121,7 @@ typedef unsigned long Time; /* Whether to use HIToolbar. */ #ifndef USE_MAC_TOOLBAR -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 && MAC_OS_X_VERSION_MIN_REQUIRED != 1020 +#if USE_CG_DRAWING && MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 && MAC_OS_X_VERSION_MIN_REQUIRED != 1020 #define USE_MAC_TOOLBAR 1 #endif #endif diff --git a/src/macmenu.c b/src/macmenu.c index 932af50bbd8..6fe064dd55a 100644 --- a/src/macmenu.c +++ b/src/macmenu.c @@ -882,7 +882,7 @@ no quit occurs and `x-popup-menu' returns nil. */) /* Regard ESC and C-g as Cancel even without the Cancel button. */ -#ifdef MAC_OSX +#if 0 /* defined (MAC_OSX) */ static Boolean mac_dialog_modal_filter (dialog, event, item_hit) DialogRef dialog; @@ -991,7 +991,7 @@ for instance using the window manager, then this produces a quit and but I don't want to make one now. */ CHECK_WINDOW (window); -#ifdef MAC_OSX +#if 0 /* defined (MAC_OSX) */ /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */ if (EQ (position, Qt) && STRINGP (Fcar (contents)) @@ -2330,14 +2330,17 @@ mac_menu_show (f, x, y, for_click, keymaps, title, error) #define DIALOG_BUTTON_MAKE_COMMAND_ID(value) \ ((value) + DIALOG_BUTTON_COMMAND_ID_OFFSET) +extern EMACS_TIME timer_check P_ ((int)); + static pascal OSStatus mac_handle_dialog_event (next_handler, event, data) EventHandlerCallRef next_handler; EventRef event; void *data; { - OSStatus err; + OSStatus err, result = eventNotHandledErr; WindowRef window = (WindowRef) data; + int quit_event_loop_p = 0; switch (GetEventClass (event)) { @@ -2352,12 +2355,11 @@ mac_handle_dialog_event (next_handler, event, data) if (DIALOG_BUTTON_COMMAND_ID_P (command.commandID)) { SetWRefCon (window, command.commandID); - err = QuitAppModalLoopForWindow (window); - - return err == noErr ? noErr : eventNotHandledErr; + quit_event_loop_p = 1; + break; } - return CallNextEventHandler (next_handler, event); + result = CallNextEventHandler (next_handler, event); } break; @@ -2367,8 +2369,8 @@ mac_handle_dialog_event (next_handler, event, data) char char_code; result = CallNextEventHandler (next_handler, event); - if (result == noErr) - return noErr; + if (result != eventNotHandledErr) + break; err = GetEventParameter (event, kEventParamKeyMacCharCodes, typeChar, NULL, sizeof (char), @@ -2377,7 +2379,7 @@ mac_handle_dialog_event (next_handler, event, data) switch (char_code) { case kEscapeCharCode: - err = QuitAppModalLoopForWindow (window); + quit_event_loop_p = 1; break; default: @@ -2392,26 +2394,26 @@ mac_handle_dialog_event (next_handler, event, data) typeUInt32, NULL, sizeof (UInt32), NULL, &key_code); if (err == noErr) - { - if (mac_quit_char_key_p (modifiers, key_code)) - err = QuitAppModalLoopForWindow (window); - else - err = eventNotHandledErr; - } + if (mac_quit_char_key_p (modifiers, key_code)) + quit_event_loop_p = 1; } break; } - - if (err == noErr) - result = noErr; - - return result; } break; default: abort (); } + + if (quit_event_loop_p) + { + err = QuitEventLoop (GetCurrentEventLoop ()); + if (err == noErr) + result = noErr; + } + + return result; } static OSStatus @@ -2446,6 +2448,25 @@ install_dialog_event_handler (window) #define DIALOG_ICON_LEFT_MARGIN (24) #define DIALOG_ICON_TOP_MARGIN (15) +static Lisp_Object +pop_down_dialog (arg) + Lisp_Object arg; +{ + struct Lisp_Save_Value *p = XSAVE_VALUE (arg); + WindowRef window = p->pointer; + + BLOCK_INPUT; + + if (popup_activated_flag) + EndAppModalStateForWindow (window); + DisposeWindow (window); + popup_activated_flag = 0; + + UNBLOCK_INPUT; + + return Qnil; +} + static int create_and_show_dialog (f, first_wv) FRAME_PTR f; @@ -2459,6 +2480,7 @@ create_and_show_dialog (f, first_wv) Rect empty_rect, *rects; WindowRef window = NULL; ControlRef *buttons, default_button = NULL, text; + int specpdl_count = SPECPDL_INDEX (); dialog_name = first_wv->name; nb_buttons = dialog_name[1] - '0'; @@ -2475,8 +2497,11 @@ create_and_show_dialog (f, first_wv) kWindowStandardHandlerAttribute, &empty_rect, &window); if (err == noErr) - err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground, - true); + { + record_unwind_protect (pop_down_dialog, make_save_value (window, 0)); + err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground, + true); + } if (err == noErr) err = SetWindowTitleWithCFString (window, (dialog_name[0] == 'Q' ? CFSTR ("Question") @@ -2701,7 +2726,45 @@ create_and_show_dialog (f, first_wv) SetWRefCon (window, 0); ShowWindow (window); BringToFront (window); - err = RunAppModalLoopForWindow (window); + popup_activated_flag = 1; + err = BeginAppModalStateForWindow (window); + } + if (err == noErr) + { + EventTargetRef toolbox_dispatcher = GetEventDispatcherTarget (); + + while (1) + { + EMACS_TIME next_time = timer_check (1); + long secs = EMACS_SECS (next_time); + long usecs = EMACS_USECS (next_time); + EventTimeout timeout; + EventRef event; + + if (secs < 0 || (secs == 0 && usecs == 0)) + { + /* Sometimes timer_check returns -1 (no timers) even if + there are timers. So do a timeout anyway. */ + secs = 1; + usecs = 0; + } + + timeout = (secs * kEventDurationSecond + + usecs * kEventDurationMicrosecond); + err = ReceiveNextEvent (0, NULL, timeout, kEventRemoveFromQueue, + &event); + if (err == noErr) + { + SendEventToEventTarget (event, toolbox_dispatcher); + ReleaseEvent (event); + } + else if (err != eventLoopTimedOutErr) + { + if (err == eventLoopQuitErr) + err = noErr; + break; + } + } } if (err == noErr) { @@ -2711,8 +2774,7 @@ create_and_show_dialog (f, first_wv) result = DIALOG_BUTTON_COMMAND_ID_VALUE (command_id); } - if (window) - DisposeWindow (window); + unbind_to (specpdl_count, Qnil); return result; } @@ -3282,9 +3344,13 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_ doc: /* Return t if a menu or popup dialog is active. */) () { +#if TARGET_API_MAC_CARBON + return (popup_activated ()) ? Qt : Qnil; +#else /* Always return Qnil since menu selection functions do not return until a selection has been made or cancelled. */ return Qnil; +#endif } void diff --git a/src/macterm.c b/src/macterm.c index a5bf2365145..f9b521035d9 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -2196,11 +2196,12 @@ x_draw_fringe_bitmap (w, row, p) Display *display = FRAME_MAC_DISPLAY (f); struct face *face = p->face; int rowY; + int overlay_p = p->overlay_p; #ifdef MAC_OSX - if (p->bx >= 0 && !p->overlay_p) + if (!overlay_p) { - int bx = p->bx, nx = p->nx; + int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; #if 0 /* MAC_TODO: stipple */ /* In case the same realized face is used for fringes and @@ -2229,17 +2230,40 @@ x_draw_fringe_bitmap (w, row, p) int width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * FRAME_COLUMN_WIDTH (f)); - if (left + width == bx) + if (bx < 0 + && (left + width == p->x + || p->x + p->wd == left)) { - bx = left + sb_width; - nx += width - sb_width; + /* Bitmap fills the fringe and we need background + extension. */ + int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w); + + bx = p->x; + nx = p->wd; + by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height, + row->y)); + ny = row->visible_height; + } + + if (bx >= 0) + { + if (left + width == bx) + { + bx = left + sb_width; + nx += width - sb_width; + } + else if (bx + nx == left) + nx += width - sb_width; } - else if (bx + nx == left) - nx += width - sb_width; } } - mac_erase_rectangle (f, face->gc, bx, p->by, nx, p->ny); + if (bx >= 0) + { + mac_erase_rectangle (f, face->gc, bx, by, nx, ny); + /* The fringe background has already been filled. */ + overlay_p = 1; + } #if 0 /* MAC_TODO: stipple */ if (!face->stipple) @@ -2304,10 +2328,10 @@ x_draw_fringe_bitmap (w, row, p) : face->foreground)); #if USE_CG_DRAWING mac_draw_cg_image (fringe_bmp[p->which], f, face->gc, 0, p->dh, - p->wd, p->h, p->x, p->y, p->overlay_p); + p->wd, p->h, p->x, p->y, overlay_p); #else mac_draw_bitmap (f, face->gc, p->x, p->y, - p->wd, p->h, p->bits + p->dh, p->overlay_p); + p->wd, p->h, p->bits + p->dh, overlay_p); #endif XSetForeground (display, face->gc, gcv.foreground); } @@ -11161,7 +11185,7 @@ mac_handle_text_input_event (next_handler, event, data) EventRef event; void *data; { - OSStatus result, err = noErr; + OSStatus err, result; Lisp_Object id_key = Qnil; int num_params; const EventParamName *names; @@ -11222,6 +11246,7 @@ mac_handle_text_input_event (next_handler, event, data) SetEventParameter (event, EVENT_PARAM_TEXT_INPUT_SEQUENCE_NUMBER, typeUInt32, sizeof (UInt32), &seqno_uaia); seqno_uaia++; + result = noErr; break; case kEventTextInputUnicodeForKeyEvent: @@ -11239,7 +11264,7 @@ mac_handle_text_input_event (next_handler, event, data) if (err == noErr && mac_mapped_modifiers (modifiers)) /* There're mapped modifier keys. Process it in do_keystroke. */ - return eventNotHandledErr; + break; if (err == noErr) err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, typeUnicodeText, NULL, 0, &actual_size, @@ -11278,16 +11303,20 @@ mac_handle_text_input_event (next_handler, event, data) XSETFRAME (read_socket_inev->frame_or_window, f); } } - return eventNotHandledErr; + break; } } + if (err == noErr) + { + /* Non-ASCII keystrokes without mapped modifiers are + processed at the Lisp level. */ + id_key = Qunicode_for_key_event; + num_params = sizeof (names_ufke) / sizeof (names_ufke[0]); + names = names_ufke; + types = types_ufke; + result = noErr; + } } - /* Non-ASCII keystrokes without mapped modifiers are processed - at the Lisp level. */ - id_key = Qunicode_for_key_event; - num_params = sizeof (names_ufke) / sizeof (names_ufke[0]); - names = names_ufke; - types = types_ufke; break; case kEventTextInputOffsetToPos: @@ -11297,22 +11326,24 @@ mac_handle_text_input_event (next_handler, event, data) Point p; if (!OVERLAYP (Vmac_ts_active_input_overlay)) - return eventNotHandledErr; + break; /* Strictly speaking, this is not always correct because previous events may change some states about display. */ - if (NILP (Foverlay_get (Vmac_ts_active_input_overlay, Qbefore_string))) + if (!NILP (Foverlay_get (Vmac_ts_active_input_overlay, Qbefore_string))) + { + /* Active input area is displayed around the current point. */ + f = SELECTED_FRAME (); + w = XWINDOW (f->selected_window); + } + else if (WINDOWP (echo_area_window)) { /* Active input area is displayed in the echo area. */ w = XWINDOW (echo_area_window); f = WINDOW_XFRAME (w); } else - { - /* Active input area is displayed around the current point. */ - f = SELECTED_FRAME (); - w = XWINDOW (f->selected_window); - } + break; p.h = (WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x) + WINDOW_LEFT_FRINGE_WIDTH (w) @@ -11322,6 +11353,8 @@ mac_handle_text_input_event (next_handler, event, data) + f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f)); err = SetEventParameter (event, kEventParamTextInputReplyPoint, typeQDPoint, sizeof (typeQDPoint), &p); + if (err == noErr) + result = noErr; } break; @@ -11333,9 +11366,6 @@ mac_handle_text_input_event (next_handler, event, data) err = mac_store_event_ref_as_apple_event (0, 0, Qtext_input, id_key, event, num_params, names, types); - if (err == noErr) - result = noErr; - return result; } #endif diff --git a/src/minibuf.c b/src/minibuf.c index f275414d3aa..9a62598cf31 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1717,9 +1717,15 @@ PREDICATE limits completion to a subset of COLLECTION. See `try-completion' and `all-completions' for more details on completion, COLLECTION, and PREDICATE. -If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of COLLECTION or is null. - If it is also not t, typing RET does not exit if it does non-null completion. +REQUIRE-MATCH can take the following values: +- t means that the user is not allowed to exit unless + the input is (or completes to) an element of COLLECTION or is null. +- nil means that the user can exit with any input. +- `confirm-only' means that the user can exit with any input, but she will + need to confirm her choice if the input is not an element of COLLECTION. +- anything else behaves like t except that typing RET does not exit if it + does non-null completion. + If the input is null, `completing-read' returns DEF, or an empty string if DEF is nil, regardless of the value of REQUIRE-MATCH. @@ -2230,6 +2236,18 @@ a repetition of this command will exit. */) goto exit; } + if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only"))) + { /* The user is permitted to exit with an input that's rejected + by test-completion, but at the condition to confirm her choice. */ + if (EQ (current_kboard->Vlast_command, Vthis_command)) + goto exit; + else + { + temp_echo_area_glyphs (build_string (" [Confirm]")); + return Qnil; + } + } + /* Call do_completion, but ignore errors. */ SET_PT (ZV); val = internal_condition_case (complete_and_exit_1, Qerror, diff --git a/src/w32.c b/src/w32.c index 2d52b84af4c..206be4fa4e5 100644 --- a/src/w32.c +++ b/src/w32.c @@ -113,7 +113,7 @@ extern int w32_num_mouse_buttons; /* - Initialization states + Initialization states */ static BOOL g_b_init_is_windows_9x; static BOOL g_b_init_open_process_token; @@ -1155,7 +1155,9 @@ init_environment (char ** argv) { int dont_free = 0; - if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL) + if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL + /* Also ignore empty environment variables. */ + || *lpval == 0) { lpval = env_vars[i].def_value; dwType = REG_EXPAND_SZ; @@ -2526,7 +2528,7 @@ stat (const char * path, struct stat * buf) != INVALID_HANDLE_VALUE) { /* This is more accurate in terms of gettting the correct number - of links, but is quite slow (it is noticable when Emacs is + of links, but is quite slow (it is noticeable when Emacs is making a list of file name completions). */ BY_HANDLE_FILE_INFORMATION info; @@ -3011,7 +3013,7 @@ struct { WSAEINVALIDPROCTABLE , "Invalid procedure table from service provider", WSAEINVALIDPROVIDER , "Invalid service provider version number", WSAEPROVIDERFAILEDINIT , "Unable to initialize a service provider", - WSASYSCALLFAILURE , "System call failured", + WSASYSCALLFAILURE , "System call failure", WSASERVICE_NOT_FOUND , "Service not found", /* not sure */ WSATYPE_NOT_FOUND , "Class type not found", WSA_E_NO_MORE , "No more resources available", /* really not sure */ @@ -4210,7 +4212,7 @@ globals_of_w32 () SetConsoleCtrlHandler(shutdown_handler, TRUE); } -/* end of nt.c */ +/* end of w32.c */ /* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 (do not change this comment) */ diff --git a/src/w32bdf.c b/src/w32bdf.c index 316254eb7f9..2fdfba8bfb4 100644 --- a/src/w32bdf.c +++ b/src/w32bdf.c @@ -302,7 +302,7 @@ w32_free_bdf_font(bdffont *fontp) font_char *pch; cache_bitmap *pcb; - UnmapViewOfFile(fontp->hfilemap); + UnmapViewOfFile(fontp->font); CloseHandle(fontp->hfilemap); CloseHandle(fontp->hfile); @@ -867,6 +867,7 @@ int w32_BDF_to_x_font (char *file, char* xstr, int len) retval = 1; } } + UnmapViewOfFile (font); CloseHandle (hfile); CloseHandle (hfilemap); return retval; diff --git a/src/w32menu.c b/src/w32menu.c index f33442244ce..03cd307f925 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -2292,29 +2292,53 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) /* Quote any special characters within the menu item's text and key binding. */ nlen = orig_len = strlen (out_string); - for (p = out_string; *p; p = _mbsinc (p)) - { - if (_mbsnextc (p) == '&') - nlen++; - } + if (unicode_append_menu) + { + /* With UTF-8, & cannot be part of a multibyte character. */ + for (p = out_string; *p; p++) + { + if (*p == '&') + nlen++; + } + } + else + { + /* If encoded with the system codepage, use multibyte string + functions in case of multibyte characters that contain '&'. */ + for (p = out_string; *p; p = _mbsinc (p)) + { + if (_mbsnextc (p) == '&') + nlen++; + } + } + if (nlen > orig_len) - { - p = out_string; - out_string = alloca (nlen + 1); - q = out_string; - while (*p) - { - if (_mbsnextc (p) == '&') - { - _mbsncpy (q, p, 1); - q = _mbsinc (q); - } - _mbsncpy (q, p, 1); - p = _mbsinc (p); - q = _mbsinc (q); - } - *q = '\0'; - } + { + p = out_string; + out_string = alloca (nlen + 1); + q = out_string; + while (*p) + { + if (unicode_append_menu) + { + if (*p == '&') + *q++ = *p; + *q++ = *p++; + } + else + { + if (_mbsnextc (p) == '&') + { + _mbsncpy (q, p, 1); + q = _mbsinc (q); + } + _mbsncpy (q, p, 1); + p = _mbsinc (p); + q = _mbsinc (q); + } + } + *q = '\0'; + } if (item != NULL) fuFlags = MF_POPUP; diff --git a/src/w32term.c b/src/w32term.c index bd7f36c1094..03bee91e7b2 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -249,10 +249,9 @@ extern int errno; extern EMACS_INT extra_keyboard_modifiers; static void x_update_window_end P_ ((struct window *, int, int)); -void w32_delete_display P_ ((struct w32_display_info *)); static void w32_handle_tool_bar_click P_ ((struct frame *, struct input_event *)); -void w32_define_cursor P_ ((Window, Cursor)); +static void w32_define_cursor P_ ((Window, Cursor)); void x_lower_frame P_ ((struct frame *)); void x_scroll_bar_clear P_ ((struct frame *)); @@ -261,7 +260,7 @@ void x_raise_frame P_ ((struct frame *)); void x_set_window_size P_ ((struct frame *, int, int, int)); void x_wm_set_window_state P_ ((struct frame *, int)); void x_wm_set_icon_pixmap P_ ((struct frame *, int)); -void w32_initialize P_ ((void)); +static void w32_initialize P_ ((void)); static void x_font_min_bounds P_ ((XFontStruct *, int *, int *)); int x_compute_min_glyph_bounds P_ ((struct frame *)); static void x_update_end P_ ((struct frame *)); @@ -3715,7 +3714,7 @@ redo_mouse_highlight () HIWORD (last_mouse_motion_event.lParam)); } -void +static void w32_define_cursor (window, cursor) Window window; Cursor cursor; @@ -6868,7 +6867,7 @@ static struct redisplay_interface w32_redisplay_interface = w32_shift_glyphs_for_insert }; -void +static void w32_initialize () { rif = &w32_redisplay_interface; diff --git a/src/xdisp.c b/src/xdisp.c index 9477ea76aee..05898c51512 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24443,7 +24443,7 @@ unselects the minibuffer if it is active. */); This dynamically changes the tool-bar's height to the minimum height that is needed to make all tool-bar items visible. If value is `grow-only', the tool-bar's height is only increased -automatically; to decreace the tool-bar height, use \\[recenter]. */); +automatically; to decrease the tool-bar height, use \\[recenter]. */); Vauto_resize_tool_bars = Qt; DEFVAR_BOOL ("auto-raise-tool-bar-buttons", &auto_raise_tool_bar_buttons_p, |