# HG changeset patch # User Miles Bader # Date 1183968055 0 # Node ID 988f1edc9674e126093ab6675e09422496807d89 # Parent f866074aedc44bce8883da1efb7fdd6a6a61c57f# Parent 44b53335982adb65f9fa1751c2952a7faabe4ff8 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 diff -r f866074aedc4 -r 988f1edc9674 ChangeLog --- a/ChangeLog Sun Jul 08 18:09:12 2007 +0000 +++ b/ChangeLog Mon Jul 09 08:00:55 2007 +0000 @@ -1,3 +1,12 @@ +2007-06-20 Jan Dj,Ad(Brv + + * configure.in: Complain if X seems to be installed but no + development files were found. + +2007-06-20 Glenn Morris + + * configure.in: Prefer libgif over libungif. + 2007-06-14 Jan Dj,Ad(Brv * 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 - - * ediff-ptch.el (ediff-context-diff-label-regexp): partially undid - previous patch - 2007-06-13 Chong Yidong * configure.in: Merge xaw3d and libXaw checks. Check xaw3d even diff -r f866074aedc4 -r 988f1edc9674 configure --- a/configure Sun Jul 08 18:09:12 2007 +0000 +++ b/configure Mon Jul 09 08:00:55 2007 +0000 @@ -686,6 +686,7 @@ CFLAGS_SOUND SET_MAKE XMKMF +HAVE_XSERVER GTK_CFLAGS GTK_LIBS XFT_CFLAGS @@ -1345,7 +1346,7 @@ --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 @@ ;; 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,6 +14333,83 @@ 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 -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="-lgif $LIBS" +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char EGifPutExtensionLast (); +int +main () +{ +return EGifPutExtensionLast (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + ac_cv_lib_gif_EGifPutExtensionLast=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + 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_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_libungif=yes +fi + +fi + + + + if test "$HAVE_GIF" = yes; then + ac_gif_lib_name="-lgif" + fi + +# 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 @@ -14333,93 +14473,16 @@ echo "${ECHO_T}$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } if test $ac_cv_lib_ungif_EGifPutExtensionLast = yes; then HAVE_GIF=yes -else - try_libgif=yes -fi - -fi - - - - if test "$HAVE_GIF" = yes; then - ac_gif_lib_name="-lungif" - 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 - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgif $LIBS" -cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char EGifPutExtensionLast (); -int -main () -{ -return EGifPutExtensionLast (); - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext conftest$ac_exeext -if { (ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 - (eval "$ac_link") 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && - $as_test_x conftest$ac_exeext; then - ac_cv_lib_gif_EGifPutExtensionLast=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - 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_gif_EGifPutExtensionLast" >&5 -echo "${ECHO_T}$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test $ac_cv_lib_gif_EGifPutExtensionLast = yes; then - HAVE_GIF=yes fi if test "$HAVE_GIF" = yes; then cat >>confdefs.h <<\_ACEOF -#define LIBGIF -lgif -_ACEOF - - ac_gif_lib_name="-lgif" +#define LIBGIF -lungif +_ACEOF + + ac_gif_lib_name="-lungif" fi fi @@ -24601,6 +24664,7 @@ 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 @@ 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 @@ 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 -r f866074aedc4 -r 988f1edc9674 configure.in --- a/configure.in Sun Jul 08 18:09:12 2007 +0000 +++ b/configure.in Mon Jul 09 08:00:55 2007 +0000 @@ -105,7 +105,7 @@ 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 @@ ;; 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 @@ 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 -r f866074aedc4 -r 988f1edc9674 etc/ChangeLog --- a/etc/ChangeLog Sun Jul 08 18:09:12 2007 +0000 +++ b/etc/ChangeLog Mon Jul 09 08:00:55 2007 +0000 @@ -1,3 +1,19 @@ +2007-07-07 Michael Albinus + + * NEWS: New function `start-file-process'. + +2007-07-02 Carsten Dominik + + * orgcard.tex: Version 5.01 + +2007-06-27 Michael Albinus + + * NEWS: `dired-call-process' has been removed. + +2007-06-20 Glenn Morris + + * NEWS: configure prefers libgif over libungif. + 2007-06-14 Nick Roberts * NEWS: Mention mouse highlighting in a GNU/Linux console. diff -r f866074aedc4 -r 988f1edc9674 etc/NEWS --- a/etc/NEWS Sun Jul 08 18:09:12 2007 +0000 +++ b/etc/NEWS Mon Jul 09 08:00:55 2007 +0000 @@ -28,17 +28,24 @@ ** 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 @@ ** 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 @@ 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 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. + +*** 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 @@ * 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 \(?:\) specifies the group number explicitly. @@ -91,6 +121,11 @@ ** 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 -r f866074aedc4 -r 988f1edc9674 etc/NEWS.22 --- a/etc/NEWS.22 Sun Jul 08 18:09:12 2007 +0000 +++ b/etc/NEWS.22 Mon Jul 09 08:00:55 2007 +0000 @@ -50,8 +50,14 @@ ** 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 @@ 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 -r f866074aedc4 -r 988f1edc9674 etc/orgcard.tex --- a/etc/orgcard.tex Sun Jul 08 18:09:12 2007 +0000 +++ b/etc/orgcard.tex Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ \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 @@ \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 @@ {\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 -r f866074aedc4 -r 988f1edc9674 lisp/ChangeLog --- a/lisp/ChangeLog Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ChangeLog Mon Jul 09 08:00:55 2007 +0000 @@ -1,14 +1,140 @@ -2007-07-08 Chong Yidong - - * 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. +2007-07-08 Martin Rudalics + + * novice.el (disabled-command-function): Fit window to buffer to + make last line visible. + Reported by Stephen Berman . + + * mouse.el (mouse-drag-track): Reset transient-mark-mode to nil + when handling the terminating event. + +2007-07-07 Jay Belanger + + * 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 + + * vc.el (vc-annotate): Jump to line and output message only after the + process is really all done. + +2007-07-07 Stefan Monnier + + * 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 + + * term/w32-win.el (menu-bar-open): New function. + Bind to it. + +2007-07-07 Michael Albinus + + * simple.el (start-file-process): New defun. + +2007-07-07 Stefan Monnier + + * 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 + + * calc/calc.el (math-read-number): Replace number by variable. + (math-read-number-simple): Properly parse small integers. + +2007-07-07 Dan Nicolaescu + + * vc.el: Fix doc for the checkout function. + +2007-07-06 Dan Nicolaescu + + * 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 + + * emacs-lisp/lisp-mode.el (eval-last-sexp): Avoid introducing any + dynamic bindings around the evaluation of the expression. + Reported by Jay Belanger . + +2007-07-06 Stefan Monnier + + * autorevert.el (auto-revert-tail-handler): Use inhibit-read-only. + Run before-revert-hook. Suggested by Denis Bueno . + Use run-hooks rather than run-mode-hooks. + +2007-07-05 Jay Belanger + + * 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 - * 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 + + * emacs-lisp/byte-opt.el: Revert last change. + +2007-07-05 Dan Nicolaescu + + * 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 + + * complete.el (PC-do-complete-and-exit): Add support for the new + `confirm-only' confirmation mode. + +2007-07-05 Chong Yidong * 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 + + * 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 + + * 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 + + * calculator.el (calculator-expt): Use more cases to determine + the value. + +2007-07-03 Jay Belanger + + * 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 + + * 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 + + * files.el (make-directory): Doc fix. + (find-file-confirm-inexistent-file): Make it a defcustom. + Make nil the default. + +2007-07-02 Richard Stallman + + * startup.el (command-line): Set buffer-offer-save in *scratch* + and enable auto-save in it. + +2007-07-02 Carsten Dominik + + * 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 + + * 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 + + * cus-start.el (max-mini-window-height): Added. + +2007-07-01 Sean O'Rourke (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 + + * 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 + + * 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 + + * emacs-lisp/rx.el (rx-constituents): Fix up `anything'. + +2007-06-29 Juanma Barranquero + + * 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 + + * 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 + + * font-lock.el (lisp-font-lock-keywords-2): Recognize the new \(?1:..\) + syntax as well. Reported by Juri Linkov . + +2007-06-28 Jan Dj,Ad(Brv + + * dnd.el (dnd-get-local-file-name): Set fixcase to t in call to + replace-regexp-in-string. + +2007-06-28 Stefan Monnier + + * 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 + + * Makefile.in ($(lisp)/mh-e/mh-loaddefs.el): Depend on + $(lisp)/subdirs.el. + +2007-06-28 Juanma Barranquero + + * 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 . + +2007-06-28 Kevin Ryde + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * calc/calc-poly.el (math-padded-polynomial) + (math-partial-fractions): Add some function comments. + +2007-06-25 Stefan Monnier + + * emacs-lisp/autoload.el (autoload-generate-file-autoloads): + Make `outbuf' optional. + (update-file-autoloads): Use it. + +2007-06-25 Stefan Monnier + + * 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 + + * 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 + + * 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 + + * 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 + + * simple.el (next-error-recenter): Accept `(4)' as well; + also, specify `integer' instead of `number'. + +2007-06-23 Eli Zaretskii + + * 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 + + * ruler-mode.el (ruler-mode): Prevent clobbering the original + `header-line-format' when reentering ruler mode. + +2007-06-23 Eli Zaretskii + + * ls-lisp.el (insert-directory): Don't treat FILE as a wildcard if + FILE exists as a file. + +2007-06-22 Jay Belanger + + * 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 + + * log-view.el (log-view-mode-menu): New menu. + +2007-06-22 Stefan Monnier + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * calc/calc.el (math-read-number-simple): New function. + +2007-06-21 Stefan Monnier + + * 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 + + * 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 + + * 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 + + * calc/calc.el (math-standard-ops): Fix precedence of multiplication. + +2007-06-20 Stefan Monnier + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * progmodes/vera-mode.el: New file. + +2007-06-19 Jay Belanger + + * 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 + + * vc-hg.el: New file. + +2007-06-18 Stefan Monnier + + * progmodes/sh-script.el (sh-font-lock-paren): Mark the relevant text + with font-lock-multiline. + +2007-06-17 Glenn Morris + + * lpr.el (lpr-page-header-switches): Move %s to separate element + for correct quoting. Doc fix. + +2007-06-17 Stefan Monnier + + * 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 * thingatpt.el (thing-at-point-email-regexp): Don't require two @@ -51,16 +804,15 @@ 2007-06-15 Masatake YAMATO - * 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 - * 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 @@ -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 @@ -97,8 +849,8 @@ 2007-06-14 Michael Kifer * 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 @@ -193,6 +945,11 @@ * vc-arch.el (vc-arch-command): Remove bzr. It's a different program. +2007-06-13 Michael Kifer + + * ediff-ptch.el (ediff-context-diff-label-regexp): Partially undo + previous change. + 2007-06-12 Tom Tromey * 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 * 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 -r f866074aedc4 -r 988f1edc9674 lisp/ChangeLog.12 --- a/lisp/ChangeLog.12 Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ChangeLog.12 Mon Jul 09 08:00:55 2007 +0000 @@ -2595,7 +2595,7 @@ path. Rewrite function in `cond' style for readability. Suggested by: Stephen Eglen . - (The path shortening, that is, not the rearrarangement.) + (The path shortening, that is, not the rearrangement.) 2007-01-15 YAMAMOTO Mitsuharu @@ -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 @@ -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 - * 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) : Add a header-mouse-map + (name, size, mode) : Add a header-mouse-map property. 2006-04-02 Drew Adams (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 * 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 . * 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 -r f866074aedc4 -r 988f1edc9674 lisp/Makefile.in --- a/lisp/Makefile.in Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/Makefile.in Mon Jul 09 08:00:55 2007 +0000 @@ -241,7 +241,7 @@ $(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 @@ # 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 @@ 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 -r f866074aedc4 -r 988f1edc9674 lisp/add-log.el --- a/lisp/add-log.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/add-log.el Mon Jul 09 08:00:55 2007 +0000 @@ -695,7 +695,8 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/autorevert.el --- a/lisp/autorevert.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/autorevert.el Mon Jul 09 08:00:55 2007 +0000 @@ -447,20 +447,21 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-aent.el --- a/lisp/calc/calc-aent.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-aent.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ 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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-bin.el --- a/lisp/calc/calc-bin.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-bin.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-comb.el --- a/lisp/calc/calc-comb.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-comb.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-embed.el --- a/lisp/calc/calc-embed.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-embed.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-ext.el --- a/lisp/calc/calc-ext.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-ext.el Mon Jul 09 08:00:55 2007 +0000 @@ -1878,8 +1878,19 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-forms.el --- a/lisp/calc/calc-forms.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-forms.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-funcs.el --- a/lisp/calc/calc-funcs.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-funcs.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-lang.el --- a/lisp/calc/calc-lang.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-lang.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-math.el --- a/lisp/calc/calc-math.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-math.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-misc.el --- a/lisp/calc/calc-misc.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-misc.el Mon Jul 09 08:00:55 2007 +0000 @@ -579,7 +579,7 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-poly.el --- a/lisp/calc/calc-poly.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-poly.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-prog.el --- a/lisp/calc/calc-prog.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-prog.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc-yank.el --- a/lisp/calc/calc-yank.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc-yank.el Mon Jul 09 08:00:55 2007 +0000 @@ -559,7 +559,7 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calc.el --- a/lisp/calc/calc.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calc.el Mon Jul 09 08:00:55 2007 +0000 @@ -401,6 +401,13 @@ :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 @@ - +(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 @@ ;;; 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 @@ (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 @@ 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ ((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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (> (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 @@ ;; 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 @@ ( "!" 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 @@ ( "::" 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 -r f866074aedc4 -r 988f1edc9674 lisp/calc/calccomp.el --- a/lisp/calc/calccomp.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calc/calccomp.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/calculator.el --- a/lisp/calculator.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/calculator.el Mon Jul 09 08:00:55 2007 +0000 @@ -278,7 +278,7 @@ ("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 @@ `+' 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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/complete.el --- a/lisp/complete.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/complete.el Mon Jul 09 08:00:55 2007 +0000 @@ -222,13 +222,6 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/cus-start.el --- a/lisp/cus-start.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/cus-start.el Mon Jul 09 08:00:55 2007 +0000 @@ -142,6 +142,9 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/desktop.el --- a/lisp/desktop.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/desktop.el Mon Jul 09 08:00:55 2007 +0000 @@ -626,9 +626,7 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/diff-mode.el --- a/lisp/diff-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/diff-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -338,7 +338,7 @@ ("^--- .+ ----$" . 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 -r f866074aedc4 -r 988f1edc9674 lisp/dired-aux.el --- a/lisp/dired-aux.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/dired-aux.el Mon Jul 09 08:00:55 2007 +0000 @@ -582,18 +582,6 @@ ;; 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 @@ (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 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/autoload.el --- a/lisp/emacs-lisp/autoload.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/autoload.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ ;; 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 @@ "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 @@ (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 @@ (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 @@ 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) + (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 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)))) +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) - (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))) + (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)))))) + ;; 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))) + (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 @@ 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)) + (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))) - (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 @@ 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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/cl-extra.el --- a/lisp/emacs-lisp/cl-extra.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/cl-extra.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ ;;; 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 @@ ;;; Control structures. +;;;###autoload (defun cl-mapcar-many (cl-func cl-seqs) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) @@ -119,6 +122,7 @@ 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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ ;;; 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 @@ ;;; 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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ ;; 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 @@ ;; 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 @@ (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 @@ ((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 @@ (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 @@ ;;; 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 @@ (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 @@ ;;; 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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/cl-loaddefs.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/emacs-lisp/cl-loaddefs.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/cl-macs.el --- a/lisp/emacs-lisp/cl-macs.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/cl-macs.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ ;;; 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 @@ (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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ ;;; 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 @@ '(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 @@ 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 @@ ;; 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 @@ (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 @@ 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 @@ 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 @@ ;;; 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 @@ 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 @@ ;;; 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 @@ (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 @@ ;;; 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ ;;; 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 @@ 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 @@ ((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 @@ (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 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/cl-seq.el --- a/lisp/emacs-lisp/cl-seq.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/cl-seq.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ 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 @@ \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 @@ \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 @@ 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 @@ \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 @@ \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 @@ (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 @@ (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 @@ \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 @@ \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 @@ (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 @@ \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 @@ \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 @@ (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 @@ \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 @@ \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 @@ (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 @@ \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 @@ \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 @@ (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 @@ (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 @@ (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 @@ (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 @@ \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 @@ (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 @@ (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 @@ \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 @@ \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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ \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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ \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 @@ \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 @@ \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 @@ \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 @@ \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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/cl.el --- a/lisp/emacs-lisp/cl.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/cl.el Mon Jul 09 08:00:55 2007 +0000 @@ -113,8 +113,9 @@ (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 @@ ;;; 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 @@ (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 @@ (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 @@ ;;; Miscellaneous. -(defvar cl-fake-autoloads nil - "Non-nil means don't make CL functions autoload.") +;; 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. +;; 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 "" (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))) +(load "cl-loaddefs") -;;; 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. +;; 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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/lisp-mode.el --- a/lisp/emacs-lisp/lisp-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/lisp-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -628,13 +628,13 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/emacs-lisp/rx.el --- a/lisp/emacs-lisp/rx.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/emacs-lisp/rx.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 -r f866074aedc4 -r 988f1edc9674 lisp/ffap.el --- a/lisp/ffap.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ffap.el Mon Jul 09 08:00:55 2007 +0000 @@ -1793,7 +1793,11 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/files.el --- a/lisp/files.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/files.el Mon Jul 09 08:00:55 2007 +0000 @@ -1051,6 +1051,12 @@ ,@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 @@ 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 @@ 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 @@ 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 @@ "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 @@ "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 @@ "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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/font-lock.el --- a/lisp/font-lock.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/font-lock.el Mon Jul 09 08:00:55 2007 +0000 @@ -2288,7 +2288,7 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/generic-x.el --- a/lisp/generic-x.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/generic-x.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ "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 @@ (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 @@ 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 -r f866074aedc4 -r 988f1edc9674 lisp/help-mode.el --- a/lisp/help-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/help-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -487,7 +487,7 @@ ;; 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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/ido.el --- a/lisp/ido.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ido.el Mon Jul 09 08:00:55 2007 +0000 @@ -3994,8 +3994,7 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/log-edit.el --- a/lisp/log-edit.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/log-edit.el Mon Jul 09 08:00:55 2007 +0000 @@ -590,25 +590,23 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/log-view.el --- a/lisp/log-view.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/log-view.el Mon Jul 09 08:00:55 2007 +0000 @@ -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:.*\\)\\)?") - "\\)$")) + "\\)$") + "Regexp matching the text identifying a revision. +The match group number 1 should match the revision number itself.") -(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))) +(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 -r f866074aedc4 -r 988f1edc9674 lisp/lpr.el --- a/lisp/lpr.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/lpr.el Mon Jul 09 08:00:55 2007 +0000 @@ -140,9 +140,10 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/ls-lisp.el --- a/lisp/ls-lisp.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ls-lisp.el Mon Jul 09 08:00:55 2007 +0000 @@ -216,6 +216,7 @@ ;; 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 @@ ;; `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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/mouse.el --- a/lisp/mouse.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/mouse.el Mon Jul 09 08:00:55 2007 +0000 @@ -433,9 +433,8 @@ ;; - 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 @@ ((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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/net/ange-ftp.el --- a/lisp/net/ange-ftp.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/net/ange-ftp.el Mon Jul 09 08:00:55 2007 +0000 @@ -4360,7 +4360,7 @@ ;; 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 @@ ;; 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 @@ 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 -r f866074aedc4 -r 988f1edc9674 lisp/net/rcirc.el --- a/lisp/net/rcirc.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/net/rcirc.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ 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 @@ :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 @@ ;;;###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 @@ 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 @@ (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 @@ (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 @@ 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 @@ (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 @@ ;; 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 @@ process)))))) (defun rcirc-delete-process (process) - (message "delete process %S" process) (delete-process process)) (defvar rcirc-trap-errors-flag t) @@ -1162,7 +1186,7 @@ :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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/novice.el --- a/lisp/novice.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/novice.el Mon Jul 09 08:00:55 2007 +0000 @@ -88,8 +88,9 @@ 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 -r f866074aedc4 -r 988f1edc9674 lisp/pcvs-util.el --- a/lisp/pcvs-util.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/pcvs-util.el Mon Jul 09 08:00:55 2007 +0000 @@ -186,35 +186,6 @@ "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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/pcvs.el --- a/lisp/pcvs.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/pcvs.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/progmodes/cc-mode.el --- a/lisp/progmodes/cc-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/progmodes/cc-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -790,7 +790,8 @@ ;; 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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/progmodes/gud.el --- a/lisp/progmodes/gud.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/progmodes/gud.el Mon Jul 09 08:00:55 2007 +0000 @@ -2462,7 +2462,7 @@ ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/progmodes/hideshow.el --- a/lisp/progmodes/hideshow.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/progmodes/hideshow.el Mon Jul 09 08:00:55 2007 +0000 @@ -508,8 +508,8 @@ (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 @@ '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 @@ (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 @@ 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 (> (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 @@ (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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/progmodes/sh-script.el --- a/lisp/progmodes/sh-script.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/progmodes/sh-script.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 June 1999. ;;; Code: @@ -1052,7 +1058,18 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/progmodes/vera-mode.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/vera-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 +;; Maintainer: Reto Zimmermann +;; 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 "") 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 . + +Official distribution is at +. + + + The Vera Mode Maintainer + Reto Zimmermann + +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 "\\") + (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 "\\")))))) + (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 "\\")) + ;; 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 "\\|\\"))) + (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 " + "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 -r f866074aedc4 -r 988f1edc9674 lisp/ps-mule.el --- a/lisp/ps-mule.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ps-mule.el Mon Jul 09 08:00:55 2007 +0000 @@ -1233,5 +1233,9 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/ps-print.el --- a/lisp/ps-print.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ps-print.el Mon Jul 09 08:00:55 2007 +0000 @@ -3638,7 +3638,7 @@ ;; 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 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. - -(autoload 'ps-mule-initialize "ps-mule" - "Initialize global data for printing multi-byte characters.") - -(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.") - -(autoload 'ps-mule-begin-page "ps-mule" - "Initialize multi-byte charset for printing current page.") - -(autoload 'ps-mule-end-job "ps-mule" - "Finish printing job for multi-byte chars.") - + +;;;### (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 (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. + +\(fn FROM TO)" nil nil) + +(autoload (quote ps-mule-begin-page) "ps-mule" "\ +Not documented + +\(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 -r f866074aedc4 -r 988f1edc9674 lisp/ruler-mode.el --- a/lisp/ruler-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/ruler-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/shell.el --- a/lisp/shell.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/shell.el Mon Jul 09 08:00:55 2007 +0000 @@ -5,7 +5,7 @@ ;; Author: Olin Shivers ;; Simon Marshall -;; Maintainer: FSF +;; Maintainer: FSF ;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/simple.el --- a/lisp/simple.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/simple.el Mon Jul 09 08:00:55 2007 +0000 @@ -156,6 +156,15 @@ :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 @@ ;; 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 @@ ;; 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 @@ (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 @@ ;;;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/speedbar.el --- a/lisp/speedbar.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/speedbar.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 @@ (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 @@ "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 @@ ;; 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 @@ (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 @@ (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 @@ (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 @@ "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 @@ (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 @@ (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 @@ 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 -r f866074aedc4 -r 988f1edc9674 lisp/startup.el --- a/lisp/startup.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/startup.el Mon Jul 09 08:00:55 2007 +0000 @@ -1056,7 +1056,10 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/subr.el --- a/lisp/subr.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/subr.el Mon Jul 09 08:00:55 2007 +0000 @@ -2768,6 +2768,36 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/term/w32-win.el --- a/lisp/term/w32-win.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/term/w32-win.el Mon Jul 09 08:00:55 2007 +0000 @@ -1041,8 +1041,18 @@ ;;; 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 -r f866074aedc4 -r 988f1edc9674 lisp/textmodes/bibtex.el --- a/lisp/textmodes/bibtex.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/textmodes/bibtex.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ 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 @@ 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 @@ (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 @@ (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 @@ ;; 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 @@ (,(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 @@ (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 @@ 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 @@ (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 @@ (< (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 @@ "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 @@ 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 @@ 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 @@ "\\([\"{][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 @@ (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 @@ (<= (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 @@ (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 @@ (<= 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 @@ (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 @@ (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 @@ 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ ;; 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 @@ (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 @@ 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 @@ 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 @@ ;; 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 (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 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 @@ (,(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 @@ (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 @@ (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 @@ ;; ;; 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 @@ (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 @@ "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 -r f866074aedc4 -r 988f1edc9674 lisp/textmodes/nroff-mode.el --- a/lisp/textmodes/nroff-mode.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/textmodes/nroff-mode.el Mon Jul 09 08:00:55 2007 +0000 @@ -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 @@ (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 -r f866074aedc4 -r 988f1edc9674 lisp/textmodes/org.el --- a/lisp/textmodes/org.el Sun Jul 08 18:09:12 2007 +0000 +++ b/lisp/textmodes/org.el Mon Jul 09 08:00:55 2007 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; 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 @@ :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 @@ :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 @@ :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 @@ :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 @@ :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 @@ (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 @@ (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 @@ 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 @@ '("<%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 @@ (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 @@ (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 @@ (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 @@ :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 @@ (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 @@ :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 "