diff --git a/ChangeLog b/ChangeLog index 32fde8b0c4c..3a5797a7caa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2014-06-27 Glenn Morris + + * Makefile.in (src): No more need to pass BOOTSTRAPEMACS. + + * make-dist: Exclude test/automated/*.log. + +2014-06-26 Glenn Morris + + * Makefile.in (mostlyclean, clean): Maybe clean test/automated. + 2014-06-21 Paul Eggert * configure.ac: Warn about --enable-link-time-optimization's issues diff --git a/Makefile.in b/Makefile.in index 1a7acef0c5a..0fd9f980ca9 100644 --- a/Makefile.in +++ b/Makefile.in @@ -368,16 +368,6 @@ lisp: src lib lib-src lisp nt: Makefile $(MAKE) -C $@ all -# Pass to src/Makefile.in an additional BOOTSTRAPEMACS variable which -# is either set to bootstrap-emacs (in case bootstrap-emacs has not been -# constructed yet) or the empty string (otherwise). -# src/Makefile.in uses it to implement conditional dependencies, so that -# files that need bootstrap-emacs to be built do not additionally need -# to be kept fresher than bootstrap-emacs. Otherwise changing a single -# file src/foo.c forces dumping a new bootstrap-emacs, then re-byte-compiling -# all preloaded elisp files, and only then dump the actual src/emacs, which -# is not wrong, but is overkill in 99.99% of the cases. -# # Note the use of single quotes in the value of vcswitness. # This passes an unexpanded $srcdir to src's Makefile, which then # expands it using its own value of srcdir (which points to the @@ -386,10 +376,7 @@ src: Makefile dirstate='.bzr/checkout/dirstate'; \ vcswitness='$$(srcdir)/../'$$dirstate; \ [ -r "$(srcdir)/$$dirstate" ] || vcswitness=''; \ - cd $@ || exit; \ - boot=bootstrap-emacs$(EXEEXT); \ - [ ! -x "$$boot" ] || boot=''; \ - $(MAKE) all BOOTSTRAPEMACS="$$boot" VCSWITNESS="$$vcswitness" + $(MAKE) -C $@ all VCSWITNESS="$$vcswitness" blessmail: Makefile src $(MAKE) -C lib-src maybe-blessmail @@ -798,7 +785,9 @@ mostlyclean_dirs = src oldXMenu lwlib lib lib-src nt doc/emacs doc/misc \ $(foreach dir,$(mostlyclean_dirs),$(eval $(call submake_template,$(dir),mostlyclean))) mostlyclean: $(mostlyclean_dirs:=_mostlyclean) - + for dir in test/automated; do \ + [ ! -d $$dir ] || $(MAKE) -C $$dir mostlyclean; \ + done ### `clean' ### Delete all files from the current directory that are normally @@ -813,6 +802,9 @@ clean_dirs = $(mostlyclean_dirs) nextstep $(foreach dir,$(clean_dirs),$(eval $(call submake_template,$(dir),clean))) clean: $(clean_dirs:=_clean) + for dir in test/automated; do \ + [ ! -d $$dir ] || $(MAKE) -C $$dir clean; \ + done -rm -f etc/emacs.tmpdesktop ### `bootclean' diff --git a/admin/ChangeLog b/admin/ChangeLog index bdf317fa2de..d96368c4f9a 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,29 @@ +2014-06-26 Eli Zaretskii + + * notes/unicode: Some notes about what to do when a new Unicode + version is imported. + +2014-06-26 Glenn Morris + + * authors.el: Move here from ../lisp/emacs-lisp. + +2014-06-25 Glenn Morris + + * grammars/Makefile.in (${bovinedir}/c-by.el, ${bovinedir}/make-by.el): + (${wisentdir}/js-wy.el, ${wisentdir}/python-wy.el): + Replace with pattern rules. + (${bovinedir}/scm-by.el, ${wisentdir}/javat-wy.el) + (${cedetdir}/srecode/srt-wy.el): Use $<. + + * unidata/Makefile.in (${top_srcdir}/src/macuvs.h): Make and load .elc. + (.el.elc): Replace with pattern rule. + (%.elc): New. + (unidata.txt): Use $<. + (compile): Remove. + (${DSTDIR}/charprop.el): Use order-only prereqs rather than a sub-make. + + * unidata/uvs.el (uvs-print-table-ivd): Fix free variable typo. + 2014-06-21 Glenn Morris * unidata/BidiMirroring.txt: Update to 7.0.0 (only comment changes). diff --git a/lisp/emacs-lisp/authors.el b/admin/authors.el similarity index 99% rename from lisp/emacs-lisp/authors.el rename to admin/authors.el index dfc60512c61..3a552c6c1ef 100644 --- a/lisp/emacs-lisp/authors.el +++ b/admin/authors.el @@ -622,11 +622,12 @@ Changes to files in this list are not listed.") "temacs.opt" "descrip.mms" "compile.com" "link.com" "compact.el" "fadr.el" "calc/calc-maint.el" + "emacs-lisp/cl-specs.el" "emacs-lisp/eieio-comp.el" "erc-hecomplete.el" "eshell/esh-maint.el" "language/persian.el" - "meese.el" "iswitchb.el" + "ledit.el" "meese.el" "iswitchb.el" "longlines.el" "mh-exec.el" "mh-init.el" "mh-customize.el" "net/zone-mode.el" "xesam.el" "term/mac-win.el" "sup-mouse.el" @@ -647,6 +648,7 @@ Changes to files in this list are not listed.") "dns-mode.el" "run-at-time.el" "gnus-encrypt.el" "sha1-el.el" "gnus-gl.el" "gnus.sum.el" "proto-stream.el" "color.el" "color-lab.el" "eww.el" "shr-color.el" "shr.el" "earcon.el" "gnus-audio.el" "encrypt.el" + "format-spec.el" "gnus-move.el" ;; doc "getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi" "back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el" @@ -752,7 +754,11 @@ in the repository.") ("progmodes/octave-inf.el" . "octave.el") ("progmodes/octave-mod.el" . "octave.el") ;; Obsolete. + ("emacs-lisp/assoc.el" . "assoc.el") + ("emacs-lisp/cust-print.el" . "cust-print.el") + ("mail/mailpost.el" . "mailpost.el") ("play/bruce.el" . "bruce.el") + ("play/yow.el" . "yow.el") ("patcomp.el" . "patcomp.el") ;; From lisp to etc/forms. ("forms-d2.el" . "forms-d2.el") @@ -771,6 +777,7 @@ in the repository.") ("build-install" . "build-ins.in") ("build-install.in" . "build-ins.in") ("unidata/Makefile" . "unidata/Makefile.in") + ("mac/uvs.el" . "unidata/uvs.el") ;; Moved from top to etc/ ("CONTRIBUTE" . "CONTRIBUTE") ("FTP" . "FTP") diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index b89df7116a6..1454225b80a 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -66,39 +66,32 @@ bovine: ${BOVINE} wisent: ${WISENT} - -${bovinedir}/c-by.el: ${srcdir}/c.by +## c-by.el, make-by.el. +${bovinedir}/%-by.el: ${srcdir}/%.by [ ! -f "$@" ] || chmod +w "$@" - ${make_bovine} -o "$@" ${srcdir}/c.by - -${bovinedir}/make-by.el: ${srcdir}/make.by - [ ! -f "$@" ] || chmod +w "$@" - ${make_bovine} -o "$@" ${srcdir}/make.by + ${make_bovine} -o "$@" $< ${bovinedir}/scm-by.el: ${srcdir}/scheme.by [ ! -f "$@" ] || chmod +w "$@" - ${make_bovine} -o "$@" ${srcdir}/scheme.by + ${make_bovine} -o "$@" $< - -${cedetdir}/semantic/grammar-wy.el: ${srcdir}/grammar.wy +## grammar-wy.el +${cedetdir}/semantic/%-wy.el: ${srcdir}/%.wy [ ! -f "$@" ] || chmod +w "$@" - ${make_wisent} -o "$@" ${srcdir}/grammar.wy + ${make_wisent} -o "$@" $< + +## js-wy.el, python-wy.el +${wisentdir}/%-wy.el: ${srcdir}/%.wy + [ ! -f "$@" ] || chmod +w "$@" + ${make_wisent} -o "$@" $< ${wisentdir}/javat-wy.el: ${srcdir}/java-tags.wy [ ! -f "$@" ] || chmod +w "$@" - ${make_wisent} -o "$@" ${srcdir}/java-tags.wy - -${wisentdir}/js-wy.el: ${srcdir}/js.wy - [ ! -f "$@" ] || chmod +w "$@" - ${make_wisent} -o "$@" ${srcdir}/js.wy - -${wisentdir}/python-wy.el: ${srcdir}/python.wy - [ ! -f "$@" ] || chmod +w "$@" - ${make_wisent} -o "$@" ${srcdir}/python.wy + ${make_wisent} -o "$@" $< ${cedetdir}/srecode/srt-wy.el: ${srcdir}/srecode-template.wy [ ! -f "$@" ] || chmod +w "$@" - ${make_wisent} -o "$@" ${srcdir}/srecode-template.wy + ${make_wisent} -o "$@" $< .PHONY: distclean bootstrap-clean maintainer-clean extraclean diff --git a/admin/notes/unicode b/admin/notes/unicode index 841b7ebd5e4..79e0e1d77e4 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -3,6 +3,39 @@ Copyright (C) 2002-2014 Free Software Foundation, Inc. See the end of the file for license conditions. +Importing a new Unicode Standard version into Emacs +------------------------------------------------------------- + +Emacs uses the following files from the Unicode Character Database +(a.k.a. "UCD): + + . UnicodeData.txt + . BidiMirroring.txt + . IVD_Sequences.txt + +First, these files need to be copied into admin/unidata/, and then +Emacs should be rebuilt for them to take effect. Rebuilding Emacs +updates several derived files elsewhere in the Emacs source tree, +mainly in lisp/international/. + +When Emacs is rebuilt for the first time after importing the new +files, pay attention to any warning or error messages. In particular, +admin/unidata/unidata-gen.el will complain if UnicodeData.txt defines +new bidirectional attributes of characters, because unidata-gen.el, +bidi.c and dispextern.h need to be updated in that case; failure to do +so will cause aborts in redisplay. + +Next, review the changes in UnicodeData.txt vs the previous version +used by Emacs. Any changes, be it introduction of new scripts or +addition of codepoints to existing scripts, need corresponding changes +in the data used for filling char-script-table, see characters.el +around line 1300. Other databases and settings in characters.el, such +as the data for char-width-table, might also need changes. + +Any new scripts added by UnicodeData.txt will also need updates to +script-representative-chars defined in fontset.el. Other databases in +fontset.el might also need to be updated as needed. + Problems, fixmes and other unicode-related issues ------------------------------------------------------------- diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index c86fff0bab4..6b253ea565b 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -35,24 +35,23 @@ emacs = "${EMACS}" -batch --no-site-file --no-site-lisp all: ${top_srcdir}/src/macuvs.h ${DSTDIR}/charprop.el -${top_srcdir}/src/macuvs.h: ${srcdir}/uvs.el ${srcdir}/IVD_Sequences.txt - ${EMACS} -batch -l "${srcdir}/uvs.el" \ +## Specify .elc as an order-only prereq so as to not needlessly rebuild +## target just because the .elc is missing. +## Same with charprop.el below. +${top_srcdir}/src/macuvs.h: ${srcdir}/uvs.el ${srcdir}/IVD_Sequences.txt | \ + ${srcdir}/uvs.elc + ${emacs} -L ${srcdir} -l uvs \ --eval '(uvs-print-table-ivd "${srcdir}/IVD_Sequences.txt" "Adobe-Japan1")' \ > $@ -.el.elc: +%.elc: %.el ${emacs} -f batch-byte-compile $< unidata.txt: ${srcdir}/UnicodeData.txt - sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < ${srcdir}/UnicodeData.txt > $@ + sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' < $< > $@ -compile: ${srcdir}/unidata-gen.elc - -## Depend on .el rather than .elc so as not to needlessly rebuild -## uni-*.el files just because .elc is missing. -## Same for UnicodeData.txt v unidata.txt. -${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.el ${srcdir}/UnicodeData.txt - ${MAKE} compile unidata.txt EMACS="${EMACS}" +${DSTDIR}/charprop.el: ${srcdir}/unidata-gen.el ${srcdir}/UnicodeData.txt | \ + ${srcdir}/unidata-gen.elc unidata.txt -if [ -f "$@" ]; then \ cd ${DSTDIR} && chmod +w charprop.el `sed -n 's/^;; FILE: //p' < charprop.el`; \ fi diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index 7559a566974..4a17c726712 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -198,8 +198,8 @@ corresponding number." (let ((uvs-alist (with-temp-buffer (insert-file-contents filename) - (setq uvs-alist (uvs-alist-from-ivd collection-id - sequence-id-to-glyph-func))))) + (uvs-alist-from-ivd collection-id + sequence-id-to-glyph-func)))) (princ "/* Automatically generated by uvs.el. */\n") (princ (format "static const unsigned char mac_uvs_table_%s_bytes[] =\n {\n" diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index a6b87020733..d7b030fb1aa 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,12 @@ +2014-06-24 Leo Liu + + * dired-x.texi (Omitting Files in Dired, Omitting Variables): + Fix key binding to dired-omit-mode. (Bug#16354) + +2014-06-24 Eli Zaretskii + + * autotype.texi (Skeleton Language): Document the \n feature better. + 2014-06-23 Glenn Morris * Makefile.in (%.texi): Disable implicit rules. diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index e0fce74bd3f..a2988795fc5 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -234,9 +234,10 @@ Insert string or character. Literal strings and characters are passed through @c ??? something seems very wrong here. Insert a newline and align under current line, but not if this is the last element of a skeleton and the newline would be inserted at end of -line. Use newline character @code{?\n} to prevent alignment. Use -@code{"\n"} as the last string element of a skeleton to insert a -newline after the skeleton unconditionally. +line, or this is the first element and the newline would be inserted +at beginning of line. Use newline character @code{?\n} to prevent +alignment. Use @code{"\n"} as the first or last string element of a +skeleton to insert a newline unconditionally. @item @code{_} Interesting point. When wrapping skeletons around successive regions, they are put at these places. Point is left at first @code{_} where nothing is wrapped. diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index a69d72c7d43..1eb512b7372 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -283,8 +283,8 @@ Marked files are never omitted. @end itemize @table @kbd -@item M-o -@kindex M-o +@item C-x M-o +@kindex C-x M-o @findex dired-omit-mode (@code{dired-omit-mode}) Toggle between displaying and omitting ``uninteresting'' files. @@ -324,7 +324,7 @@ Default: @code{nil} If non-@code{nil}, ``uninteresting'' files are not listed. Uninteresting files are those whose files whose names match regexp @code{dired-omit-files}, plus those ending with extensions in -@code{dired-omit-extensions}. @kbd{M-o} (@code{dired-omit-mode}) +@code{dired-omit-extensions}. @kbd{C-x M-o} (@code{dired-omit-mode}) toggles its value, which is buffer-local. Put @example @@ -333,8 +333,8 @@ toggles its value, which is buffer-local. Put @noindent inside your @code{dired-mode-hook} to have omitting initially turned on in -@emph{every} Dired buffer (@pxref{Installation}). You can then use @kbd{M-o} to -unomit in that buffer. +@emph{every} Dired buffer (@pxref{Installation}). You can then use +@kbd{C-x M-o} to unomit in that buffer. To enable omitting automatically only in certain directories you can add a directory local setting diff --git a/etc/ChangeLog b/etc/ChangeLog index 4419f4a0e66..fbeaed956a4 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2014-06-24 Eli Barzilay + + * NEWS: calculator.el user-visible changes. + 2014-06-15 Michael Albinus * NEWS: New Tramp method "nc". diff --git a/etc/NEWS b/etc/NEWS index 27e9cfa0e3c..1fc4a218d76 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -96,6 +96,8 @@ should be used instead of font-lock-fontify-buffer when called from Elisp. *** Calendar can list and mark diary entries with Chinese dates. See `diary-chinese-list-entries' and `diary-chinese-mark-entries'. +** New ERT function `ert-summarize-tests-batch-and-exit'. + --- ** The Rmail commands d, C-d and u now handle repeat counts to delete or undelete multiple messages. @@ -113,6 +115,10 @@ protocols as well as for "telnet" and "ftp" are passed to Tramp. *** New connection method "nc", which allows to access dumb busyboxes. +** Calculator: decimal display mode uses "," groups, so it's more +fitting for use in money calculations; factorial works with +non-integer inputs. + ** Obsolete packages --- diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 1fc9fcdb1f5..64a73027915 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,13 @@ +2014-06-26 Glenn Morris + + * Makefile.in (blessmail): Depend on lisp/mail/blessmail.el. + Use $<, $@. + (regex.o, etags${EXEEXT}, ctags${EXEEXT}, ebrowse${EXEEXT}) + (profile${EXEEXT}, make-docfile${EXEEXT}, movemail${EXEEXT}) + (pop.o, emacsclient${EXEEXT}, emacsclientw${EXEEXT}, ntlib.o) + (hexl${EXEEXT}, update-game-score${EXEEXT}, emacsclient.res): Use $<. + (ctags${EXEEXT}): Add $srcdir to dependency rather than using VPATH. + 2014-06-17 Paul Eggert Omit redundant extern decls. diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 35fe618a297..7eb13f667ec 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -1,7 +1,7 @@ ### @configure_input@ -# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2014 Free Software -# Foundation, Inc. +# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2014 +# Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -211,9 +211,9 @@ $(EXE_FILES): ../lib/libgnu.a ## Only used if we need blessmail, but no harm in always defining. ## This makes the actual blessmail executable. -blessmail: - $(EMACS) $(EMACSOPT) -l $(srcdir)/../lisp/mail/blessmail.el - chmod +x blessmail +blessmail: $(srcdir)/../lisp/mail/blessmail.el + $(EMACS) $(EMACSOPT) -l $< + chmod +x $@ ## This checks if we need to run blessmail. ## Do not charge ahead and do it! Let the installer decide. @@ -311,7 +311,7 @@ TAGS: etags${EXEEXT} $(MAKE) -C ../lib libgnu.a regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h) - ${CC} -c ${CPP_CFLAGS} ${srcdir}/../src/regex.c + ${CC} -c ${CPP_CFLAGS} $< etags_deps = ${srcdir}/etags.c regex.o $(NTLIB) $(config_h) @@ -319,42 +319,41 @@ etags_cflags = -DEMACS_NAME="\"GNU Emacs\"" -DVERSION="\"${version}\"" -o $@ etags_libs = regex.o $(LOADLIBES) $(NTLIB) etags${EXEEXT}: ${etags_deps} - $(CC) ${ALL_CFLAGS} $(etags_cflags) $(srcdir)/etags.c $(etags_libs) + $(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) ## ctags.c is distinct from etags.c so that parallel makes do not write two ## etags.o files on top of each other. ## FIXME? ## Can't we use a wrapper that calls 'etags --ctags'? -ctags${EXEEXT}: ctags.c ${etags_deps} - $(CC) ${ALL_CFLAGS} $(etags_cflags) $(srcdir)/ctags.c $(etags_libs) +ctags${EXEEXT}: ${srcdir}/ctags.c ${etags_deps} + $(CC) ${ALL_CFLAGS} $(etags_cflags) $< $(etags_libs) ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h $(NTLIB) \ $(config_h) $(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" \ - ${srcdir}/ebrowse.c $(LOADLIBES) $(NTLIB) -o $@ + $< $(LOADLIBES) $(NTLIB) -o $@ profile${EXEEXT}: ${srcdir}/profile.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c \ + $(CC) ${ALL_CFLAGS} $< \ $(LOADLIBES) $(NTLIB) $(LIB_CLOCK_GETTIME) -o $@ make-docfile${EXEEXT}: ${srcdir}/make-docfile.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) $(NTLIB) \ - -o $@ + $(CC) ${ALL_CFLAGS} $< $(LOADLIBES) $(NTLIB) -o $@ movemail${EXEEXT}: ${srcdir}/movemail.c pop.o $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c pop.o \ + $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} $< pop.o \ $(LOADLIBES) $(NTLIB) $(LIBS_MOVE) -o $@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h) - $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/pop.c + $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} $< emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c \ + $(CC) ${ALL_CFLAGS} $< \ -DVERSION="\"${version}\"" $(NTLIB) $(LOADLIBES) $(LIB_FDATASYNC) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) - $(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows ${srcdir}/emacsclient.c \ + $(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ -DVERSION="\"${version}\"" $(LOADLIBES) $(LIB_FDATASYNC) \ $(LIB_WSOCK32) $(LIBS_ECLIENT) -o $@ @@ -366,18 +365,16 @@ NTDEPS = $(NTINC)/ms-w32.h $(NTINC)/sys/stat.h $(NTINC)/inttypes.h \ # The dependency on $(NTDEPS) is a trick intended to cause recompile of # programs on MinGW whenever some private header in nt/inc is modified. ntlib.o: ${srcdir}/ntlib.c ${srcdir}/ntlib.h $(NTDEPS) - $(CC) -c ${CPP_CFLAGS} ${srcdir}/ntlib.c + $(CC) -c ${CPP_CFLAGS} $< hexl${EXEEXT}: ${srcdir}/hexl.c $(NTLIB) $(config_h) - $(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o $@ + $(CC) ${ALL_CFLAGS} $< $(LOADLIBES) -o $@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) $(CC) ${ALL_CFLAGS} -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\"" \ - ${srcdir}/update-game-score.c $(LOADLIBES) $(NTLIB) \ - -o $@ + $< $(LOADLIBES) $(NTLIB) -o $@ emacsclient.res: $(NTINC)/../emacsclient.rc - $(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ \ - $(NTINC)/../emacsclient.rc + $(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< ## Makefile ends here. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c3f74d84998..9fb230813c7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,203 @@ +2014-06-26 Glenn Morris + + * Makefile.in (update-authors): Update for moved authors.el. + +2014-06-26 Leo Liu + + * skeleton.el (skeleton-end-hook): Default to nil and move the + work to skeleton-insert. (Bug#17850) + +2014-06-26 Dmitry Antipov + + * calc/calc-alg.el (math-beforep): + * progmodes/cc-guess.el (c-guess-view-reorder-offsets-alist-in-style): + Simplify because string-lessp can accept symbols as args. + +2014-06-26 Daiki Ueno + + * emacs-lisp/package.el (package--check-signature): If + package-check-signature is allow-unsigned, don't signal error when + we can't verify signature because of missing public key + (bug#17625). + +2014-06-26 Glenn Morris + + * emacs-lisp/cl-macs.el (help-add-fundoc-usage): + Remove outdated declaration. + + * emacs-lisp/authors.el (authors-valid-file-names) + (authors-renamed-files-alist): Additions. + +2014-06-26 Leo Liu + + * textmodes/picture.el (picture-set-tab-stops): + * ruler-mode.el (ruler-mode-mouse-add-tab-stop) + (ruler-mode-ruler): Fix to work with nil tab-stop-list. + + * progmodes/asm-mode.el (asm-calculate-indentation): Use + indent-next-tab-stop. + + * indent.el (indent-accumulate-tab-stops): New function. + +2014-06-26 Stefan Monnier + + * emacs-lisp/package.el (package-list-unsigned): New var (bug#17625). + (package-desc-status): Obey it. + +2014-06-26 Stephen Berman + + * calendar/todo-mode.el: Fix two bugs. + (todo-insert-item--basic): If user cancels item insertion to + another category before setting priority, show original category + whether it is in the same or a different file. + (todo-set-item-priority): After selecting category, instead of + moving point to top, which extends an active region, restore it. + +2014-06-26 Stefan Monnier + + * help-fns.el (describe-function-1): Check file-name is a string before + calling help-fns--autoloaded-p (bug#17564). + +2014-06-26 Juri Linkov + + * desktop.el (desktop-auto-save-enable) + (desktop-auto-save-disable): New functions. + (desktop-save-mode, desktop-auto-save-timeout): Use them. + (desktop-read): Disable the autosave before loading the desktop, + and enable afterwards. (Bug#17351) + +2014-06-26 Stefan Monnier + + Fix some indentation problem with \; and pipes (bug#17842). + * progmodes/sh-script.el (sh-mode-syntax-table): Set syntax of ;|&. + (sh-smie--default-forward-token, sh-smie--default-backward-token): + New functions. + (sh-smie-sh-forward-token, sh-smie-sh-backward-token) + (sh-smie-rc-forward-token, sh-smie-rc-backward-token): Use them. + (sh-smie-sh-rules): Fix indentation of a pipe at BOL. + +2014-06-26 Glenn Morris + + * emacs-lisp/find-func.el (find-function-C-source-directory): + Use file-accessible-directory-p. + + * ps-samp.el: Make it slightly less awful. + (ps-rmail-mode-hook, ps-gnus-article-prepare-hook, ps-vm-mode-hook): + (ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key. + Only set local values. + (ps-article-subject, ps-article-author): Use standard functions + like mail-fetch-field. + (ps-info-file, ps-info-node): Use match-string. + (ps-jts-ps-setup, ps-jack-setup): Remove, merging into... + (ps-samp-ps-setup): ... new function. + + * progmodes/idlw-shell.el (idlwave-shell-make-temp-file): + Optimize away code unneeded on any modern Emacs. + + * emacs-lisp/authors.el: Move to ../admin. + + * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New. + +2014-06-25 Glenn Morris + + * Makefile.in ($(lisp)/progmodes/cc-defs.elc) + ($(lisp)/progmodes/cc-fonts.elc, $(lisp)/progmodes/cc-langs.elc) + ($(lisp)/progmodes/cc-vars.elc): Drop hand-written deps on non-cc + files. They are not relevant to the original issue (bug#1004), + and cause unnecessary recompilation (bug#2151). + +2014-06-25 Stefan Monnier + + * play/landmark.el: Use lexical-binding and avoid `intangible'. + (landmark--last-pos): New var. + (landmark--intangible-chars): New const. + (landmark--intangible): New function. + (landmark-mode, landmark-move): Use it. + (landmark-mode): Remove properties. + (landmark-plot-square, landmark-point-square, landmark-goto-xy) + (landmark-cross-qtuple): + Don't worry about `intangible' any more. + (landmark-click, landmark-point-y): Same; and don't assume point-min==1. + (landmark-init-display): Don't set `intangible' and `point-entered'. + (square): Remove. Inline it instead. + (landmark--distance): Rename from `distance'. + (landmark-calc-distance-of-robot-from): Rename from + calc-distance-of-robot-from. + (landmark-calc-smell-internal): Rename from calc-smell-internal. + +2014-06-25 Dmitry Antipov + + * files.el (dir-locals-find-file, file-relative-name): + * info.el (Info-complete-menu-item): + * minibuffer.el (completion-table-subvert): Prefer string-prefix-p + to compare-strings to avoid out-of-range errors. + * subr.el (string-prefix-p): Adjust to match strict range + checking in compare-strings. + +2014-06-24 Leonard Randall (tiny change) + + * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search + for comment lines non-greedy and stopping at newlines to fix stack + overflows with large files. + +2014-06-24 Eli Barzilay + + * calculator.el (calculator-last-input): Drop 'ascii-character property + lookup. + +2014-06-24 Leo Liu + + * align.el (align-adjust-col-for-rule): Unbreak due to defaulting + tab-stop-list to nil. (Bug#16381) + + * indent.el (indent-next-tab-stop): Rename from indent--next-tab-stop. + (indent-rigidly-left-to-tab-stop) + (indent-rigidly-right-to-tab-stop, tab-to-tab-stop) + (move-to-tab-stop): Change callers. + +2014-06-24 Eli Zaretskii + + * skeleton.el (skeleton-insert): Yet another fix of the doc string + wrt behavior of \n as the first/last element of a skeleton. + +2014-06-24 Michael Albinus + + * net/tramp-adb.el (tramp-adb-handle-process-file): + * net/tramp-sh.el (tramp-sh-handle-process-file): + * net/tramp-smb.el (tramp-smb-handle-process-file): Do not raise + the output buffer when DISPLAY is non-nil. (Bug#17815) + +2014-06-24 Glenn Morris + + * play/landmark.el (landmark-move-down, landmark-move-up): + Fix 2007-10-20 change - preserve horizontal position. + +2014-06-23 Sam Steingold + + * simple.el (kill-append): Remove undo boundary depending on ... + (kill-append-merge-undo): New user option. + +2014-06-23 Stefan Monnier + + * simple.el (handle-shift-selection, exchange-point-and-mark) + (activate-mark): Set transient-mark-mode buffer-locally (bug#6316). + (transient-mark-mode): Use&set the global value. + * mouse.el (mouse-set-region-1, mouse-drag-track): Idem. + * emulation/edt.el (edt-emulation-off): Save&restore the global + transient-mark-mode setting. + * obsolete/pc-select.el (pc-selection-mode): Use the + transient-mark-mode function. + +2014-06-23 Eli Zaretskii + + * international/fontset.el (script-representative-chars): + Add representative characters for scripts added in Unicode 7.0. + (otf-script-alist): Synchronize with the latest registry of OTF + script tags. + + * international/characters.el (char-script-table): Update for + scripts added and codepoint ranges changed in Unicode 7.0. + 2014-06-23 Eli Barzilay * calculator.el (calculator-standard-displayer): Fix bug in use of @@ -19,8 +219,8 @@ * obsolete/vi.el (vi-set-mark): * term.el (term-handle-scroll): * textmodes/bibtex.el (bibtex-fill-field, bibtex-fill-entry): - * wid-edit.el (widget-editable-list-value-create): Prefer - point-marker to copy-marker of point. + * wid-edit.el (widget-editable-list-value-create): + Prefer point-marker to copy-marker of point. 2014-06-21 Fabián Ezequiel Gallina @@ -223,9 +423,9 @@ (calculator-expt, calculator-truncate): Minor code improvements. (calculator-need-3-lines): New function pulling out code from `calculator'. - (calculator-get-display): Renamed from `calculator-get-prompt', and + (calculator-get-display): Rename from `calculator-get-prompt', and improved. - (calculator-push-curnum): Renamed from `calculator-curnum-value', and + (calculator-push-curnum): Rename from `calculator-curnum-value', and extended for all uses of it. All callers changed. (calculator-groupize-number): New utility for splitting a number into groups. @@ -237,11 +437,11 @@ `pcase' for conciseness and clarity). (calculator-reduce-stack): Now doing just the reduction loop using `calculator-reduce-stack-once'. - (calculator-funcall): Improved code, make it work in v24.3.1 too. - (calculator-last-input): Improved code, remove some old cruft. + (calculator-funcall): Improve code, make it work in v24.3.1 too. + (calculator-last-input): Improve code, remove some old cruft. (calculator-quit): Kill `calculator-buffer' in electric mode too. - (calculator-integer-p): Removed. - (calculator-fact): Improved code, make it work on non-integer values + (calculator-integer-p): Remove. + (calculator-fact): Improve code, make it work on non-integer values too (using truncated numbers). 2014-06-15 Michael Albinus @@ -12072,7 +12272,7 @@ 2013-07-07 Michael Kifer - * ediff.el (ediff-version): Version update. + * vc/ediff.el (ediff-version): Version update. (ediff-files-command, ediff3-files-command, ediff-merge-command) (ediff-merge-with-ancestor-command, ediff-directories-command) (ediff-directories3-command, ediff-merge-directories-command) @@ -12080,19 +12280,21 @@ All are command-line interfaces to ediff: to facilitate calling Emacs with the appropriate ediff functions invoked. - * viper-cmd.el (viper-del-forward-char-in-insert): New function. + * emulation/viper-cmd.el (viper-del-forward-char-in-insert): + New function. (viper-save-kill-buffer): Check if buffer is modified. - * viper.el (viper-version): Version update. + * emulation/viper.el (viper-version): Version update. (viper-emacs-state-mode-list): Add egg-status-buffer-mode. 2013-07-07 Stefan Monnier * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook. - * viper-cmd.el (viper-envelop-ESC-key): Remove function. + * emulation/viper-cmd.el (viper-envelop-ESC-key): Remove function. (viper-intercept-ESC-key): Simplify. - * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd. - * viper.el (viper--tty-ESC-filter, viper--lookup-key) + * emulation/viper-keym.el (viper-ESC-key): Make it a constant, + don't use kbd. + * emulation/viper.el (viper--tty-ESC-filter, viper--lookup-key) (viper-catch-tty-ESC, viper-uncatch-tty-ESC) (viper-setup-ESC-to-escape): New functions. (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape. diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 534f91f61ce..2e8c6df24a6 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -8501,7 +8501,7 @@ 2012-07-25 Jay Belanger - * calc-alg.el (math-simplify-divide): Don't cross multiply + * calc/calc-alg.el (math-simplify-divide): Don't cross multiply in an equation when the lhs is a variable. 2012-07-24 Julien Danjou diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cbc1d2af3ae..cb732655299 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -238,7 +238,8 @@ bzr-update: compile finder-data custom-deps # Update the AUTHORS file. update-authors: - $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) + $(emacs) -L "$(top_srcdir)/admin" -l authors \ + -f batch-update-authors "$(top_srcdir)/etc/AUTHORS" "$(top_srcdir)" ETAGS = ../lib-src/etags @@ -519,28 +520,22 @@ $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\ $(lisp)/progmodes/cc-vars.elc: \ $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-defs.elc -$(lisp)/progmodes/cc-align.elc: \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc - -$(lisp)/progmodes/cc-cmds.elc: \ +$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-cmds.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-compat.elc: \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-styles.elc \ $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc \ - $(lisp)/emacs-lisp/cl.elc $(lisp)/emacs-lisp/regexp-opt.elc +$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-engine.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-fonts.elc: $(lisp)/progmodes/cc-langs.elc \ - $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ - $(lisp)/font-lock.elc + $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc -$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \ - $(lisp)/emacs-lisp/cl.elc +$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \ @@ -550,6 +545,4 @@ $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \ $(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \ $(lisp)/progmodes/cc-align.elc -$(lisp)/progmodes/cc-vars.elc: $(lisp)/custom.elc $(lisp)/widget.elc - # Makefile ends here. diff --git a/lisp/align.el b/lisp/align.el index 3b54aba264f..0e6b84d11ec 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -1130,13 +1130,8 @@ TAB-STOP specifies whether SPACING refers to tab-stop boundaries." column (if (not tab-stop) (+ column spacing) - (let ((stops tab-stop-list)) - (while stops - (if (and (> (car stops) column) - (= (setq spacing (1- spacing)) 0)) - (setq column (car stops) - stops nil) - (setq stops (cdr stops))))) + (dotimes (_ spacing) + (setq column (indent-next-tab-stop column))) column))) (defsubst align-column (pos) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 4bd37a4982d..c26b007bb96 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -293,7 +293,7 @@ (Math-objectp a)) ((eq (car a) 'var) (if (eq (car b) 'var) - (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b))) + (string-lessp (nth 1 a) (nth 1 b)) (not (Math-numberp b)))) ((eq (car b) 'var) (Math-numberp a)) ((eq (car a) (car b)) @@ -302,7 +302,7 @@ (and b (or (null a) (math-beforep (car a) (car b))))) - (t (string-lessp (symbol-name (car a)) (symbol-name (car b)))))) + (t (string-lessp (car a) (car b))))) (defsubst math-simplify-extended (a) diff --git a/lisp/calculator.el b/lisp/calculator.el index 9ffa6b1a64b..ad7a7f4c92a 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1217,13 +1217,11 @@ Use KEYS if given, otherwise use `this-command-keys'." inp ;; Translates kp-x to x and [tries to] create a string to lookup ;; operators; assume all symbols are translatable via - ;; `function-key-map' or with an 'ascii-character property. This - ;; is needed because we have key bindings for kp-* (which might be - ;; the wrong thing to do) so they don't get translated in - ;; `this-command-keys'. + ;; `function-key-map'. This is needed because we have key + ;; bindings for kp-* (which might be the wrong thing to do) so + ;; they don't get translated in `this-command-keys'. (concat (mapcar (lambda (k) - (if (numberp k) k (or (get k 'ascii-character) - (error "??bad key??")))) + (if (numberp k) k (error "??bad key?? (%S)" k))) (or (lookup-key function-key-map inp) inp)))))) (defun calculator-clear-fragile (&optional op) diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index ab2ab3e4cb8..1a54cc2c67b 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1962,13 +1962,12 @@ their associated keys and their effects." ;; If user cancels before setting priority, restore ;; display. (unless item-added - (if ocat - (progn - (unless (equal cat ocat) - (todo-category-number ocat) - (todo-category-select)) - (and done-only (todo-toggle-view-done-only))) - (set-window-buffer (selected-window) (set-buffer obuf))) + (set-window-buffer (selected-window) (set-buffer obuf)) + (when ocat + (unless (equal cat ocat) + (todo-category-number ocat) + (todo-category-select)) + (and done-only (todo-toggle-view-done-only))) (goto-char opoint)) ;; If the todo items section is not visible when the ;; insertion command is called (either because only done @@ -2553,9 +2552,9 @@ meaning to raise or lower the item's priority by one." (goto-char (point-min)) (setq done (re-search-forward todo-done-string-start nil t)))) (let ((todo-show-with-done done)) - (todo-category-select) - ;; Keep top of category in view while setting priority. - (goto-char (point-min))))) + ;; Keep current item or top of moved to category in view + ;; while setting priority. + (save-excursion (todo-category-select))))) ;; Prompt for priority only when the category has at least one ;; todo item. (when (> maxnum 1) diff --git a/lisp/desktop.el b/lisp/desktop.el index c500121ec44..b37b95e02be 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -174,11 +174,8 @@ For further details, see info node `(emacs)Saving Emacs Sessions'." :global t :group 'desktop (if desktop-save-mode - (when (and (integerp desktop-auto-save-timeout) - (> desktop-auto-save-timeout 0)) - (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer)) - (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (desktop-auto-save-cancel-timer))) + (desktop-auto-save-enable) + (desktop-auto-save-disable))) (defun desktop-save-mode-off () "Disable `desktop-save-mode'. Provided for use in hooks." @@ -219,9 +216,8 @@ Zero or nil means disable auto-saving due to idleness." (set-default symbol value) (ignore-errors (if (and (integerp value) (> value 0)) - (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) - (desktop-auto-save-cancel-timer)))) + (desktop-auto-save-enable value) + (desktop-auto-save-disable)))) :group 'desktop :version "24.4") @@ -1132,6 +1128,10 @@ Using it may cause conflicts. Use it anyway? " owner))))) (unless desktop-dirname (message "Desktop file in use; not loaded."))) (desktop-lazy-abort) + ;; Temporarily disable the autosave that will leave it + ;; disabled when loading the desktop fails with errors, + ;; thus not overwriting the desktop with broken contents. + (desktop-auto-save-disable) ;; Evaluate desktop buffer and remember when it was modified. (load (desktop-full-file-name) t t t) (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) @@ -1184,6 +1184,7 @@ Using it may cause conflicts. Use it anyway? " owner))))) (set-window-prev-buffers window nil) (set-window-next-buffers window nil)))) (setq desktop-saved-frameset nil) + (desktop-auto-save-enable) t)) ;; No desktop file found. (desktop-clear) @@ -1230,6 +1231,15 @@ directory DIRNAME." ;; Auto-Saving. (defvar desktop-auto-save-timer nil) +(defun desktop-auto-save-enable (&optional timeout) + (when (and (integerp (or timeout desktop-auto-save-timeout)) + (> (or timeout desktop-auto-save-timeout) 0)) + (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer))) + +(defun desktop-auto-save-disable () + (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer) + (desktop-auto-save-cancel-timer)) + (defun desktop-auto-save () "Save the desktop periodically. Called by the timer created in `desktop-auto-save-set-timer'." diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ce54337a3b1..0a426d17096 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -382,8 +382,6 @@ its argument list allows full Common Lisp conventions." (if (car res) `(progn ,(car res) ,form) form)) `(function ,func))) -(declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) - (defun cl--make-usage-var (x) "X can be a var or a (destructuring) lambda-list." (cond diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 6ecb218091a..024110b93e0 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1463,6 +1463,65 @@ the tests)." (kill-emacs 2)))) +(defun ert-summarize-tests-batch-and-exit () + "Summarize the results of testing. +Expects to be called in batch mode, with logfiles as command-line arguments. +The logfiles should have the `ert-run-tests-batch' format. When finished, +this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." + (or noninteractive + (user-error "This function is only for use in batch mode")) + (let ((nlogs (length command-line-args-left)) + (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) + nnotrun logfile notests badtests unexpected) + (with-temp-buffer + (while (setq logfile (pop command-line-args-left)) + (erase-buffer) + (insert-file-contents logfile) + (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) + (push logfile notests) + (setq ntests (+ ntests (string-to-number (match-string 1)))) + (if (not (re-search-forward "^\\(Aborted: \\)?\ +Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ +\\(?:, \\([0-9]+\\) unexpected\\)?\ +\\(?:, \\([0-9]+\\) skipped\\)?" nil t)) + (push logfile badtests) + (if (match-string 1) (push logfile badtests)) + (setq nrun (+ nrun (string-to-number (match-string 2))) + nexpected (+ nexpected (string-to-number (match-string 3)))) + (when (match-string 4) + (push logfile unexpected) + (setq nunexpected (+ nunexpected + (string-to-number (match-string 4))))) + (if (match-string 5) + (setq nskipped (+ nskipped + (string-to-number (match-string 5))))))))) + (setq nnotrun (- ntests nrun)) + (message "\nSUMMARY OF TEST RESULTS") + (message "-----------------------") + (message "Files examined: %d" nlogs) + (message "Ran %d tests%s, %d results as expected%s%s" + nrun + (if (zerop nnotrun) "" (format ", %d failed to run" nnotrun)) + nexpected + (if (zerop nunexpected) + "" + (format ", %d unexpected" nunexpected)) + (if (zerop nskipped) + "" + (format ", %d skipped" nskipped))) + (when notests + (message "%d files did not contain any tests:" (length notests)) + (mapc (lambda (l) (message " %s" l)) notests)) + (when badtests + (message "%d files did not finish:" (length badtests)) + (mapc (lambda (l) (message " %s" l)) badtests)) + (when unexpected + (message "%d files contained unexpected results:" (length unexpected)) + (mapc (lambda (l) (message " %s" l)) unexpected)) + (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2) + (unexpected 1) + (t 0))))) + ;;; Utility functions for load/unload actions. (defun ert--activate-font-lock-keywords () diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 5c404ce0468..c372117b104 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -178,8 +178,7 @@ LIBRARY should be a string (the name of the library)." (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) - (when (and (file-directory-p dir) (file-readable-p dir)) - dir)) + (if (file-accessible-directory-p dir) dir)) "Directory where the C source files of Emacs can be found. If nil, do not try to find the source code of functions and variables defined in C.") diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7ca62464bd0..4d7ed8f121c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -828,14 +828,20 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (buffer-string)))) (epg-context-set-home-directory context homedir) (epg-verify-string context sig-content (buffer-string)) - ;; The .sig file may contain multiple signatures. Success if one - ;; of the signatures is good. - (let ((good-signatures - (delq nil (mapcar (lambda (sig) - (if (eq (epg-signature-status sig) 'good) - sig)) - (epg-context-result-for context 'verify))))) - (if (null good-signatures) + (let (good-signatures had-fatal-error) + ;; The .sig file may contain multiple signatures. Success if one + ;; of the signatures is good. + (dolist (sig (epg-context-result-for context 'verify)) + (if (eq (epg-signature-status sig) 'good) + (push sig good-signatures) + ;; If package-check-signature is allow-unsigned, don't + ;; signal error when we can't verify signature because of + ;; missing public key. Other errors are still treated as + ;; fatal (bug#17625). + (unless (and (eq package-check-signature 'allow-unsigned) + (eq (epg-signature-status sig) 'no-pubkey)) + (setq had-fatal-error t)))) + (if (and (null good-signatures) had-fatal-error) (error "Failed to verify signature %s: %S" sig-file (mapcar #'epg-signature-to-string @@ -1664,6 +1670,9 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (defvar package-list-unversioned nil "If non-nil include packages that don't have a version in `list-package'.") +(defvar package-list-unsigned nil + "If non-nil, mention in the list which packages were installed w/o signature.") + (defun package-desc-status (pkg-desc) (let* ((name (package-desc-name pkg-desc)) (dir (package-desc-dir pkg-desc)) @@ -1684,9 +1693,8 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (dir ;One of the installed packages. (cond ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") - ((eq pkg-desc (cadr (assq name package-alist))) (if signed - "installed" - "unsigned")) + ((eq pkg-desc (cadr (assq name package-alist))) + (if (or (not package-list-unsigned) signed) "installed" "unsigned")) (t "obsolete"))) (t (let* ((ins (cadr (assq name package-alist))) @@ -1696,9 +1704,9 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (if (memq name package-menu--new-package-list) "new" "available")) ((version-list-< version ins-v) "obsolete") - ((version-list-= version ins-v) (if signed - "installed" - "unsigned")))))))) + ((version-list-= version ins-v) + (if (or (not package-list-unsigned) signed) + "installed" "unsigned")))))))) (defun package-menu--refresh (&optional packages keywords) "Re-populate the `tabulated-list-entries'. diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index a32fb612adb..e0e2660b70a 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -2033,7 +2033,8 @@ created." ;; Make highlighting of selected text work properly for EDT commands. (if (featurep 'emacs) (progn - (setq edt-orig-transient-mark-mode transient-mark-mode) + (setq edt-orig-transient-mark-mode + (default-value 'transient-mark-mode)) (add-hook 'activate-mark-hook (function (lambda () @@ -2068,7 +2069,7 @@ created." (edt-reset) (force-mode-line-update t) (if (featurep 'emacs) - (setq transient-mark-mode edt-orig-transient-mark-mode)) + (setq-default transient-mark-mode edt-orig-transient-mark-mode)) (message "Original key bindings restored; EDT Emulation disabled")) (defun edt-default-menu-bar-update-buffers () diff --git a/lisp/files.el b/lisp/files.el index 9017cc96703..65f2009c7ce 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3659,10 +3659,9 @@ of no valid cache entry." ;;; (setq locals-file nil)) ;; Find the best cached value in `dir-locals-directory-cache'. (dolist (elt dir-locals-directory-cache) - (when (and (eq t (compare-strings file nil (length (car elt)) - (car elt) nil nil - (memq system-type - '(windows-nt cygwin ms-dos)))) + (when (and (string-prefix-p (car elt) file + (memq system-type + '(windows-nt cygwin ms-dos))) (> (length (car elt)) (length (car dir-elt)))) (setq dir-elt elt))) (if (and dir-elt @@ -4507,18 +4506,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (let ((ancestor ".") (filename-dir (file-name-as-directory filename))) (while (not - (or - (eq t (compare-strings filename-dir nil (length directory) - directory nil nil fold-case)) - (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)))) + (or (string-prefix-p directory filename-dir fold-case) + (string-prefix-p directory filename fold-case))) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (if (equal ancestor ".") ".." (concat "../" ancestor)))) ;; Now ancestor is empty, or .., or ../.., etc. - (if (eq t (compare-strings filename nil (length directory) - directory nil nil fold-case)) + (if (string-prefix-p directory filename fold-case) ;; We matched within FILENAME's directory part. ;; Add the rest of FILENAME onto ANCESTOR. (let ((rest (substring filename (length directory)))) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index a21e899b6e4..7589d1505d7 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,12 @@ +2014-06-26 Glenn Morris + + * mm-util.el (help-function-arglist): Remove outdated declaration. + +2014-06-24 Andreas Schwab + + * html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted + attribute values. (Bug#17834) + 2013-06-22 Dmitry Antipov * gnus-sum.el (gnus-summary-edit-article-done): diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el index 78cecd92356..22ee1c3921e 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/gnus/html2text.el @@ -179,72 +179,20 @@ formatting, and then moved afterward.") (defun html2text-get-attr (p1 p2) (goto-char p1) - (re-search-forward " +[^ ]" p2 t) - (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) - (tmp-list (split-string attr-string)) - (attr-list) - (counter 0) - (prev (car tmp-list)) - (this (nth 1 tmp-list)) - (next (nth 2 tmp-list)) - (index 1)) - - (cond - ;; size=3 - ((string-match "[^ ]=[^ ]" prev) - (let ((attr (nth 0 (split-string prev "="))) - (value (substring prev (1+ (string-match "=" prev))))) - (setq attr-list (cons (list attr value) attr-list)))) - ;; size= 3 - ((string-match "[^ ]=\\'" prev) - (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) - - (while (< index (length tmp-list)) - (cond - ;; size=3 - ((string-match "[^ ]=[^ ]" this) - (let ((attr (nth 0 (split-string this "="))) - (value (substring this (1+ (string-match "=" this))))) - (setq attr-list (cons (list attr value) attr-list)))) - ;; size =3 - ((string-match "\\`=[^ ]" this) - (setq attr-list (cons (list prev (substring this 1)) attr-list))) - ;; size= 3 - ((string-match "[^ ]=\\'" this) - (setq attr-list (cons (list (substring this 0 -1) next) attr-list))) - ;; size = 3 - ((string= "=" this) - (setq attr-list (cons (list prev next) attr-list)))) - (setq index (1+ index)) - (setq prev this) - (setq this next) - (setq next (nth (1+ index) tmp-list))) - ;; - ;; Tags with no accompanying "=" i.e. value=nil - ;; - (setq prev (car tmp-list)) - (setq this (nth 1 tmp-list)) - (setq next (nth 2 tmp-list)) - (setq index 1) - - (when (and (not (string-match "=" prev)) - (not (string= (substring this 0 1) "="))) - (setq attr-list (cons (list prev nil) attr-list))) - (while (< index (1- (length tmp-list))) - (when (and (not (string-match "=" this)) - (not (or (string= (substring next 0 1) "=") - (string= (substring prev -1) "=")))) - (setq attr-list (cons (list this nil) attr-list))) - (setq index (1+ index)) - (setq prev this) - (setq this next) - (setq next (nth (1+ index) tmp-list))) - - (when (and this - (not (string-match "=" this)) - (not (string= (substring prev -1) "="))) - (setq attr-list (cons (list this nil) attr-list))) - ;; return - value + (re-search-forward "\\s-+" p2 t) + (let (attr-list) + (while (re-search-forward "[-a-z0-9._]+" p2 t) + (setq attr-list + (cons + (list (match-string 0) + (when (looking-at "\\s-*=") + (goto-char (match-end 0)) + (skip-chars-forward "[:space:]") + (when (or (looking-at "\"[^\"]*\"\\|'[^']*'") + (looking-at "[-a-z0-9._:]+")) + (goto-char (match-end 0)) + (match-string 0)))) + attr-list))) attr-list)) ;; diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 0d02e1db758..31b7d073fbe 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1374,8 +1374,6 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." (write-region start end filename append visit lockname))) (autoload 'gmm-write-region "gmm-utils") -(declare-function help-function-arglist "help-fns" - (def &optional preserve-names)) ;; It is not a MIME function, but some MIME functions use it. (if (and (fboundp 'make-temp-file) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 25ee1d3149f..248e505ad79 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -483,7 +483,7 @@ FILE is the file where FUNCTION was probably defined." (beg (if (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def) '(macro lambda closure))) - file-name + (stringp file-name) (help-fns--autoloaded-p function file-name)) (if (commandp def) "an interactive autoloaded " diff --git a/lisp/indent.el b/lisp/indent.el index ab38d502966..20820701b3b 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -249,7 +249,7 @@ indentation by specifying a large negative ARG." (indent-rigidly--pop-undo) (let* ((current (indent-rigidly--current-indentation beg end)) (rtl (eq (current-bidi-paragraph-direction) 'right-to-left)) - (next (indent--next-tab-stop current (if rtl nil 'prev)))) + (next (indent-next-tab-stop current (if rtl nil 'prev)))) (indent-rigidly beg end (- next current)))) (defun indent-rigidly-right-to-tab-stop (beg end) @@ -258,7 +258,7 @@ indentation by specifying a large negative ARG." (indent-rigidly--pop-undo) (let* ((current (indent-rigidly--current-indentation beg end)) (rtl (eq (current-bidi-paragraph-direction) 'right-to-left)) - (next (indent--next-tab-stop current (if rtl 'prev)))) + (next (indent-next-tab-stop current (if rtl 'prev)))) (indent-rigidly beg end (- next current)))) (defun indent-line-to (column) @@ -654,7 +654,7 @@ You can add or remove colons and then do \\\\[edit-tab-stops (setq tab-stop-list tabs)) (message "Tab stops installed")) -(defun indent--next-tab-stop (column &optional prev) +(defun indent-next-tab-stop (column &optional prev) "Return the next tab stop after COLUMN. If PREV is non-nil, return the previous one instead." (let ((tabs tab-stop-list)) @@ -677,6 +677,13 @@ If PREV is non-nil, return the previous one instead." (if (<= column last) -1 (/ (- column last 1) step)) (1+ (/ (- column last) step))))))))) +(defun indent-accumulate-tab-stops (limit) + "Get a list of tab stops before LIMIT (inclusive)." + (let ((tab 0) (tab-stops)) + (while (<= (setq tab (indent-next-tab-stop tab)) limit) + (push tab tab-stops)) + (nreverse tab-stops))) + (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. @@ -684,7 +691,7 @@ Use \\[edit-tab-stops] to edit them interactively." (interactive) (and abbrev-mode (= (char-syntax (preceding-char)) ?w) (expand-abbrev)) - (let ((nexttab (indent--next-tab-stop (current-column)))) + (let ((nexttab (indent-next-tab-stop (current-column)))) (delete-horizontal-space t) (indent-to nexttab))) @@ -693,7 +700,7 @@ Use \\[edit-tab-stops] to edit them interactively." The variable `tab-stop-list' is a list of columns at which there are tab stops. Use \\[edit-tab-stops] to edit them interactively." (interactive) - (let ((nexttab (indent--next-tab-stop (current-column)))) + (let ((nexttab (indent-next-tab-stop (current-column)))) (let ((before (point))) (move-to-column nexttab t) (save-excursion diff --git a/lisp/info.el b/lisp/info.el index 89ca8bdbe33..405d6a22449 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2691,9 +2691,7 @@ Because of ambiguities, this should be concatenated with something like (equal (nth 1 Info-complete-cache) Info-current-node) (equal (nth 2 Info-complete-cache) Info-complete-next-re) (equal (nth 5 Info-complete-cache) Info-complete-nodes) - (let ((prev (nth 3 Info-complete-cache))) - (eq t (compare-strings string 0 (length prev) - prev 0 nil t)))) + (string-prefix-p (nth 3 Info-complete-cache) string) t) ;; We can reuse the previous list. (setq completions (nth 4 Info-complete-cache)) ;; The cache can't be used. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 63b2b4f0eda..4cab85be105 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1176,8 +1176,8 @@ Setup char-width-table appropriate for non-CJK language environment." (elt '((#x0000 #x007F latin) (#x00A0 #x024F latin) - (#x0250 #x02AF phonetic) - (#x02B0 #x036F latin) + (#x0250 #x02AF phonetic) ; IPA Extensions + (#x02B0 #x036F latin) ; Spacing Modifiers and Diacriticals (#x0370 #x03E1 greek) (#x03E2 #x03EF coptic) (#x03F0 #x03F3 greek) @@ -1186,12 +1186,12 @@ Setup char-width-table appropriate for non-CJK language environment." (#x0590 #x05FF hebrew) (#x0600 #x06FF arabic) (#x0700 #x074F syriac) - (#x0750 #x077F arabic) + (#x0750 #x077F arabic) ; Arabic Supplement (#x0780 #x07BF thaana) (#x07C0 #x07FF nko) (#x0800 #x083F samaritan) (#x0840 #x085F mandaic) - (#x08A0 #x08FF arabic) + (#x08A0 #x08FF arabic) ; Arabic Extended-A (#x0900 #x097F devanagari) (#x0980 #x09FF bengali) (#x0A00 #x0A7F gurmukhi) @@ -1205,10 +1205,10 @@ Setup char-width-table appropriate for non-CJK language environment." (#x0E00 #x0E7F thai) (#x0E80 #x0EFF lao) (#x0F00 #x0FFF tibetan) - (#x1000 #x109F burmese) ; according to Unicode 6.1, should be "myanmar" + (#x1000 #x109F burmese) ; Myanmar (#x10A0 #x10FF georgian) (#x1100 #x11FF hangul) - (#x1200 #x139F ethiopic) + (#x1200 #x139F ethiopic) ; Ethiopic and Ethiopic Supplement (#x13A0 #x13FF cherokee) (#x1400 #x167F canadian-aboriginal) (#x1680 #x169F ogham) @@ -1219,13 +1219,14 @@ Setup char-width-table appropriate for non-CJK language environment." (#x1760 #x177F tagbanwa) (#x1780 #x17FF khmer) (#x1800 #x18AF mongolian) - (#x18B0 #x18FF canadian-aboriginal) + (#x18B0 #x18FF canadian-aboriginal) ; Canadian Aboriginal Syllabics Extended (#x1900 #x194F limbu) (#x1950 #x197F tai-le) - (#x1980 #x19DF tai-lue) - (#x19E0 #x19FF khmer) + (#x1980 #x19DF tai-lue) ; New Tai Lue + (#x19E0 #x19FF khmer) ; Khmer Symbols (#x1A00 #x1A00 buginese) (#x1A20 #x1AAF tai-tham) + (#x1AB0 #x1AFF latin) ; Combining Diacritical Marks Extended (#x1B00 #x1B7F balinese) (#x1B80 #x1BBF sundanese) (#x1BC0 #x1BFF batak) @@ -1233,58 +1234,63 @@ Setup char-width-table appropriate for non-CJK language environment." (#x1C50 #x1C7F ol-chiki) (#x1CC0 #x1CCF sundanese) (#x1CD0 #x1CFF vedic) - (#x1D00 #x1DBF phonetic) - (#x1DC0 #x1EFF latin) - (#x1F00 #x1FFF greek) + (#x1D00 #x1DBF phonetic) ; Phonetic Extensions & Supplement + (#x1DC0 #x1EFF latin) ; Latin Extended Additional + (#x1F00 #x1FFF greek) ; Greek Extended (#x2000 #x27FF symbol) (#x2800 #x28FF braille) (#x2900 #x2BFF symbol) (#x2C00 #x2C5F glagolitic) - (#x2C60 #x2C7F latin) + (#x2C60 #x2C7F latin) ; Latin Extended-C (#x2C80 #x2CFF coptic) - (#x2D00 #x2D2F georgian) + (#x2D00 #x2D2F georgian) ; Georgian Supplement (#x2D30 #x2D7F tifinagh) - (#x2D80 #x2DDF ethiopic) - (#x2DE0 #x2DFF cyrillic) + (#x2D80 #x2DDF ethiopic) ; Ethiopic Extended + (#x2DE0 #x2DFF cyrillic) ; Cyrillic Extended-A (#x2E00 #x2E7F symbol) (#x2E80 #x2FDF han) (#x2FF0 #x2FFF ideographic-description) (#x3000 #x303F cjk-misc) - (#x3040 #x30FF kana) + (#x3040 #x30FF kana) ; Hiragana and Katakana (#x3100 #x312F bopomofo) - (#x3130 #x318F hangul) + (#x3130 #x318F hangul) ; Hangul Compatibility Jamo (#x3190 #x319F kanbun) - (#x31A0 #x31BF bopomofo) - (#x31C0 #x31EF cjk-misc) - (#x31F0 #x31FF kana) + (#x31A0 #x31BF bopomofo) ; Bopomofo Extended + (#x31C0 #x31EF cjk-misc) ; CJK Strokes + (#x31F0 #x31FF kana) ; Katakana Phonetic Extensions (#x3200 #x9FAF han) (#xA000 #xA4CF yi) (#xA4D0 #xA4FF lisu) (#xA500 #xA63F vai) - (#xA640 #xA69F cyrillic) + (#xA640 #xA69F cyrillic) ; Cyrillic Extended-B (#xA6A0 #xA6FF bamum) (#xA700 #xA7FF latin) (#xA800 #xA82F syloti-nagri) (#xA830 #xA83F north-indic-number) (#xA840 #xA87F phags-pa) (#xA880 #xA8DF saurashtra) - (#xA8E0 #xA8FF devanagari) + (#xA8E0 #xA8FF devanagari) ; Devanagari Extended (#xA900 #xA92F kayah-li) (#xA930 #xA95F rejang) - (#xA960 #xA97F hangul) + (#xA960 #xA97F hangul) ; Hangul Jamo Extended (#xA980 #xA9DF javanese) + (#xA9E0 #xA9FF burmese) ; Myanmar Extended-B (#xAA00 #xAA5F cham) - (#xAA60 #xAA7B burmese) ; Unicode 6.1: "myanmar" + (#xAA60 #xAA7F burmese) ; Myanmar Extended-A (#xAA80 #xAADF tai-viet) - (#xAAE0 #xAAFF meetei-mayek) - (#xAB00 #xAB2F ethiopic) + (#xAAE0 #xAAFF meetei-mayek) ; Meetei Mayek Extensions + (#xAB00 #xAB2F ethiopic) ; Ethiopic Extended-A + (#xAB30 #xAB6F latin) ; Latin Extended-E (#xABC0 #xABFF meetei-mayek) (#xAC00 #xD7FF hangul) (#xF900 #xFAFF han) - (#xFB1D #xFB4F hebrew) - (#xFB50 #xFDFF arabic) + (#xFB00 #xFB06 latin) ; Latin ligatures + (#xFB13 #xFB17 armenian) ; Armenian ligatures + (#xFB1D #xFB4F hebrew) ; Alphabetic Presentation Forms + (#xFB50 #xFDFF arabic) ; Arabic Presentation Forms-A + (#xFE20 #xFE2F latin) ; Combining Half Marks (#xFE30 #xFE4F han) - (#xFE70 #xFEFF arabic) + (#xFE70 #xFEFF arabic) ; Arabic Presentation Forms-B (#xFF00 #xFF5F cjk-misc) (#xFF61 #xFF9F kana) (#xFFE0 #xFFE6 cjk-misc) @@ -1295,51 +1301,75 @@ Setup char-width-table appropriate for non-CJK language environment." (#x101D0 #x101FF phaistos-disc) (#x10280 #x1029F lycian) (#x102A0 #x102DF carian) + (#x102E0 #x102FF coptic) ; Coptic Epact Numbers (#x10300 #x1032F olt-italic) (#x10330 #x1034F gothic) + (#x10350 #x1037F old-permic) (#x10380 #x1039F ugaritic) (#x103A0 #x103DF old-persian) (#x10400 #x1044F deseret) (#x10450 #x1047F shavian) (#x10480 #x104AF osmanya) + (#x10500 #x1052F elbasan) + (#x10530 #x1056F caucasian-albanian) + (#x10600 #x106BF linear-a) (#x10800 #x1083F cypriot-syllabary) (#x10840 #x1085F aramaic) + (#x10860 #x1087F palmyrene) + (#x10880 #x108AF nabataean) (#x10900 #x1091F phoenician) (#x10920 #x1093F lydian) (#x10980 #x109FF meroitic) (#x10A00 #x10A5F kharoshthi) (#x10A60 #x10A7F old-south-arabian) + (#x10A80 #x10A9F old-north-arabian) + (#x10AC0 #x10AFF manichaean) (#x10B00 #x10B3F avestan) (#x10B40 #x10B5F inscriptional-parthian) (#x10B60 #x10B7F inscriptional-pahlavi) + (#x10B80 #x10BAF psalter-pahlavi) (#x10C00 #x10C4F old-turkic) (#x10E60 #x10E7F rumi-number) (#x11000 #x1107F brahmi) (#x11080 #x110CF kaithi) (#x110D0 #x110FF sora-sompeng) (#x11100 #x1114F chakma) + (#x11150 #x1117F mahajani) (#x11180 #x111DF sharada) + (#x111E0 #x111FF sinhala-archaic-number) + (#x11200 #x1124F khojki) + (#x112B0 #x112FF khudawadi) + (#x11300 #x1137F grantha) + (#x11480 #x114DF tirhuta) + (#x11580 #x115FF siddham) + (#x11600 #x1165F modi) (#x11680 #x116CF takri) + (#x118A0 #x118FF warang-citi) + (#x11AC0 #x11AFF pau-cin-hau) (#x12000 #x123FF cuneiform) (#x12400 #x1247F cuneiform-numbers-and-punctuation) (#x13000 #x1342F egyptian) (#x16800 #x16A3F bamum) + (#x16A40 #x16A6F mro) + (#x16AD0 #x16AFF bassa-vah) + (#x16B00 #x16B8F pahawh-hmong) (#x16F00 #x16F9F miao) - (#x1B000 #x1B0FF kana) + (#x1B000 #x1B0FF kana) ; Kana Supplement + (#x1BC00 #x1BCAF duployan-shorthand) (#x1D000 #x1D0FF byzantine-musical-symbol) (#x1D100 #x1D1FF musical-symbol) (#x1D200 #x1D24F ancient-greek-musical-notation) (#x1D300 #x1D35F tai-xuan-jing-symbol) (#x1D360 #x1D37F counting-rod-numeral) (#x1D400 #x1D7FF mathematical) - (#x1EE00 #x1EEFF arabic) + (#x1E800 #x1E8DF mende-kikakui) + (#x1EE00 #x1EEFF arabic) ; Arabic Mathematical Alphabetic Symbols (#x1F000 #x1F02F mahjong-tile) (#x1F030 #x1F09F domino-tile) (#x1F0A0 #x1F0FF playing-cards) - (#x1F100 #x1F1FF symbol) - (#x1F200 #x1F2FF han) - (#x1F300 #x1F64F symbol) - (#x1F680 #x1F77F symbol) + (#x1F100 #x1F1FF symbol) ; Enclosed Alphanumeric Supplement + (#x1F200 #x1F2FF han) ; Enclosed Ideographic Supplement + (#x1F300 #x1F8FF symbol) (#x20000 #x2B81F han) (#x2F800 #x2FFFF han))) (set-char-table-range char-script-table diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 8f056a71008..e3f49ce3293 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -199,91 +199,158 @@ (carian #x102A0) (olt-italic #x10300) (ugaritic #x10380) + (old-permic #x10350) (old-persian #x103A0) (deseret #x10400) (shavian #x10450) (osmanya #x10480) + (elbasan #x10500) + (caucasian-albanian #x10530) + (linear-a #x10600) (cypriot-syllabary #x10800) + (palmyrene #x10860) + (nabataean #x10880) (phoenician #x10900) (lydian #x10920) (kharoshthi #x10A00) + (manichaean #x10AC0) + (mahajani #x11150) + (sinhala-archaic-number #x111E1) + (khojki #x11200) + (khudawadi #x112B0) + (grantha #x11305) + (tirhuta #x11481) + (siddham #x11580) + (modi #x11600) + (takri #x11680) + (warang-citi #x118A1) + (pau-cin-hau #x11AC0) (cuneiform #x12000) (cuneiform-numbers-and-punctuation #x12400) + (mro #x16A40) + (bassa-vah #x16AD0) + (pahawh-hmong #x16B11) + (duployan-shorthand #x1BC20) (byzantine-musical-symbol #x1D000) (musical-symbol #x1D100) (ancient-greek-musical-notation #x1D200) (tai-xuan-jing-symbol #x1D300) (counting-rod-numeral #x1D360) + (mende-kikakui #x1E810) (mahjong-tile #x1F000) (domino-tile #x1F030))) (defvar otf-script-alist) +;; The below was synchronized with the latest Jan 3, 2013 version of +;; https://www.microsoft.com/typography/otspec/scripttags.htm. (setq otf-script-alist '((arab . arabic) + (armi . aramaic) (armn . armenian) + (avst . avestan) (bali . balinese) + (bamu . bamum) + (batk . batak) + (bng2 . bengali) (beng . bengali) (bopo . bopomofo) (brai . braille) + (brah . brahmi) (bugi . buginese) (buhd . buhid) (byzm . byzantine-musical-symbol) (cans . canadian-aboriginal) + (cari . carian) + (cakm . chakma) + (cham . cham) (cher . cherokee) (copt . coptic) (xsux . cuneiform) - (cyrl . cyrillic) (cprt . cypriot) + (cyrl . cyrillic) (dsrt . deseret) (deva . devanagari) + (dev2 . devanagari) + (egyp . egyptian) (ethi . ethiopic) (geor . georgian) (glag . glagolitic) (goth . gothic) (grek . greek) (gujr . gujarati) + (gjr2 . gujarati) (guru . gurmukhi) + (gur2 . gurmukhi) (hani . han) (hang . hangul) + (jamo . hangul) (hano . hanunoo) (hebr . hebrew) - (kana . kana) + (phli . inscriptional-pahlavi) + (prti . inscriptional-parthian) + (java . javanese) + (kthi . kaithi) + (kana . kana) ; Hiragana (knda . kannada) + (knd2 . kannada) + (kali . kayah-li) (khar . kharoshthi) (khmr . khmer) (lao\ . lao) (latn . latin) + (lepc . lepcha) (limb . limbu) (linb . linear_b) (mlym . malayalam) + (mlm2 . malayalam) + (mand . mandaic) (math . mathematical) + (mtei . meetei-mayek) + (merc . meroitic) + (mero . meroitic) (mong . mongolian) (musc . musical-symbol) (mymr . burmese) (nko\ . nko) (ogam . ogham) + (olck . ol-chiki) (ital . old_italic) (xpeo . old_persian) + (sarb . old-south-arabian) + (orkh . old-turkic) (orya . oriya) + (ory2 . oriya) (osma . osmanya) (phag . phags-pa) (phnx . phoenician) + (rjng . rejang) (runr . runic) + (samr . samaritan) + (saur . saurashtra) + (shrd . sharada) (shaw . shavian) (sinh . sinhala) + (sora . sora-sompeng) + (sund . sundanese) (sylo . syloti_nagri) (syrc . syriac) (tglg . tagalog) (tagb . tagbanwa) - (taml . tamil) (tale . tai_le) + (talu . tai-lue) + (lana . tai-tham) + (tavt . tai-viet) + (takr . takri) + (taml . tamil) + (tml2 . tamil) (telu . telugu) (thaa . thaana) (thai . thai) (tibt . tibetan) (tfng . tifinagh) (ugar . ugaritic) + (vai\ . vai) (yi\ \ . yi))) ;; Set standard fontname specification of characters in the default @@ -312,7 +379,7 @@ (eval-when-compile -;; Build a data to initialize the default fontset at compile time to +;; Build data to initialize the default fontset at compile time to ;; avoid loading charsets that won't be necessary at runtime. ;; The value is (CJK-REGISTRY-VECTOR TARGET-SPEC ...), where diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7b252b4d46d..e7e08342b47 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -244,8 +244,7 @@ The result is a completion table which completes strings of the form (concat S1 S) in the same way as TABLE completes strings of the form (concat S2 S)." (lambda (string pred action) - (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil - completion-ignore-case)) + (let* ((str (if (string-prefix-p s1 string completion-ignore-case) (concat s2 (substring string (length s1))))) (res (if str (complete-with-action action table str pred)))) (when res @@ -257,8 +256,7 @@ the form (concat S2 S)." (+ beg (- (length s1) (length s2)))) . ,(and (eq (car-safe res) 'boundaries) (cddr res))))) ((stringp res) - (if (eq t (compare-strings res 0 (length s2) s2 nil nil - completion-ignore-case)) + (if (string-prefix-p s2 string completion-ignore-case) (concat s1 (substring res (length s2))))) ((eq action t) (let ((bounds (completion-boundaries str table pred ""))) diff --git a/lisp/mouse.el b/lisp/mouse.el index f5a09f45a07..7beea8e26e6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -579,10 +579,10 @@ command alters the kill ring or not." (defun mouse-set-region-1 () ;; Set transient-mark-mode for a little while. (unless (eq (car-safe transient-mark-mode) 'only) - (setq transient-mark-mode - (cons 'only - (unless (eq transient-mark-mode 'lambda) - transient-mark-mode)))) + (setq-local transient-mark-mode + (cons 'only + (unless (eq transient-mark-mode 'lambda) + transient-mark-mode)))) (setq mouse-last-region-beg (region-beginning)) (setq mouse-last-region-end (region-end)) (setq mouse-last-region-tick (buffer-modified-tick))) @@ -801,10 +801,10 @@ The region will be defined with mark and point." ;; Activate the region, using `mouse-start-end' to determine where ;; to put point and mark (e.g., double-click will select a word). - (setq transient-mark-mode - (if (eq transient-mark-mode 'lambda) - '(only) - (cons 'only transient-mark-mode))) + (setq-local transient-mark-mode + (if (eq transient-mark-mode 'lambda) + '(only) + (cons 'only transient-mark-mode))) (let ((range (mouse-start-end start-point start-point click-count))) (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index b8128407c01..4f6d5807ba5 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -801,11 +801,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." v (format "(cd %s; %s)" (tramp-shell-quote-argument localname) command) "") - ;; We should show the output anyway. + ;; We should add the output anyway. (when outbuf (with-current-buffer outbuf (insert-buffer-substring (tramp-get-connection-buffer v))) - (when display (display-buffer outbuf)))) + (when (and display (get-buffer-window outbuf t)) (redisplay)))) ;; When the user did interrupt, we should do it also. We use ;; return code -1 as marker. (quit diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a6771cd306f..68f1ef472f1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2994,13 +2994,13 @@ the result will be a local, non-Tramp, file name." command) t t) 0 1)) - ;; We should show the output anyway. + ;; We should add the output anyway. (when outbuf (with-current-buffer outbuf (insert (with-current-buffer (tramp-get-connection-buffer v) (buffer-string)))) - (when display (display-buffer outbuf)))) + (when (and display (get-buffer-window outbuf t)) (redisplay)))) ;; When the user did interrupt, we should do it also. We use ;; return code -1 as marker. (quit diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index aa44b8dbf4b..15ae9ed6fa8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1225,8 +1225,8 @@ target of the symlink differ." (error (setq ret 1))) - ;; We should show the output anyway. - (when (and outbuf display) (display-buffer outbuf)) + ;; We should redisplay the output. + (when (and display outbuf (get-buffer-window outbuf t)) (redisplay)) ;; Cleanup. We remove all file cache values for the connection, ;; because the remote process could have changed them. diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index e5ac1e1427d..5ee0818a1e5 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -388,7 +388,7 @@ but before calling PC Selection mode): (fboundp 'normal-erase-is-backspace-mode)) (normal-erase-is-backspace-mode 1)) (setq highlight-nonselected-windows nil) - (setq transient-mark-mode t) + (transient-mark-mode 1) (setq mark-even-if-inactive t) (delete-selection-mode 1)) ;;else diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 0a11eafb959..7ad601b1719 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,7 @@ +2014-06-23 Stefan Monnier + + * org-compat.el (activate-mark): Set transient-mark-mode buffer-locally. + 2014-06-22 Mario Lang * org-list.el (org-list-insert-item): The the -> the. diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index e5d6a49f318..c3ccf062db9 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -295,7 +295,7 @@ Works on both Emacs and XEmacs." (setq mark-active t) (when (and (boundp 'transient-mark-mode) (not transient-mark-mode)) - (setq transient-mark-mode 'lambda)) + (set (make-local-variable 'transient-mark-mode) 'lambda)) (when (boundp 'zmacs-regions) (setq zmacs-regions t))))) diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 5c516e70f99..c1175944917 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -1,16 +1,11 @@ -;;; landmark.el --- neural-network robot that learns landmarks +;;; landmark.el --- Neural-network robot that learns landmarks -*- lexical-binding:t -*- ;; Copyright (C) 1996-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Terrence Brannon (was: ) ;; Created: December 16, 1996 - first release to usenet -;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis - -;;;_* Usage -;;; Just type -;;; M-x eval-buffer -;;; M-x landmark-test-run - +;; Keywords: games, neural network, adaptive search, chemotaxis +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -29,6 +24,9 @@ ;;; Commentary: + +;; To try this, just type: M-x landmark-test-run + ;; Landmark is a relatively non-participatory game in which a robot ;; attempts to maneuver towards a tree at the center of the window ;; based on unique olfactory cues from each of the 4 directions. If @@ -228,9 +226,6 @@ 'landmark-font-lock-face-X))) "Font lock rules for Landmark.") -(put 'landmark-mode 'front-sticky - (put 'landmark-mode 'rear-nonsticky '(intangible))) -(put 'landmark-mode 'intangible 1) ;; This one is for when they set view-read-only to t: Landmark cannot ;; allow View Mode to be activated in its buffer. (define-derived-mode landmark-mode special-mode "Lm" @@ -247,7 +242,8 @@ Entry to this mode calls the value of `landmark-mode-hook' if that value is non-nil. One interesting value is `turn-on-font-lock'." (landmark-display-statistics) (setq-local font-lock-defaults '(landmark-font-lock-keywords t)) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (add-hook 'post-command-hook #'landmark--intangible nil t)) ;;;_ + THE SCORE TABLE. @@ -682,8 +678,8 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (landmark-prompt-for-other-game)) (t (message "Let me think...") - (let (square score) - (setq square (landmark-strongest-square)) + (let ((square (landmark-strongest-square)) + score) (cond ((null square) (landmark-terminate-game 'nobody-won)) (t @@ -725,8 +721,7 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE." (min (max (/ (+ (- (cdr click) landmark-y-offset 1) - (let ((inhibit-point-motion-hooks t)) - (count-lines 1 (window-start))) + (count-lines (point-min) (window-start)) landmark-square-height (% landmark-square-height 2) (/ landmark-square-height 2)) @@ -752,8 +747,8 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square score) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square)) + score) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -847,16 +842,15 @@ If the game is finished, this command requests for another game." (defun landmark-point-y () "Return the board row where point is." - (let ((inhibit-point-motion-hooks t)) - (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1)) - landmark-square-height)))) + (1+ (/ (- (count-lines (point-min) (point)) + landmark-y-offset (if (bolp) 0 1)) + landmark-square-height))) (defun landmark-point-square () "Return the index of the square point is on." - (let ((inhibit-point-motion-hooks t)) (landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset) landmark-square-width)) - (landmark-point-y)))) + (landmark-point-y))) (defun landmark-goto-square (index) "Move point to square number INDEX." @@ -864,23 +858,21 @@ If the game is finished, this command requests for another game." (defun landmark-goto-xy (x y) "Move point to square at X, Y coords." - (let ((inhibit-point-motion-hooks t)) (goto-char (point-min)) - (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))) + (forward-line (+ landmark-y-offset (* landmark-square-height (1- y)))) (move-to-column (+ landmark-x-offset (* landmark-square-width (1- x))))) (defun landmark-plot-square (square value) "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there." (or (= value 1) (landmark-goto-square square)) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (insert-and-inherit (cond ((= value 1) ?.) - ((= value 2) ?N) - ((= value 3) ?S) - ((= value 4) ?E) - ((= value 5) ?W) - ((= value 6) ?^))) + (let ((inhibit-read-only t)) + (insert (cond ((= value 1) ?.) + ((= value 2) ?N) + ((= value 3) ?S) + ((= value 4) ?E) + ((= value 5) ?W) + ((= value 6) ?^))) (and (zerop value) (add-text-properties (1- (point)) (point) @@ -895,8 +887,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "Display an N by M Landmark board." (buffer-disable-undo (current-buffer)) (let ((inhibit-read-only t) - (point 1) opoint - (intangible t) + (point (point-min)) opoint (i m) j x) ;; Try to minimize number of chars (because of text properties) (setq tab-width @@ -905,7 +896,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (max (/ (+ (% landmark-x-offset landmark-square-width) landmark-square-width 1) 2) 2))) (erase-buffer) - (newline landmark-y-offset) + (insert-char ?\n landmark-y-offset) (while (progn (setq j n x (- landmark-x-offset landmark-square-width)) @@ -913,9 +904,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (insert-char ?\t (/ (- (setq x (+ x landmark-square-width)) (current-column)) tab-width)) - (insert-char ? (- x (current-column))) - (if (setq intangible (not intangible)) - (put-text-property point (point) 'intangible 2)) + (insert-char ?\s (- x (current-column))) (and (zerop j) (= i (- m 2)) (progn @@ -932,14 +921,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (if (= i (1- m)) (setq opoint point)) (insert-char ?\n landmark-square-height)) - (or (eq (char-after 1) ?.) - (put-text-property 1 2 'point-entered - (lambda (_x _y) (if (bobp) (forward-char))))) - (or intangible - (put-text-property point (point) 'intangible 2)) - (put-text-property point (point) 'point-entered - (lambda (_x _y) (if (eobp) (backward-char)))) - (put-text-property (point-min) (point) 'category 'landmark-mode)) + (insert-char ?\n)) (landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board (sit-for 0)) ; Display NOW @@ -1001,8 +983,7 @@ mouse-1: get robot moving, mouse-2: play on this square"))) "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction." (save-excursion ; Not moving point from last square (let ((depl (landmark-xy-to-index dx dy)) - (inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (inhibit-read-only t)) ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1 (while (/= square1 square2) (landmark-goto-square square1) @@ -1021,32 +1002,56 @@ mouse-1: get robot moving, mouse-2: play on this square"))) (setq landmark-n (1+ landmark-n)) (forward-line 1) (indent-to column) - (insert-and-inherit ?|)))) + (insert ?|)))) ((= dx -1) ; 1st Diagonal (indent-to (prog1 (- (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?/)) + (insert ?/)) (t ; 2nd Diagonal (indent-to (prog1 (+ (current-column) (/ landmark-square-width 2)) (forward-line (/ landmark-square-height 2)))) - (insert-and-inherit ?\\)))))) + (insert ?\\)))))) (sit-for 0)) ; Display NOW ;;;_ + CURSOR MOTION. +(defvar-local landmark--last-pos 0) + +(defconst landmark--intangible-chars "- \t\n|/\\\\") + +(defun landmark--intangible () + (when (or (eobp) + (save-excursion + (not (zerop (skip-chars-forward landmark--intangible-chars))))) + (if (<= landmark--last-pos (point)) ;Moving forward. + (progn + (skip-chars-forward landmark--intangible-chars) + (when (eobp) + (skip-chars-backward landmark--intangible-chars) + (forward-char -1))) + (skip-chars-backward landmark--intangible-chars) + (if (bobp) + (skip-chars-forward landmark--intangible-chars) + (forward-char -1)))) + (setq landmark--last-pos (point))) + ;; previous-line and next-line don't work right with intangible newlines (defun landmark-move-down () "Move point down one row on the Landmark board." (interactive) (if (< (landmark-point-y) landmark-board-height) - (forward-line 1)));;; landmark-square-height))) + (let ((col (current-column))) + (forward-line 1) ;;; landmark-square-height + (move-to-column col)))) (defun landmark-move-up () "Move point up one row on the Landmark board." (interactive) (if (> (landmark-point-y) 1) - (forward-line (- landmark-square-height)))) + (let ((col (current-column))) + (forward-line (- landmark-square-height)) + (move-to-column col)))) (defun landmark-move-ne () "Move point North East on the Landmark board." @@ -1137,7 +1142,7 @@ because it is overwritten by \"One moment please\"." (defun landmark-print-distance () - (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree))) + (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree))) (mapc 'landmark-print-distance-int landmark-directions)) @@ -1302,9 +1307,9 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ - landmark-plot-internal (sym) (defun landmark-plot-internal (sym) (landmark-plot-square (landmark-xy-to-index - (get sym 'x) - (get sym 'y)) - (get sym 'sym))) + (get sym 'x) + (get sym 'y)) + (get sym 'sym))) ;;;_ - landmark-plot-landmarks () (defun landmark-plot-landmarks () (setq landmark-cx (/ landmark-board-width 2)) @@ -1335,26 +1340,24 @@ After this limit is reached, landmark-random-move is called to push him out of i ;;;_ + Distance-calculation functions -;;;_ - square (a) -(defun square (a) - (* a a)) ;;;_ - distance (x x0 y y0) -(defun distance (x x0 y y0) - (sqrt (+ (square (- x x0)) (square (- y y0))))) +(defun landmark--distance (x x0 y y0) + (let ((dx (- x x0)) (dy (- y y0))) + (sqrt (+ (* dx dx) (* dy dy))))) -;;;_ - calc-distance-of-robot-from (direction) -(defun calc-distance-of-robot-from (direction) +;;;_ - landmark-calc-distance-of-robot-from (direction) +(defun landmark-calc-distance-of-robot-from (direction) (put direction 'distance - (distance (get direction 'x) - (landmark-index-to-x (landmark-point-square)) - (get direction 'y) - (landmark-index-to-y (landmark-point-square))))) + (landmark--distance (get direction 'x) + (landmark-index-to-x (landmark-point-square)) + (get direction 'y) + (landmark-index-to-y (landmark-point-square))))) -;;;_ - calc-smell-internal (sym) -(defun calc-smell-internal (sym) +;;;_ - landmark-calc-smell-internal (sym) +(defun landmark-calc-smell-internal (sym) (let ((r (get sym 'r)) - (d (calc-distance-of-robot-from sym))) + (d (landmark-calc-distance-of-robot-from sym))) (if (> (* 0.5 (- 1 (/ d r))) 0) (* 0.5 (- 1 (/ d r))) 0))) @@ -1401,12 +1404,12 @@ After this limit is reached, landmark-random-move is called to push him out of i (defun landmark-calc-current-smells () (mapc (lambda (direction) - (put direction 'smell (calc-smell-internal direction))) + (put direction 'smell (landmark-calc-smell-internal direction))) landmark-directions)) (defun landmark-calc-payoff () (put 'z 't-1 (get 'z 't)) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) (cl-incf landmark-no-payoff) (setf landmark-no-payoff 0))) @@ -1447,8 +1450,9 @@ After this limit is reached, landmark-random-move is called to push him out of i (message "e-w normalization")))) (mapc (lambda (pair) - (if (> (get (car pair) 'y_t) 0) - (funcall (car (cdr pair))))) + (when (> (get (car pair) 'y_t) 0) + (funcall (car (cdr pair))) + (landmark--intangible))) '( (landmark-n landmark-move-up) (landmark-s landmark-move-down) @@ -1470,7 +1474,7 @@ After this limit is reached, landmark-random-move is called to push him out of i (defun landmark-amble-robot () (interactive) - (while (> (calc-distance-of-robot-from 'landmark-tree) 0) + (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0) (landmark-store-old-y_t) (landmark-calc-current-smells) @@ -1504,8 +1508,7 @@ If the game is finished, this command requests for another game." ((not landmark-game-in-progress) (landmark-prompt-for-other-game)) (t - (let (square) - (setq square (landmark-point-square)) + (let ((square (landmark-point-square))) (cond ((null square) (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) @@ -1516,7 +1519,7 @@ If the game is finished, this command requests for another game." (landmark-store-old-y_t) (landmark-calc-current-smells) - (put 'z 't (calc-smell-internal 'landmark-tree)) + (put 'z 't (landmark-calc-smell-internal 'landmark-tree)) (landmark-random-move) @@ -1589,7 +1592,9 @@ If the game is finished, this command requests for another game." ;; distance on scent. (defun landmark-set-landmark-signal-strengths () - (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5)) + (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx) + (* landmark-cy landmark-cy))) + 1.5)) (mapc (lambda (direction) (put direction 'r (* landmark-cx 1.1))) landmark-ew) @@ -1608,7 +1613,7 @@ If the game is finished, this command requests for another game." "Run 100 Landmark games, each time saving the weights from the previous game." (interactive) (landmark 1) - (dotimes (scratch-var 100) + (dotimes (_ 100) (landmark 2))) ;;;###autoload diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index ab7612082d5..3532b4a03f1 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -172,7 +172,7 @@ Special commands: ;; Simple `;' comments go to the comment-column. (and (looking-at "\\s<\\(\\S<\\|\\'\\)") comment-column) ;; The rest goes at the first tab stop. - (or (car tab-stop-list) tab-width))) + (or (indent-next-tab-stop 0)))) (defun asm-colon () "Insert a colon; if it follows a label, delete the label's indentation." diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index abde007cd04..5424e8d4a61 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -504,8 +504,7 @@ is called with one argument, the guessed style." (cond ((or (and a-guessed? b-guessed?) (not (or a-guessed? b-guessed?))) - (string-lessp (symbol-name (car a)) - (symbol-name (car b)))) + (string-lessp (car a) (car b))) (a-guessed? t) (b-guessed? nil))))))) style) diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index ee144df4395..b0ca4f0cdd0 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -36,6 +36,8 @@ ;; ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't ;; pass through. Support complete C/C++ expression and precedence. +;; It will automatically scans for new #define symbols and macros on the way +;; parsing. ;; ;; The hidden code is marked by ellipses (...). Be ;; cautious when editing near ellipses, since the hidden text is @@ -97,11 +99,12 @@ ;; Extensively modified by Daniel LaLiberte (while at Gould). ;; ;; Extensively modified by Luke Lee in 2013 to support complete C expression -;; evaluation. +;; evaluation and argumented macro expansion. ;;; Code: (require 'cc-mode) +(require 'cl-lib) (defgroup hide-ifdef nil "Hide selected code within `ifdef'." @@ -133,6 +136,9 @@ :group 'hide-ifdef :version "23.1") +(defcustom hide-ifdef-exclude-define-regexp nil + "Ignore #define names if those names match this exclusion pattern." + :type 'string) (defvar hide-ifdef-mode-submap ;; Set up the submap that goes after the prefix key. @@ -356,12 +362,32 @@ that form should be displayed.") ;;; The code that understands what ifs and ifdef in files look like. (defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") +(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) +(defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) (defconst hif-ifx-else-endif-regexp - (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) + (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" + hif-endif-regexp)) +(defconst hif-macro-expr-prefix-regexp + (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+")) + +(defconst hif-white-regexp "[ \t]*") +(defconst hif-define-regexp + (concat hif-cpp-prefix "\\(define\\|undef\\)")) +(defconst hif-id-regexp + (concat "[[:alpha:]_][[:alnum:]_]*")) +(defconst hif-macroref-regexp + (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp + "\\(" + "(" hif-white-regexp + "\\(" hif-id-regexp "\\)?" hif-white-regexp + "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*" + "\\(\\.\\.\\.\\)?" hif-white-regexp + ")" + "\\)?" )) ;; Used to store the current token and the whole token list during parsing. ;; Only bound dynamically. @@ -397,7 +423,12 @@ that form should be displayed.") ("/" . hif-divide) ("%" . hif-modulo) ("?" . hif-conditional) - (":" . hif-colon))) + (":" . hif-colon) + ("," . hif-comma) + ("#" . hif-stringify) + ("..." . hif-etc))) + +(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) (defconst hif-token-regexp (concat (regexp-opt (mapcar 'car hif-token-alist)) @@ -413,16 +444,23 @@ that form should be displayed.") (string-to-number string base) (let* ((parts (split-string string "\\." t "[ \t]+")) (frac (cadr parts)) - (quot (expt (* base 1.0) (length frac))) - (num (/ (string-to-number (concat (car parts) frac) base) - quot))) - (if (= num (truncate num)) - (truncate num) - num)))) + (fraclen (length frac)) + (quot (expt (if (zerop fraclen) + base + (* base 1.0)) fraclen))) + (/ (string-to-number (concat (car parts) frac) base) quot)))) + +;; The dynamic binding variable `hif-simple-token-only' is shared only by +;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize' +;; from returning one more value to indicate a simple token is scanned. This help +;; speeding up macro evaluation on those very simple cases like integers or +;; literals. +;; Check the long comments before `hif-find-define' for more details. [lukelee] (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." (let ((token-list nil)) + (setq hif-simple-token-only t) (with-syntax-table hide-ifdef-syntax-table (save-excursion (goto-char start) @@ -435,8 +473,10 @@ that form should be displayed.") ((looking-at hif-string-literal-regexp) (push (substring-no-properties (match-string 1)) token-list) (goto-char (match-end 0))) + ((looking-at hif-token-regexp) - (let ((token (buffer-substring (point) (match-end 0)))) + (let ((token (buffer-substring-no-properties + (point) (match-end 0)))) (goto-char (match-end 0)) ;; (message "token: %s" token) (sit-for 1) (push @@ -444,7 +484,7 @@ that form should be displayed.") (if (string-equal token "defined") 'hif-defined) ;; TODO: ;; 1. postfix 'l', 'll', 'ul' and 'ull' - ;; 2. floating number formats + ;; 2. floating number formats (like 1.23e4) ;; 3. 098 is interpreted as octal conversion error (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" token) @@ -454,9 +494,12 @@ that form should be displayed.") (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" token) (string-to-number token)) ;; decimal - (intern token)) + (prog1 (intern token) + (setq hif-simple-token-only nil))) token-list))) + (t (error "Bad #if expression: %s" (buffer-string))))))) + (nreverse token-list))) ;;------------------------------------------------------------------------ @@ -491,9 +534,115 @@ that form should be displayed.") "Pop the next token from token-list into the let variable `hif-token'." (setq hif-token (pop hif-token-list))) -(defun hif-parse-if-exp (token-list) - "Parse the TOKEN-LIST. Return translated list in prefix form." - (let ((hif-token-list token-list)) +(defsubst hif-if-valid-identifier-p (id) + (not (or (numberp id) + (stringp id)))) + +(defun hif-define-operator (tokens) + "`Upgrade' hif-define xxx to '(hif-define xxx)' so that it won't be +subsitituted" + (let ((result nil) + (tok nil)) + (while (setq tok (pop tokens)) + (push + (if (eq tok 'hif-defined) + (progn + (setq tok (cadr tokens)) + (if (eq (car tokens) 'hif-lparen) + (if (and (hif-if-valid-identifier-p tok) + (eq (caddr tokens) 'hif-rparen)) + (setq tokens (cdddr tokens)) + (error "#define followed by non-identifier: %S" tok)) + (setq tok (car tokens) + tokens (cdr tokens)) + (unless (hif-if-valid-identifier-p tok) + (error "#define followed by non-identifier: %S" tok))) + (list 'hif-defined 'hif-lparen tok 'hif-rparen)) + tok) + result)) + (nreverse result))) + +(defun hif-flatten (l) + "Flatten a tree" + (apply #'nconc + (mapcar (lambda (x) (if (listp x) + (hif-flatten x) + (list x))) l))) + +(defun hif-expand-token-list (tokens &optional macroname expand_list) + "Perform expansion till everything expanded. No self-reference expansion. + EXPAND_LIST is the list of macro names currently being expanded." + (catch 'self-referencing + (let ((expanded nil) + (remains (hif-define-operator + (hif-token-concatenation + (hif-token-stringification tokens)))) + tok rep) + (if macroname + (setq expand_list (cons macroname expand_list))) + ;; Expanding all tokens till list exhausted + (while (setq tok (pop remains)) + (if (memq tok expand_list) + ;; For self-referencing tokens, don't expand it + (throw 'self-referencing tokens)) + (push + (cond + ((or (memq tok hif-valid-token-list) + (numberp tok) + (stringp tok)) + tok) + + ((setq rep (hif-lookup tok)) + (if (and (listp rep) + (eq (car rep) 'hif-define-macro)) ;; a defined macro + ;; Recursively expand it + (if (cadr rep) ;; Argument list is not nil + (if (not (eq (car remains) 'hif-lparen)) + ;; No argument, no invocation + tok + ;; Argumented macro, get arguments and invoke it. + ;; Dynamically bind hif-token-list and hif-token + ;; for hif-macro-supply-arguments + (let* ((hif-token-list (cdr remains)) + (hif-token nil) + (parmlist (mapcar 'hif-expand-token-list + (hif-get-argument-list + tok))) + (result + (hif-expand-token-list + (hif-macro-supply-arguments tok parmlist) + tok expand_list))) + (setq remains (cons hif-token hif-token-list)) + result)) + ;; Argument list is nil, direct expansion + (setq rep (hif-expand-token-list + (caddr rep) ;; Macro's token list + tok expand_list)) + ;; Replace all remaining references immediately + (setq remains (substitute tok rep remains)) + rep) + ;; Lookup tok returns an atom + rep)) + + ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing + ;; this token might results in an incomplete expression that + ;; cannot be parsed further. + ;;((= 1 (hif-defined tok)) ;; defined (hif-defined tok)=1, + ;; ;;but empty (hif-lookup tok)=nil, thus remove this token + ;; (setq remains (delete tok remains)) + ;; nil) + + (t ;; Usual IDs + tok)) + + expanded)) + + (hif-flatten (nreverse expanded))))) + +(defun hif-parse-exp (token-list &optional macroname) + "Parse the TOKEN-LIST. Return translated list in prefix form. MACRONAME +is applied when invoking macros to prevent self-referencing macros." + (let ((hif-token-list (hif-expand-token-list token-list macroname))) (hif-nexttoken) (prog1 (and hif-token @@ -583,7 +732,8 @@ that form should be displayed.") "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift." (let ((result (hif-logshift-expr)) (comp-token nil)) - (while (memq hif-token '(hif-greater hif-less hif-greater-equal hif-less-equal)) + (while (memq hif-token '(hif-greater hif-less hif-greater-equal + hif-less-equal)) (setq comp-token hif-token) (hif-nexttoken) (setq result (list comp-token result (hif-logshift-expr)))) @@ -622,7 +772,8 @@ that form should be displayed.") result)) (defun hif-factor () - "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | 'id(parmlist)' | strings | id." + "Parse a factor: '!' factor | '~' factor | '(' expr ')' | +'defined(' id ')' | 'id(parmlist)' | strings | id." (cond ((eq hif-token 'hif-not) (hif-nexttoken) @@ -655,6 +806,8 @@ that form should be displayed.") ((numberp hif-token) (prog1 hif-token (hif-nexttoken))) + ((stringp hif-token) + (hif-string-concatenation)) ;; Unary plus/minus. ((memq hif-token '(hif-minus hif-plus)) @@ -662,10 +815,91 @@ that form should be displayed.") (t ; identifier (let ((ident hif-token)) - (if (memq ident '(or and)) - (error "Error: missing identifier")) (hif-nexttoken) - `(hif-lookup (quote ,ident)))))) + (if (eq hif-token 'hif-lparen) + (hif-place-macro-invocation ident) + `(hif-lookup (quote ,ident))))))) + +(defun hif-get-argument-list (ident) + (let ((nest 0) + (parmlist nil) ;; A "token" list of parameters, will later be parsed + (parm nil)) + + (while (or (not (eq (hif-nexttoken) 'hif-rparen)) + (/= nest 0)) + (if (eq (car (last parm)) 'hif-comma) + (setq parm nil)) + (cond + ((eq hif-token 'hif-lparen) + (setq nest (1+ nest))) + ((eq hif-token 'hif-rparen) + (setq nest (1- nest))) + ((and (eq hif-token 'hif-comma) + (= nest 0)) + (push (nreverse parm) parmlist) + (setq parm nil))) + (push hif-token parm)) + + (push (nreverse parm) parmlist) ;; Okay even if parm is nil + (hif-nexttoken) ;; Drop the hif-rparen, get next token + (nreverse parmlist))) + +(defun hif-place-macro-invocation (ident) + (let ((parmlist (hif-get-argument-list ident))) + `(hif-invoke (quote ,ident) (quote ,parmlist)))) + +(defun hif-string-concatenation () + "Parse concatenated strings: string | strings string" + (let ((result (substring-no-properties hif-token))) + (while (stringp (hif-nexttoken)) + (setq result (concat + (substring result 0 -1) ; remove trailing '"' + (substring hif-token 1)))) ; remove leading '"' + result)) + +(defun hif-define-macro (parmlist token-body) + "A marker for defined macro with arguments, cannot be evaluated alone with +no parameters inputed." + ;;TODO: input arguments at run time, use minibuffer to query all arguments + (error + "Argumented macro cannot be evaluated without passing any parameter.")) + +(defun hif-stringify (a) + "Stringify a number, string or symbol." + (cond + ((numberp a) + (number-to-string a)) + ((atom a) + (symbol-name a)) + ((stringp a) + (concat "\"" a "\"")) + (t + (error "Invalid token to stringify")))) + +(defun intern-safe (str) + (if (stringp str) + (intern str))) + +(defun hif-token-concat (a b) + "Concatenate two tokens into a longer token, currently support only simple +token concatenation. Also support weird (but valid) token concatenation like +'>' ## '>' becomes '>>'. Here we take care only those that can be evaluated +during preprocessing time and ignore all those that can only be evaluated at +C(++) runtime (like '++', '--' and '+='...)." + (if (or (memq a hif-valid-token-list) + (memq b hif-valid-token-list)) + (let* ((ra (car (rassq a hif-token-alist))) + (rb (car (rassq b hif-token-alist))) + (result (and ra rb + (cdr (assoc (concat ra rb) hif-token-alist))))) + (or result + ;;(error "Invalid token to concatenate") + (error "Concatenating \"%s\" and \"%s\" does not give a valid \ +preprocessing token." + (or ra (symbol-name a)) + (or rb (symbol-name b))))) + (intern-safe (concat (hif-stringify a) + (hif-stringify b))))) (defun hif-mathify (val) "Treat VAL as a number: if it's t or nil, use 1 or 0." @@ -728,23 +962,157 @@ that form should be displayed.") (setq result (funcall hide-ifdef-evaluator e)))) result)) +(defun hif-token-stringification (l) + "Scan token list for 'hif-stringify' ('#') token and stringify the next +token." + (let (result) + (while l + (push (if (eq (car l) 'hif-stringify) + (prog1 + (if (cadr l) + (hif-stringify (cadr l)) + (error "No token to stringify")) + (setq l (cdr l))) + (car l)) + result) + (setq l (cdr l))) + (nreverse result))) + +(defun hif-token-concatenation (l) + "Scan token list for 'hif-token-concat' ('##') token and concatenate two +tokens." + (let ((prev nil) + result) + (while l + (while (eq (car l) 'hif-token-concat) + (unless prev + (error "No token before ## to concatenate")) + (unless (cdr l) + (error "No token after ## to concatenate")) + (setq prev (hif-token-concat prev (cadr l))) + (setq l (cddr l))) + (if prev + (setq result (append result (list prev)))) + (setq prev (car l) + l (cdr l))) + (if prev + (append result (list prev)) + result))) + +(defun hif-delimit (lis atom) + (nconc (mapcan (lambda (l) (list l atom)) + (butlast lis)) + (last lis))) + +;; Perform token replacement: +(defun hif-macro-supply-arguments (macro-name actual-parms) + "Expand a macro call, replace ACTUAL-PARMS in the macro body." + (let* ((SA (assoc macro-name hide-ifdef-env)) + (macro (and SA + (cdr SA) + (eq (cadr SA) 'hif-define-macro) + (cddr SA))) + (formal-parms (and macro (car macro))) + (macro-body (and macro (cadr macro))) + (hide-ifdef-local-env nil) ; dynamic binding local table + actual-count + formal-count + actual + formal + etc) + + (when (and actual-parms formal-parms macro-body) + ;; For each actual parameter, evaluate each one and associate it + ;; with the associated actual parameter, put it into local table and finally + ;; evaluate the macro body. + (if (setq etc (eq (car formal-parms) 'hif-etc)) + ;; Take care of 'hif-etc first. Prefix 'hif-comma back if needed. + (setq formal-parms (cdr formal-parms))) + (setq formal-count (length formal-parms) + actual-count (length actual-parms)) + + (if (> formal-count actual-count) + (error "Too few parmameter for macro %S" macro-name) + (if (< formal-count actual-count) + (or etc + (error "Too many parameters for macro %S" macro-name)))) + + ;; Perform token replacement on the macro-body on the parameters + (while (setq formal (pop formal-parms)) + ;; Prevent repetitive substitutation, thus cannot use 'subst' + ;; for example: + ;; #define mac(a,b) (a+b) + ;; #define testmac mac(b,y) + ;; testmac should expand to (b+y): replace of argument a and b + ;; occurs simultaneously, not sequentially. If sequentially, + ;; according to the argument order, it will become: + ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b) + ;; becomes (b+b) + ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b) + ;; becomes (y+y). + (setq macro-body + ;; Unlike 'subst', 'substitute' replace only the top level + ;; instead of the whole tree; more importantly, it's not + ;; destructive. + (substitute (if (and etc (null formal-parms)) + (hif-delimit actual-parms 'hif-comma) + (car actual-parms)) + formal macro-body)) + (setq actual-parms (cdr actual-parms))) + + ;; Replacement completed, flatten the whole token list + (setq macro-body (hif-flatten macro-body)) + + ;; Stringification and token concatenation happens here + (hif-token-concatenation (hif-token-stringification macro-body))))) + +(defun hif-invoke (macro-name actual-parms) + "Invoke a macro by first expanding it, then reparse the macro-body, +finally invoke the macro." + ;; Reparse the macro body and evaluate it + (funcall hide-ifdef-evaluator + (hif-parse-exp + (hif-macro-supply-arguments macro-name actual-parms) + macro-name))) ;;;----------- end of parser ----------------------- -(defun hif-canonicalize () - "When at beginning of #ifX, return a Lisp expression for its condition." +(defun hif-canonicalize-tokens (regexp) ;; for debugging + "Return the expanded result of the scanned tokens." (save-excursion - (let ((negate (looking-at hif-ifndef-regexp))) - (re-search-forward hif-ifx-regexp) - (let* ((tokens (hif-tokenize (point) - (progn (hif-end-of-line) (point)))) - (expr (hif-parse-if-exp tokens))) - ;; (message "hif-canonicalized: %s" expr) - (if negate - (list 'hif-not expr) - expr))))) + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + tokens))) +(defun hif-canonicalize (regexp) + "When at beginning of `regexp' (i.e. #ifX), return a Lisp expression for +its condition." + (let ((case-fold-search nil)) + (save-excursion + (re-search-forward regexp) + (let* ((curr-regexp (match-string 0)) + (defined (string-match hif-ifxdef-regexp curr-regexp)) + (negate (and defined + (string= (match-string 2 curr-regexp) "n"))) + (hif-simple-token-only nil) ;; Dynamic binding for `hif-tokenize' + (tokens (hif-tokenize (point) + (progn (hif-end-of-line) (point))))) + (if defined + (setq tokens (list 'hif-defined tokens))) + (if negate + (setq tokens (list 'hif-not tokens))) + (hif-parse-exp tokens))))) (defun hif-find-any-ifX () "Move to next #if..., or #ifndef, at point or after." @@ -755,10 +1123,10 @@ that form should be displayed.") (defun hif-find-next-relevant () - "Move to next #if..., #else, or #endif, after the current line." + "Move to next #if..., #elif..., #else, or #endif, after the current line." ;; (message "hif-find-next-relevant at %d" (point)) (end-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) (beginning-of-line))) @@ -766,7 +1134,7 @@ that form should be displayed.") "Move to previous #if..., #else, or #endif, before the current line." ;; (message "hif-find-previous-relevant at %d" (point)) (beginning-of-line) - ;; avoid infinite recursion by only going to beginning of line if match found + ;; Avoid infinite recursion by only going to line-beginning if match found (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) (beginning-of-line))) @@ -778,15 +1146,19 @@ that form should be displayed.") (defun hif-looking-at-else () (looking-at hif-else-regexp)) +(defun hif-looking-at-elif () + (looking-at hif-elif-regexp)) (defun hif-ifdef-to-endif () - "If positioned at #ifX or #else form, skip to corresponding #endif." + "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif." ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) (hif-find-next-relevant) (cond ((hif-looking-at-ifX) (hif-ifdef-to-endif) ; find endif of nested if (hif-ifdef-to-endif)) ; find outer endif or else + ((hif-looking-at-elif) + (hif-ifdef-to-endif)) ((hif-looking-at-else) (hif-ifdef-to-endif)) ; find endif following else ((hif-looking-at-endif) @@ -959,7 +1331,7 @@ Point is left unchanged." ;;; A bit slimy. (defun hif-hide-line (point) - "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." + "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." (when hide-ifdef-lines (save-excursion (goto-char point) @@ -1003,7 +1375,7 @@ Point is left unchanged." "Called at #ifX expression, this hides those parts that should be hidden. It uses the judgment of `hide-ifdef-evaluator'." ;; (message "hif-possibly-hide") (sit-for 1) - (let ((test (hif-canonicalize)) + (let ((test (hif-canonicalize hif-ifx-regexp)) (range (hif-find-range))) ;; (message "test = %s" test) (sit-for 1) @@ -1031,16 +1403,145 @@ It uses the judgment of `hide-ifdef-evaluator'." (goto-char (hif-range-end range)) (end-of-line))) +(defun hif-parse-macro-arglist (str) + "Parse argument list formatted as '( arg1 [ , argn] [...] )', including +the '...'. Return a list of the arguments, if '...' exists the first arg +will be hif-etc." + (let* ((hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' + (tokenlist + (cdr (hif-tokenize + (- (point) (length str)) (point)))) ; remove hif-lparen + etc result token) + (while (not (eq (setq token (pop tokenlist)) 'hif-rparen)) + (cond + ((eq token 'hif-etc) + (setq etc t)) + ((eq token 'hif-comma) + t) + (t + (push token result)))) + (if etc + (cons 'hif-etc (nreverse result)) + (nreverse result)))) +;; The original version of hideif evaluates the macro early and store the +;; final values for the defined macro into the symbol database (aka +;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed +;; tree -> [value]". (The square bracket refers to what's stored in in our +;; `hide-ifdef-env'.) +;; +;; This forbids the evaluation of an argumented macro since the parameters +;; are applied at run time. In order to support argumented macro I then +;; postponed the evaluation process one stage and store the "parsed tree" +;; into symbol database. The evaluation process was then "strings -> tokens +;; -> [parsed tree] -> value". Hideif therefore run slower since it need to +;; evaluate the parsed tree everytime when trying to expand the symbol. These +;; temporarily code changes are obsolete and not in Emacs source repository. +;; +;; Furthermore, CPP did allow partial expression to be defined in several +;; macros and later got concatenated into a complete expression and then +;; evaluate it. In order to match this behavior I had to postpone one stage +;; further, otherwise those partial expression will be fail on parsing and +;; we'll miss all macros that reference it. The evaluation process thus +;; became "strings -> [tokens] -> parsed tree -> value." This degraded the +;; performance since we need to parse tokens and evaluate them everytime +;; when that symbol is referenced. +;; +;; In real cases I found a lot portion of macros are "simple macros" that +;; expand to literals like integers or other symbols. In order to enhance +;; the performance I use this `hif-simple-token-only' to notify my code and +;; save the final [value] into symbol database. [lukelee] + +(defun hif-find-define (&optional min max) + "Parse texts and retrieve all defines within the region MIN and MAX." + (interactive) + (and min (goto-char min)) + (and (re-search-forward hif-define-regexp max t) + (or + (let* ((defining (string= "define" (match-string 2))) + (name (and (re-search-forward hif-macroref-regexp max t) + (match-string 1))) + (parsed nil) + (parmlist (and (match-string 3) ;; First arg id found + (hif-parse-macro-arglist (match-string 2))))) + (if defining + ;; Ignore name (still need to return 't), or define the name + (or (and hide-ifdef-exclude-define-regexp + (string-match hide-ifdef-exclude-define-regexp + name)) + + (let* ((start (point)) + (end (progn (hif-end-of-line) (point))) + (hif-simple-token-only nil) ;; Dynamic binding + (tokens + (and name + ;; `hif-simple-token-only' is set/clear + ;; only in this block + (condition-case nil + ;; Prevent C statements like + ;; 'do { ... } while (0)' + (hif-tokenize start end) + (error + ;; We can't just return nil here since + ;; this will stop hideif from searching + ;; for more #defines. + (setq hif-simple-token-only t) + (buffer-substring-no-properties + start end))))) + ;; For simple tokens we save only the parsed result; + ;; otherwise we save the tokens and parse it after + ;; parameter replacement + (expr (and tokens + ;; `hif-simple-token-only' is checked only + ;; here. + (or (and hif-simple-token-only + (listp tokens) + (= (length tokens) 1) + (hif-parse-exp tokens)) + `(hif-define-macro ,parmlist + ,tokens)))) + (SA (and name + (assoc (intern name) hide-ifdef-env)))) + (and name + (if SA + (or (setcdr SA expr) t) + ;; Lazy evaluation, eval only if hif-lookup find it. + ;; Define it anyway, even if nil it's still in list + ;; and therefore considerred defined + (push (cons (intern name) expr) hide-ifdef-env))))) + ;; #undef + (and name + (hif-undefine-symbol (intern name)))))) + t)) + + +(defun hif-add-new-defines (&optional min max) + "Scan and add all #define macros between MIN and MAX" + (interactive) + (save-excursion + (save-restriction + ;; (mark-region min max) ;; for debugging + (while (hif-find-define min max) + (setf min (point))) + (if max (goto-char max) + (goto-char (point-max)))))) (defun hide-ifdef-guts () "Does most of the work of `hide-ifdefs'. It does not do the work that's pointless to redo on a recursive entry." ;; (message "hide-ifdef-guts") (save-excursion + (let ((case-fold-search nil) + min max) (goto-char (point-min)) - (while (hif-find-any-ifX) - (hif-possibly-hide)))) + (setf min (point)) + (loop do + (setf max (hif-find-any-ifX)) + (hif-add-new-defines min max) + (if max + (hif-possibly-hide)) + (setf min (point)) + while max)))) ;;===%%SF%% hide-ifdef-hiding (End) === @@ -1054,7 +1555,8 @@ It does not do the work that's pointless to redo on a recursive entry." (message "Hide-Read-Only %s" (if hide-ifdef-read-only "ON" "OFF")) (if hide-ifdef-hiding - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) + (setq buffer-read-only (or hide-ifdef-read-only + hif-outside-read-only))) (force-mode-line-update)) (defun hide-ifdef-toggle-outside-read-only () @@ -1090,12 +1592,32 @@ It does not do the work that's pointless to redo on a recursive entry." (hif-set-var var 1) (if hide-ifdef-hiding (hide-ifdefs))) -(defun hide-ifdef-undef (var) - "Undefine a VAR so that #ifdef VAR would not be included." - (interactive "SUndefine what? ") - (hif-set-var var nil) - (if hide-ifdef-hiding (hide-ifdefs))) +(defun hif-undefine-symbol (var) + (setq hide-ifdef-env + (delete (assoc var hide-ifdef-env) hide-ifdef-env))) +;;(defun hide-ifdef-undef (var) +;; "Undefine a VAR so that #ifdef VAR would not be included." +;; (interactive "SUndefine what? ") +;; ;;(hif-set-var var nil);;Luke fixed: set it nil is still considered +;; ;;defined so #ifdef VAR is still true. +;; (hif-undefine-symbol var) +;; (if hide-ifdef-hiding (hide-ifdefs))) + +(defun hide-ifdef-undef (start end) + "Undefine a VAR so that #ifdef VAR would not be included." + (interactive "r") + (let* ((symstr + (or (and mark-active + (buffer-substring-no-properties start end)) + (read-string "Undefine what? " (current-word)))) + (sym (and symstr + (intern symstr)))) + (if (zerop (hif-defined sym)) + (message "`%s' not defined, no need to undefine it" symstr) + (hif-undefine-symbol sym) + (if hide-ifdef-hiding (hide-ifdefs)) + (message "`%S' undefined" sym)))) (defun hide-ifdefs (&optional nomsg) "Hide the contents of some #ifdefs. diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index e7bf3792e5f..a0683d1c409 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -590,27 +590,28 @@ TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or (defun idlwave-shell-make-temp-file (prefix) "Create a temporary file." - ; Hard coded make-temp-file for Emacs<21 - (if (fboundp 'make-temp-file) + (if (featurep 'emacs) (make-temp-file prefix) - (let (file - (temp-file-dir (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp"))) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temp-file-dir))) - (if (featurep 'xemacs) - (write-region "" nil file nil 'silent nil) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file))) + (if (fboundp 'make-temp-file) + (make-temp-file prefix) + (let (file + (temp-file-dir (if (boundp 'temporary-file-directory) + temporary-file-directory + "/tmp"))) + (while (condition-case () + (progn + (setq file + (make-temp-name + (expand-file-name prefix temp-file-dir))) + (if (featurep 'xemacs) + (write-region "" nil file nil 'silent nil) + (write-region "" nil file nil 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file)))) (defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur" diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index c3032b4f195..eb6a55689c1 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -481,6 +481,9 @@ name symbol." ?~ "_" ?, "_" ?= "." + ?\; "." + ?| "." + ?& "." ?< "." ?> ".") "The syntax table to use for Shell-Script mode. @@ -1860,6 +1863,40 @@ Does not preserve point." ((equal tok "in") (sh-smie--sh-keyword-in-p)) (t (sh-smie--keyword-p)))) +(defun sh-smie--default-forward-token () + (forward-comment (point-max)) + (buffer-substring-no-properties + (point) + (progn (if (zerop (skip-syntax-forward ".")) + (while (progn (skip-syntax-forward "w_'") + (looking-at "\\\\")) + (forward-char 2))) + (point)))) + +(defun sh-smie--default-backward-token () + (forward-comment (- (point))) + (let ((pos (point)) + (n (skip-syntax-backward "."))) + (if (or (zerop n) + (and (eq n -1) + (let ((p (point))) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))) + (while + (progn (skip-syntax-backward "w_'") + (or (not (zerop (skip-syntax-backward "\\"))) + (when (eq ?\\ (char-before (1- (point)))) + (let ((p (point))) + (forward-char -1) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))))) + (goto-char (- (point) (% (skip-syntax-backward "\\") 2)))) + (buffer-substring-no-properties (point) pos))) + (defun sh-smie-sh-forward-token () (if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)") (save-excursion @@ -1888,7 +1925,7 @@ Does not preserve point." tok)) (t (let* ((pos (point)) - (tok (smie-default-forward-token))) + (tok (sh-smie--default-forward-token))) (cond ((equal tok ")") "case-)") ((equal tok "(") "case-(") @@ -1932,7 +1969,7 @@ Does not preserve point." (goto-char (match-beginning 1)) (match-string-no-properties 1)) (t - (let ((tok (smie-default-backward-token))) + (let ((tok (sh-smie--default-backward-token))) (cond ((equal tok ")") "case-)") ((equal tok "(") "case-(") @@ -1962,18 +1999,18 @@ May return nil if the line should not be treated as continued." (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) ((and `(:before . ,_) - (guard (when sh-indent-after-continuation - (save-excursion - (ignore-errors - (skip-chars-backward " \t") - (sh-smie--looking-back-at-continuation-p)))))) - ;; After a line-continuation, make sure the rest is indented. - (let* ((sh-indent-after-continuation nil) - (indent (smie-indent-calculate)) - (initial (sh-smie--continuation-start-indent))) - (when (and (numberp indent) (numberp initial) - (<= indent initial)) - `(column . ,(+ initial sh-indentation))))) + ;; After a line-continuation, make sure the rest is indented. + (guard sh-indent-after-continuation) + (guard (save-excursion + (ignore-errors + (skip-chars-backward " \t") + (sh-smie--looking-back-at-continuation-p)))) + (let initial (sh-smie--continuation-start-indent)) + (guard (let* ((sh-indent-after-continuation nil) + (indent (smie-indent-calculate))) + (and (numberp indent) (numberp initial) + (<= indent initial))))) + `(column . ,(+ initial sh-indentation))) (`(:before . ,(or `"(" `"{" `"[")) (when (smie-rule-hanging-p) (if (not (smie-rule-prev-p "&&" "||" "|")) @@ -1997,7 +2034,12 @@ May return nil if the line should not be treated as continued." (smie-rule-bolp)))) (current-column) (smie-indent-calculate))))) - (`(:after . ,(or `"|" `"&&" `"||")) (if (smie-rule-parent-p token) nil 4)) + (`(:before . ,(or `"|" `"&&" `"||")) + (unless (smie-rule-parent-p token) + (smie-backward-sexp token) + `(column . ,(+ (funcall smie-rules-function :elem 'basic) + (smie-indent-virtual))))) + ;; Attempt at backward compatibility with the old config variables. (`(:before . "fi") (sh-var-value 'sh-indent-for-fi)) (`(:before . "done") (sh-var-value 'sh-indent-for-done)) @@ -2118,7 +2160,7 @@ Point should be before the newline." ;; tok)) (t (let* ((pos (point)) - (tok (smie-default-forward-token))) + (tok (sh-smie--default-forward-token))) (cond ;; ((equal tok ")") "case-)") ((and tok (string-match "\\`[a-z]" tok) @@ -2159,7 +2201,7 @@ Point should be before the newline." ;; (goto-char (match-beginning 1)) ;; (match-string-no-properties 1)) (t - (let ((tok (smie-default-backward-token))) + (let ((tok (sh-smie--default-backward-token))) (cond ;; ((equal tok ")") "case-)") ((and tok (string-match "\\`[a-z]" tok) diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index 319a26d71fc..488c9c05a09 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -29,18 +29,7 @@ ;;; Commentary: -;; See ps-print.el for documentation. - -;;; Code: - - -(require 'ps-print) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sample Setup Code: - - +;; Some example hacks for ps-print.el. ;; This stuff is for anybody that's brave enough to look this far, ;; and able to figure out how to use it. It isn't really part of ;; ps-print, but I'll leave it here in hopes it might be useful: @@ -48,20 +37,23 @@ ;; WARNING!!! The following code is *sample* code only. ;; Don't use it unless you understand what it does! -;; The key `f22' should probably be replaced by `print'. --Stef +;;; Code: -;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. +(require 'ps-print) + + + +;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. (defun ps-rmail-mode-hook () - (local-set-key [(f22)] 'ps-rmail-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. - '(ps-article-subject ps-article-author buffer-name))) + (local-set-key [print] 'ps-rmail-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left header will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author buffer-name))) -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for rmail. +;; Like `ps-gnus-print-article-from-summary', but for rmail. (defun ps-rmail-print-message-from-summary () (interactive) (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL")) @@ -76,61 +68,57 @@ (with-current-buffer ps-buf (ps-spool-buffer-with-faces))))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. +;; Look in an article or mail message for the Subject: line. (defun ps-article-subject () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) - "Subject ???"))) + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (concat "Subject: " (or (mail-fetch-field "Subject") "???"))))) ;; Look in an article or mail message for the From: line. Sorta-kinda ;; understands RFC-822 addresses and can pull the real name out where -;; it's provided. To be placed in `ps-left-headers'. +;; it's provided. (defun ps-article-author () (save-excursion - (goto-char (point-min)) - (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) - (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) - (cond + (save-restriction + (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point))) + (let ((fromstring (mail-fetch-field "From"))) + (cond + ;; Try first to match addresses that look like + ;; thompson@wg2.waii.com (Jim Thompson) + ((and fromstring (string-match ".*[ \t]+(\\(.*\\))" fromstring)) + (match-string 1 fromstring)) + ;; Next try to match addresses that look like + ;; Jim Thompson or + ;; "Jim Thompson" + ((and fromstring + (string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)) + (match-string 2 fromstring)) + ;; Couldn't find a real name -- show the address instead. + (fromstring) + (t "From ???")))))) - ;; Try first to match addresses that look like - ;; thompson@wg2.waii.com (Jim Thompson) - ((string-match ".*[ \t]+(\\(.*\\))" fromstring) - (substring fromstring (match-beginning 1) (match-end 1))) - - ;; Next try to match addresses that look like - ;; Jim Thompson or - ;; "Jim Thompson" - ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring) - (substring fromstring (match-beginning 2) (match-end 2))) - - ;; Couldn't find a real name -- show the address instead. - (t fromstring))) - "From ???"))) - -;; A hook to bind to `gnus-article-prepare-hook'. This will set the -;; `ps-left-headers' specially for gnus articles. Unfortunately, +;; A hook to bind to `gnus-article-prepare-hook'. This will set +;; `ps-left-header' specially for gnus articles. Unfortunately, ;; `gnus-article-mode-hook' is called only once, the first time the *Article* ;; buffer enters that mode, so it would only work for the first time ;; we ran gnus. The second time, this hook wouldn't get set up. The ;; only alternative is `gnus-article-prepare-hook'. (defun ps-gnus-article-prepare-hook () - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the article's subject, its - ;; author, and the newsgroup it was in. - '(ps-article-subject ps-article-author gnus-newsgroup-name))) + (setq-local ps-header-lines 3) + ;; The left headers will display the article's subject, its + ;; author, and the newsgroup it was in. + (setq-local ps-left-header + '(ps-article-subject ps-article-author gnus-newsgroup-name))) -;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the -;; `ps-left-headers' specially for mail messages. +;; A hook to bind to `vm-mode-hook' to locally bind prsc and set +;; `ps-left-header' specially for mail messages. (defun ps-vm-mode-hook () - (local-set-key [(f22)] 'ps-vm-print-message-from-summary) - (setq ps-header-lines 3 - ps-left-header - ;; The left headers will display the message's subject, its - ;; author, and the name of the folder it was in. + (local-set-key [print] 'ps-vm-print-message-from-summary) + (setq-local ps-header-lines 3) + ;; The left headers will display the message's subject, its + ;; author, and the name of the folder it was in. + (setq-local ps-left-header '(ps-article-subject ps-article-author buffer-name))) ;; Every now and then I forget to switch from the *Summary* buffer to @@ -138,55 +126,43 @@ ;; article subjects shows up at the printer. This function, bound to ;; prsc for the gnus *Summary* buffer means I don't have to switch ;; buffers first. -;; sb: Updated for Gnus 5. (defun ps-gnus-print-article-from-summary () (interactive) (ps-print-message-from-summary 'gnus-article-buffer "*Article*")) -;; See `ps-gnus-print-article-from-summary'. This function does the -;; same thing for vm. +;; Like `ps-gnus-print-article-from-summary', but for vm. (defun ps-vm-print-message-from-summary () (interactive) (ps-print-message-from-summary 'vm-mail-buffer "")) -;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind -;; prsc. +;; A hook to bind to `gnus-summary-setup-buffer' to locally bind prsc. (defun ps-gnus-summary-setup () - (local-set-key [(f22)] 'ps-gnus-print-article-from-summary)) + (local-set-key [print] 'ps-gnus-print-article-from-summary)) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-file () (save-excursion (goto-char (point-min)) (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "File ???"))) -;; Look in an article or mail message for the Subject: line. To be -;; placed in `ps-left-headers'. (defun ps-info-node () (save-excursion (goto-char (point-min)) (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) - (buffer-substring (match-beginning 1) (match-end 1)) + (match-string 1) "Node ???"))) (defun ps-info-mode-hook () - (setq ps-left-header - ;; The left headers will display the node name and file name. - '(ps-info-node ps-info-file))) + ;; The left headers will display the node name and file name. + (setq-local ps-left-header '(ps-info-node ps-info-file))) -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless you understand what the effects -;; will be! (In fact, this is a copy of Jim's setup for ps-print -- -;; I'd be very surprised if it was useful to *anybody*, without -;; modification.) - -(defun ps-jts-ps-setup () - (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc - (global-set-key [(shift f22)] 'ps-spool-region-with-faces) - (global-set-key [(control f22)] 'ps-despool) +;; WARNING! The following function is a *sample* only, and is *not* meant +;; to be used as a whole unless you understand what the effects will be! +(defun ps-samp-ps-setup () + (global-set-key [print] 'ps-spool-buffer-with-faces) + (global-set-key [S-print] 'ps-spool-region-with-faces) + (global-set-key [C-print] 'ps-despool) (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) (add-hook 'vm-mode-hook 'ps-vm-mode-hook) @@ -195,24 +171,10 @@ (setq ps-spool-duplex t ps-print-color-p nil ps-lpr-command "lpr" - ps-lpr-switches '("-Jjct,duplex_long")) - 'ps-jts-ps-setup) - -;; WARNING! The following function is a *sample* only, and is *not* -;; meant to be used as a whole unless it corresponds to your needs. -;; (In fact, this is a copy of Jack's setup for ps-print -- -;; I would not be that surprised if it was useful to *anybody*, -;; without modification.) - -(defun ps-jack-setup () - (setq ps-print-color-p nil - ps-lpr-command "lpr" - ps-lpr-switches nil - + ps-lpr-switches '("-Jjct,duplex_long") ps-paper-type 'a4 ps-landscape-mode t ps-number-of-columns 2 - ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm @@ -225,13 +187,11 @@ ps-header-lines 2 ps-show-n-of-n t ps-spool-duplex nil - ps-font-family 'Courier ps-font-size 5.5 ps-header-font-family 'Helvetica ps-header-font-size 6 - ps-header-title-font-size 8) - 'ps-jack-setup) + ps-header-title-font-size 8)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 238754e8584..de31f2ec4ae 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -476,8 +476,9 @@ START-EVENT is the mouse click event." (not (member ts tab-stop-list)) (progn (message "Tab stop set to %d" ts) - (setq tab-stop-list (sort (cons ts tab-stop-list) - #'<))))))))) + (when (null tab-stop-list) + (setq tab-stop-list (indent-accumulate-tab-stops (1- ts)))) + (setq tab-stop-list (sort (cons ts tab-stop-list) #'<))))))))) (defun ruler-mode-mouse-del-tab-stop (start-event) "Delete tab stop at the graduation where the mouse pointer is on. @@ -753,7 +754,7 @@ Optional argument PROPS specifies other text properties to apply." i (1+ i) 'help-echo ruler-mode-fill-column-help-echo ruler)) ;; Show the `tab-stop-list' markers. - ((and ruler-mode-show-tab-stops (member j tab-stop-list)) + ((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j)))) (aset ruler i ruler-mode-tab-stop-char) (put-text-property i (1+ i) 'face 'ruler-mode-tab-stop diff --git a/lisp/simple.el b/lisp/simple.el index 63bfbb51419..a8689aaf2e3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3742,14 +3742,34 @@ argument should still be a \"useful\" string for such uses." (if interprogram-cut-function (funcall interprogram-cut-function string))) +;; It has been argued that this should work similar to `self-insert-command' +;; which merges insertions in undo-list in groups of 20 (hard-coded in cmds.c). +(defcustom kill-append-merge-undo nil + "Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously." + :type 'boolean + :group 'killing + :version "24.5") + (defun kill-append (string before-p) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. +Also removes the last undo boundary in the current buffer, + depending on `kill-append-merge-undo'. If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) (or (= (length cur) 0) - (equal nil (get-text-property 0 'yank-handler cur)))))) + (equal nil (get-text-property 0 'yank-handler cur)))) + (when (and kill-append-merge-undo (not buffer-read-only)) + (let ((prev buffer-undo-list) + (next (cdr buffer-undo-list))) + ;; find the next undo boundary + (while (car next) + (pop next) + (pop prev)) + ;; remove this undo boundary + (when prev + (setcdr prev (cdr next))))))) (defcustom yank-pop-change-selection nil "Whether rotating the kill ring changes the window system selection. @@ -4522,7 +4542,7 @@ If NO-TMM is non-nil, leave `transient-mark-mode' alone." (force-mode-line-update) ;Refresh toolbar (bug#16382). (setq mark-active t) (unless (or transient-mark-mode no-tmm) - (setq transient-mark-mode 'lambda)) + (setq-local transient-mark-mode 'lambda)) (run-hooks 'activate-mark-hook)))) (defun set-mark (pos) @@ -4828,7 +4848,7 @@ mode temporarily." (set-mark (point)) (goto-char omark) (cond (temp-highlight - (setq transient-mark-mode (cons 'only transient-mark-mode))) + (setq-local transient-mark-mode (cons 'only transient-mark-mode))) ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p))) (not (or arg (region-active-p)))) (deactivate-mark)) @@ -4867,10 +4887,10 @@ its earlier value." (cond ((and shift-select-mode this-command-keys-shift-translated) (unless (and mark-active (eq (car-safe transient-mark-mode) 'only)) - (setq transient-mark-mode - (cons 'only - (unless (eq transient-mark-mode 'lambda) - transient-mark-mode))) + (setq-local transient-mark-mode + (cons 'only + (unless (eq transient-mark-mode 'lambda) + transient-mark-mode))) (push-mark nil nil t))) ((eq (car-safe transient-mark-mode) 'only) (setq transient-mark-mode (cdr transient-mark-mode)) @@ -4901,7 +4921,7 @@ Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\" or \"mark.*active\" at the prompt." :global t ;; It's defined in C/cus-start, this stops the d-m-m macro defining it again. - :variable transient-mark-mode) + :variable (default-value 'transient-mark-mode)) (defvar widen-automatically t "Non-nil means it is ok for commands to call `widen' when they want to. diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 28792ac558e..1c6128a33a5 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -62,12 +62,8 @@ region.") "If non-nil, make sure that the skeleton inserted ends with a newline. This just influences the way the default `skeleton-end-hook' behaves.") -(defvar skeleton-end-hook - (lambda () - (or (eolp) (not skeleton-end-newline) (newline-and-indent))) +(defvar skeleton-end-hook nil "Hook called at end of skeleton but before going to point of interest. -By default this moves out anything following to next line, - unless `skeleton-end-newline' is set to nil. The variables `v1' and `v2' are still set when calling this.") @@ -197,8 +193,9 @@ not needed, a prompt-string or an expression for complex read functions. If ELEMENT is a string or a character it gets inserted (see also `skeleton-transformation-function'). Other possibilities are: - \\n if not the last element of the skeleton, or not at eol, - go to next line and indent according to mode + \\n go to next line and indent according to mode, unless + this is the first/last element of a skeleton and point + is at bol/eol _ interesting point, interregion here - interesting point, no interregion interaction, overrides interesting point set by _ @@ -215,7 +212,8 @@ or at the first occurrence of _ or at the end of the inserted text. Note that \\n as the last element of the skeleton only inserts a newline if not at eol. If you want to unconditionally insert a newline -at the end of the skeleton, use \"\\n\" instead. +at the end of the skeleton, use \"\\n\" instead. Likewise with \\n +as the first element when at bol. Further elements can be defined via `skeleton-further-elements'. ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted @@ -266,6 +264,7 @@ When done with skeleton, but before going back to `_'-point call (mapcar #'car skeleton-further-elements) (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) (skeleton-internal-list skeleton str)) + (or (eolp) (not skeleton-end-newline) (newline-and-indent)) (run-hooks 'skeleton-end-hook) (sit-for 0) (or (pos-visible-in-window-p beg) diff --git a/lisp/subr.el b/lisp/subr.el index 524b7954b7e..09a085288a5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3677,12 +3677,14 @@ and replace a sub-expression, e.g. (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))) -(defun string-prefix-p (str1 str2 &optional ignore-case) - "Return non-nil if STR1 is a prefix of STR2. +(defun string-prefix-p (prefix string &optional ignore-case) + "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (eq t (compare-strings str1 nil nil - str2 0 (length str1) ignore-case))) + (let ((prefix-length (length prefix))) + (if (> prefix-length (length string)) nil + (eq t (compare-strings prefix 0 prefix-length string + 0 prefix-length ignore-case))))) (defun string-suffix-p (suffix string &optional ignore-case) "Return non-nil if SUFFIX is a suffix of STRING. diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index b11b773dee1..94d02bebb6a 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -418,7 +418,8 @@ stops computed are displayed in the minibuffer with `:' at each stop." (save-excursion (let (tabs) (if arg - (setq tabs (default-value 'tab-stop-list)) + (setq tabs (or (default-value 'tab-stop-list) + (indent-accumulate-tab-stops (window-width)))) (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]"))) (beginning-of-line) (let ((bol (point))) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 5b0433475b6..ce73939ac32 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -363,7 +363,7 @@ of master file." (member "biblatex" TeX-active-styles) ;; poor-man's check... (save-excursion - (re-search-forward "^[^%]*\\\\usepackage.*{biblatex}" nil t)))) + (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t)))) ;;;###autoload (defun reftex-locate-bibliography-files (master-dir &optional files) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 590de2472f2..ccbdc9595c4 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2778,7 +2778,7 @@ Here are all local bindings. ;;;*** -;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "73f6bbd6c6d423835a7a0428204eb3f5") +;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "69a531bd0ac3f97f076b7dda4ec2304d") ;;; Generated autoloads from reftex-parse.el (autoload 'reftex-parse-one "reftex-parse" "\ diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index b445ff6d1f1..b8e34ea65c4 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,11 @@ +2014-06-26 Leo Liu + + * url-http.el (url-http-end-of-headers): Remove duplicate defvar. + + * url-handlers.el (url-http-parse-response): Remove unused autoload. + (url-insert-file-contents): Condition on url-http-response-status + for the HTTP/S specific part. (Bug#17549) + 2014-05-14 Glenn Morris * url-util.el (url-make-private-file): Use with-file-modes. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index c86acb680d0..704c743bfcd 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -33,7 +33,6 @@ (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") -(autoload 'url-http-parse-response "url-http" "Parse just the response code.") ;; Always used after mm-dissect-buffer and defined in the same file. (declare-function mm-save-part-to-file "mm-decode" (handle file)) @@ -308,17 +307,21 @@ They count bytes from the beginning of the body." (insert data)) (list (length data) charset))) +(defvar url-http-codes) + ;;;###autoload (defun url-insert-file-contents (url &optional visit beg end replace) (let ((buffer (url-retrieve-synchronously url))) (unless buffer (signal 'file-error (list url "No Data"))) (with-current-buffer buffer - (let ((response (url-http-parse-response))) - (if (and (>= response 200) (< response 300)) - (goto-char (point-min)) - (let ((desc (buffer-substring-no-properties (1+ (point)) - (line-end-position)))) + ;; XXX: This is HTTP/S specific and should be moved to url-http + ;; instead. See http://debbugs.gnu.org/17549. + (when (bound-and-true-p url-http-response-status) + (unless (and (>= url-http-response-status 200) + (< url-http-response-status 300)) + (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) (kill-buffer buffer) + ;; Signal file-error per http://debbugs.gnu.org/16733. (signal 'file-error (list url desc)))))) (if visit (setq buffer-file-name url)) (save-excursion @@ -333,6 +336,7 @@ They count bytes from the beginning of the body." ;; usual heuristic/rules that we apply to files. (decode-coding-inserted-region start (point) url visit beg end replace)) (list url (car size-and-charset)))))) + (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) (defun url-file-name-completion (url directory &optional predicate) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 23e7d4b6074..608a865be7b 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -48,7 +48,6 @@ (defvar url-http-response-version) (defvar url-http-target-url) (defvar url-http-transfer-encoding) -(defvar url-http-end-of-headers) (defvar url-show-status) (require 'url-gw) diff --git a/make-dist b/make-dist index 84956920aea..68e64c0c3f8 100755 --- a/make-dist +++ b/make-dist @@ -1,8 +1,7 @@ #!/bin/sh ### make-dist: create an Emacs distribution tar file from current srcdir -## Copyright (C) 1995, 1997-1998, 2000-2014 Free Software Foundation, -## Inc. +## Copyright (C) 1995, 1997-1998, 2000-2014 Free Software Foundation, Inc. ## This file is part of GNU Emacs. @@ -461,6 +460,7 @@ if [ "$with_tests" = "yes" ]; then echo "Making links to \`test' and its subdirectories" for f in `find test -type f`; do case $f in + test/automated/*.log) continue ;; test/automated/flymake/warnpred/a.out) continue ;; test/automated/Makefile) continue ;; esac diff --git a/nextstep/ChangeLog b/nextstep/ChangeLog index a3d9b3aa283..45a2dbf427c 100644 --- a/nextstep/ChangeLog +++ b/nextstep/ChangeLog @@ -1,3 +1,8 @@ +2014-06-25 Glenn Morris + + * Makefile.in (${ns_appbindir}): New. + (${ns_appbindir}/Emacs): Use order-only prereq to create output dir. + 2014-06-15 Glenn Morris * Makefile.in (bootstrap-clean): New. diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index 4198fb29453..52f321109b7 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -43,9 +43,12 @@ ${ns_check_file} ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc} ( cd ${ns_appdir} ; umask 022; tar xf - ) touch ${ns_appdir} -${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} - ${MKDIR_P} ${ns_appbindir} - cp -f ../src/emacs${EXEEXT} ${ns_appbindir}/Emacs +${ns_appbindir}: + ${MKDIR_P} $@ + +${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} | \ + ${ns_appbindir} + cp -f ../src/emacs${EXEEXT} $@ .PHONY: all diff --git a/src/ChangeLog b/src/ChangeLog index 0fc0401265c..b25e2d487d7 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,47 @@ +2014-06-27 Glenn Morris + + * Makefile.in: Replace BOOTSTRAPEMACS sleight-of-hand + with an order-only dependence on bootstrap-emacs. (Bug#2151) + (.el.elc): Replace suffix rule with pattern rule. + (%.elc): New pattern rule, with order-only prerequisite. + ($(lisp)): No more need to depend on BOOTSTRAPEMACS. + ($(lispsource)/loaddefs.el): Use an order-only prerequisite + in place of BOOTSTRAPEMACS. + +2014-06-26 Dmitry Antipov + + * fns.c (Fcompare_strings): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE. + +2014-06-25 Dmitry Antipov + + Consistently use validate_subarray to verify substring. + * fns.c (validate_substring): Not static any more. Adjust to + use ptrdiff_t, not EMACS_INT, because string and vector limits + can't exceed ptrdiff_t even if EMACS_INT is wider. + (Fcompare_strings, Fsubstring, Fsubstring_no_properties) + (secure_hash): Adjust user. + * lisp.h (validate_subarray): Add prototype. + * coding.c (Fundecodable_char_position): + * composite.c (Fcomposition_get_gstring, Fcompose_string_internal): + Use validate_subarray. Adjust comment to mention substring. + +2014-06-25 Dmitry Antipov + + Do not allow out-of-range character position in Fcompare_strings. + * fns.c (validate_subarray): Add prototype. + (Fcompare_substring): Use validate_subarray to check ranges. + Adjust comment to mention that the semantics was changed. Also see + http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00447.html. + +2014-06-24 Paul Eggert + + Be more consistent about the 'Qfoo' naming convention. + * image.c (Fimagemagick_types): + * lisp.h (lisp_h_CHECK_TYPE, CHECK_TYPE, CHECK_ARRAY): + * process.c (Fmake_network_process): + Rename C local identifier 'Qfoo to avoid giving the false + impression that it stands for the symbol 'foo'. + 2014-06-23 Dmitry Antipov Simplify and cleanup character conversion stuff. diff --git a/src/Makefile.in b/src/Makefile.in index 81fdccc1ca2..2e1f7fd9451 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1,7 +1,7 @@ ### @configure_input@ -# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2014 Free Software -# Foundation, Inc. +# Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2014 +# Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -604,40 +604,28 @@ tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS ## such as loaddefs.el or *.elc can typically be produced by any old ## Emacs executable, so we would like to avoid rebuilding them whenever ## we build a new Emacs executable. +## +## (In other words, changing a single file src/foo.c would force +## dumping a new bootstrap-emacs, then re-byte-compiling all preloaded +## elisp files, and only then dump the actual src/emacs, which is not +## wrong, but is overkill in 99.99% of the cases.) +## ## To solve the circularity, we use 2 different Emacs executables, ## "emacs" is the main target and "bootstrap-emacs" is the one used ## to build the *.elc and loaddefs.el files. -## To solve the freshness issue, we used to use a third file "witness-emacs" -## which was used to witness the fact that there is a bootstrap-emacs -## executable, and then have dependencies on witness-emacs rather than -## bootstrap-emacs, but that lead to problems in parallel builds (because -## witness-emacs needed to be free from dependencies (to avoid rebuilding -## it), so it was compiled in parallel, leading typically to having 2 -## processes dumping bootstrap-emacs at the same time). -## So instead, we replace the witness-emacs dependencies by conditional -## bootstrap-dependencies (via $(BOOTSTRAPEMACS)). Of course, since we do -## not want to rely on GNU Make features, we have to rely on an external -## script to do the conditional part of the dependency -## (i.e. see the $(SUBDIR) rule ../Makefile.in). +## To solve the freshness issue, in the past we tried various clever tricks, +## but now that we require GNU make, we can simply specify +## bootstrap-emacs$(EXEEXT) as an order-only prerequisite. -.SUFFIXES: .elc .el - -## These suffix rules do not allow additional dependencies, sadly, so -## instead of adding a $(BOOTSTRAPEMACS) dependency here, we add it -## separately below. -## With GNU Make, we would just say "%.el : %.elc $(BOOTSTRAPEMACS)" -.el.elc: +%.elc: %.el | bootstrap-emacs$(EXEEXT) @$(MAKE) -C ../lisp compile-onefile THEFILE=$< EMACS="$(bootstrap_exe)" -## Since the .el.elc rule cannot specify an extra dependency, we do it here. -$(lisp): $(BOOTSTRAPEMACS) - ## VCSWITNESS points to the file that holds info about the current checkout. ## We use it as a heuristic to decide when to rebuild loaddefs.el. ## If empty it is ignored; the parent makefile can set it to some other value. VCSWITNESS = -$(lispsource)/loaddefs.el: $(BOOTSTRAPEMACS) $(VCSWITNESS) +$(lispsource)/loaddefs.el: $(VCSWITNESS) | bootstrap-emacs$(EXEEXT) $(MAKE) -C ../lisp autoloads EMACS="$(bootstrap_exe)" ## Dump an Emacs executable named bootstrap-emacs containing the diff --git a/src/coding.c b/src/coding.c index 16dc37a3f20..79f116fc618 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9091,8 +9091,7 @@ DEFUN ("find-coding-systems-region-internal", DEFUN ("unencodable-char-position", Funencodable_char_position, Sunencodable_char_position, 3, 5, 0, - doc: /* -Return position of first un-encodable character in a region. + doc: /* Return position of first un-encodable character in a region. START and END specify the region and CODING-SYSTEM specifies the encoding to check. Return nil if CODING-SYSTEM does encode the region. @@ -9102,8 +9101,9 @@ list of positions. If optional 5th argument STRING is non-nil, it is a string to search for un-encodable characters. In that case, START and END are indexes -to the string. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object count, Lisp_Object string) +to the string and treated as in `substring'. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, + Lisp_Object count, Lisp_Object string) { EMACS_INT n; struct coding_system coding; @@ -9140,12 +9140,7 @@ to the string. */) else { CHECK_STRING (string); - CHECK_NATNUM (start); - CHECK_NATNUM (end); - if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string))) - args_out_of_range_3 (string, start, end); - from = XINT (start); - to = XINT (end); + validate_subarray (string, start, end, SCHARS (string), &from, &to); if (! STRING_MULTIBYTE (string)) return Qnil; p = SDATA (string) + string_char_to_byte (string, from); diff --git a/src/composite.c b/src/composite.c index 5e14ad037a6..66a20759ec6 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1684,9 +1684,10 @@ Otherwise (for terminal display), FONT-OBJECT must be a terminal ID, a frame, or nil for the selected frame's terminal device. If the optional 4th argument STRING is not nil, it is a string -containing the target characters between indices FROM and TO. -Otherwise FROM and TO are character positions in current buffer; -they can be in either order, and can be integers or markers. +containing the target characters between indices FROM and TO, +which are treated as in `substring'. Otherwise FROM and TO are +character positions in current buffer; they can be in either order, +and can be integers or markers. A glyph-string is a vector containing information about how to display a specific character sequence. The format is: @@ -1742,15 +1743,10 @@ should be ignored. */) } else { - CHECK_NATNUM (from); - CHECK_NATNUM (to); CHECK_STRING (string); + validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); if (! STRING_MULTIBYTE (string)) error ("Attempt to shape unibyte text"); - if (! (XINT (from) <= XINT (to) && XINT (to) <= SCHARS (string))) - args_out_of_range_3 (string, from, to); - frompos = XFASTINT (from); - topos = XFASTINT (to); frombyte = string_char_to_byte (string, frompos); } @@ -1795,21 +1791,18 @@ DEFUN ("compose-string-internal", Fcompose_string_internal, Scompose_string_internal, 3, 5, 0, doc: /* Internal use only. -Compose text between indices START and END of STRING. -Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC +Compose text between indices START and END of STRING, where +START and END are treated as in `substring'. Optional 4th +and 5th arguments are COMPONENTS and MODIFICATION-FUNC for the composition. See `compose-string' for more details. */) - (Lisp_Object string, Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func) + (Lisp_Object string, Lisp_Object start, Lisp_Object end, + Lisp_Object components, Lisp_Object modification_func) { + ptrdiff_t from, to; + CHECK_STRING (string); - CHECK_NUMBER (start); - CHECK_NUMBER (end); - - if (XINT (start) < 0 || - XINT (start) > XINT (end) - || XINT (end) > SCHARS (string)) - args_out_of_range (start, end); - - compose_text (XINT (start), XINT (end), components, modification_func, string); + validate_subarray (string, start, end, SCHARS (string), &from, &to); + compose_text (from, to, components, modification_func, string); return string; } diff --git a/src/fns.c b/src/fns.c index 5074ae3b41b..887a856f224 100644 --- a/src/fns.c +++ b/src/fns.c @@ -50,7 +50,7 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); - + DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */) (Lisp_Object arg) @@ -232,6 +232,7 @@ string STR1, compare the part between START1 (inclusive) and END1 \(exclusive). If START1 is nil, it defaults to 0, the beginning of the string; if END1 is nil, it defaults to the length of the string. Likewise, in string STR2, compare the part between START2 and END2. +Like in `substring', negative values are counted from the end. The strings are compared by the numeric values of their characters. For instance, STR1 is "less than" STR2 if its first differing @@ -244,75 +245,39 @@ If string STR1 is less, the value is a negative number N; - 1 - N is the number of characters that match at the beginning. If string STR1 is greater, the value is a positive number N; N - 1 is the number of characters that match at the beginning. */) - (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) + (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, + Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) { - register ptrdiff_t end1_char, end2_char; - register ptrdiff_t i1, i1_byte, i2, i2_byte; + ptrdiff_t from1, to1, from2, to2, i1, i1_byte, i2, i2_byte; CHECK_STRING (str1); CHECK_STRING (str2); - if (NILP (start1)) - start1 = make_number (0); - if (NILP (start2)) - start2 = make_number (0); - CHECK_NATNUM (start1); - CHECK_NATNUM (start2); - if (! NILP (end1)) - CHECK_NATNUM (end1); - if (! NILP (end2)) - CHECK_NATNUM (end2); - end1_char = SCHARS (str1); - if (! NILP (end1) && end1_char > XINT (end1)) - end1_char = XINT (end1); - if (end1_char < XINT (start1)) - args_out_of_range (str1, start1); + validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1); + validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2); - end2_char = SCHARS (str2); - if (! NILP (end2) && end2_char > XINT (end2)) - end2_char = XINT (end2); - if (end2_char < XINT (start2)) - args_out_of_range (str2, start2); - - i1 = XINT (start1); - i2 = XINT (start2); + i1 = from1; + i2 = from2; i1_byte = string_char_to_byte (str1, i1); i2_byte = string_char_to_byte (str2, i2); - while (i1 < end1_char && i2 < end2_char) + while (i1 < to1 && i2 < to2) { /* When we find a mismatch, we must compare the characters, not just the bytes. */ int c1, c2; - if (STRING_MULTIBYTE (str1)) - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c1, str1, i1, i1_byte); - else - { - c1 = SREF (str1, i1++); - MAKE_CHAR_MULTIBYTE (c1); - } - - if (STRING_MULTIBYTE (str2)) - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c2, str2, i2, i2_byte); - else - { - c2 = SREF (str2, i2++); - MAKE_CHAR_MULTIBYTE (c2); - } + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte); + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte); if (c1 == c2) continue; if (! NILP (ignore_case)) { - Lisp_Object tem; - - tem = Fupcase (make_number (c1)); - c1 = XINT (tem); - tem = Fupcase (make_number (c2)); - c2 = XINT (tem); + c1 = XINT (Fupcase (make_number (c1))); + c2 = XINT (Fupcase (make_number (c2))); } if (c1 == c2) @@ -322,15 +287,15 @@ If string STR1 is greater, the value is a positive number N; past the character that we are comparing; hence we don't add or subtract 1 here. */ if (c1 < c2) - return make_number (- i1 + XINT (start1)); + return make_number (- i1 + from1); else - return make_number (i1 - XINT (start1)); + return make_number (i1 - from1); } - if (i1 < end1_char) - return make_number (i1 - XINT (start1) + 1); - if (i2 < end2_char) - return make_number (- i1 + XINT (start1) - 1); + if (i1 < to1) + return make_number (i1 - from1 + 1); + if (i2 < to2) + return make_number (- i1 + from1 - 1); return Qt; } @@ -1133,9 +1098,9 @@ Elements of ALIST that are not conses are also shared. */) Count negative values backwards from the end. Set *IFROM and *ITO to the two indexes used. */ -static void +void validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to, - ptrdiff_t size, EMACS_INT *ifrom, EMACS_INT *ito) + ptrdiff_t size, ptrdiff_t *ifrom, ptrdiff_t *ito) { EMACS_INT f, t; @@ -1184,8 +1149,7 @@ With one argument, just copy STRING (with properties, if any). */) (Lisp_Object string, Lisp_Object from, Lisp_Object to) { Lisp_Object res; - ptrdiff_t size; - EMACS_INT ifrom, ito; + ptrdiff_t size, ifrom, ito; if (STRINGP (string)) size = SCHARS (string); @@ -1225,9 +1189,7 @@ If FROM or TO is negative, it counts from the end. With one argument, just copy STRING without its properties. */) (Lisp_Object string, register Lisp_Object from, Lisp_Object to) { - ptrdiff_t size; - EMACS_INT from_char, to_char; - ptrdiff_t from_byte, to_byte; + ptrdiff_t from_char, to_char, from_byte, to_byte, size; CHECK_STRING (string); @@ -4656,12 +4618,12 @@ returns nil, then (funcall TEST x1 x2) also returns nil. */) /* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, Lisp_Object binary) +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary) { int i; - ptrdiff_t size; - EMACS_INT start_char = 0, end_char = 0; - ptrdiff_t start_byte, end_byte; + ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; diff --git a/src/image.c b/src/image.c index f8c2402bfc4..b6d1f81ca06 100644 --- a/src/image.c +++ b/src/image.c @@ -8549,7 +8549,6 @@ and `imagemagick-types-inhibit'. */) ExceptionInfo ex; char **imtypes; size_t i; - Lisp_Object Qimagemagicktype; GetExceptionInfo(&ex); imtypes = GetMagickList ("*", &numf, &ex); @@ -8557,8 +8556,8 @@ and `imagemagick-types-inhibit'. */) for (i = 0; i < numf; i++) { - Qimagemagicktype = intern (imtypes[i]); - typelist = Fcons (Qimagemagicktype, typelist); + Lisp_Object imagemagicktype = intern (imtypes[i]); + typelist = Fcons (imagemagicktype, typelist); imtypes[i] = MagickRelinquishMemory (imtypes[i]); } diff --git a/src/lisp.h b/src/lisp.h index 8251c62270c..6d0cd57d41e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -341,8 +341,8 @@ error !; #define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) -#define lisp_h_CHECK_TYPE(ok, Qxxxp, x) \ - ((ok) ? (void) 0 : (void) wrong_type_argument (Qxxxp, x)) +#define lisp_h_CHECK_TYPE(ok, predicate, x) \ + ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons) #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) #define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float) @@ -388,7 +388,7 @@ error !; # define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) -# define CHECK_TYPE(ok, Qxxxp, x) lisp_h_CHECK_TYPE (ok, Qxxxp, x) +# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) # define CONSP(x) lisp_h_CONSP (x) # define EQ(x, y) lisp_h_EQ (x, y) # define FLOATP(x) lisp_h_FLOATP (x) @@ -1008,8 +1008,9 @@ make_lisp_proc (struct Lisp_Process *p) /* Type checking. */ -LISP_MACRO_DEFUN_VOID (CHECK_TYPE, (int ok, Lisp_Object Qxxxp, Lisp_Object x), - (ok, Qxxxp, x)) +LISP_MACRO_DEFUN_VOID (CHECK_TYPE, + (int ok, Lisp_Object predicate, Lisp_Object x), + (ok, predicate, x)) /* Deprecated and will be removed soon. */ @@ -2557,9 +2558,9 @@ CHECK_VECTOR_OR_STRING (Lisp_Object x) CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x); } INLINE void -CHECK_ARRAY (Lisp_Object x, Lisp_Object Qxxxp) +CHECK_ARRAY (Lisp_Object x, Lisp_Object predicate) { - CHECK_TYPE (ARRAYP (x), Qxxxp, x); + CHECK_TYPE (ARRAYP (x), predicate, x); } INLINE void CHECK_BUFFER (Lisp_Object x) @@ -3468,7 +3469,8 @@ ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); extern struct hash_table_test hashtest_eql, hashtest_equal; - +extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, + ptrdiff_t, ptrdiff_t *, ptrdiff_t *); extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); diff --git a/src/process.c b/src/process.c index 592c43acc2d..3242222a94a 100644 --- a/src/process.c +++ b/src/process.c @@ -2844,7 +2844,7 @@ usage: (make-network-process &rest ARGS) */) struct gcpro gcpro1; ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count1; - Lisp_Object QCaddress; /* one of QClocal or QCremote */ + Lisp_Object colon_address; /* Either QClocal or QCremote. */ Lisp_Object tem; Lisp_Object name, buffer, host, service, address; Lisp_Object filter, sentinel; @@ -2892,8 +2892,8 @@ usage: (make-network-process &rest ARGS) */) backlog = XINT (tem); } - /* Make QCaddress an alias for :local (server) or :remote (client). */ - QCaddress = is_server ? QClocal : QCremote; + /* Make colon_address an alias for :local (server) or :remote (client). */ + colon_address = is_server ? QClocal : QCremote; /* :nowait BOOL */ if (!is_server && socktype != SOCK_DGRAM @@ -2920,7 +2920,7 @@ usage: (make-network-process &rest ARGS) */) res = &ai; /* :local ADDRESS or :remote ADDRESS */ - address = Fplist_get (contact, QCaddress); + address = Fplist_get (contact, colon_address); if (!NILP (address)) { host = service = Qnil; @@ -3307,7 +3307,7 @@ usage: (make-network-process &rest ARGS) */) memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen); } #endif - contact = Fplist_put (contact, QCaddress, + contact = Fplist_put (contact, colon_address, conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen)); #ifdef HAVE_GETSOCKNAME if (!is_server) diff --git a/test/ChangeLog b/test/ChangeLog index b90f47631bc..7ad0e9a4b9d 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,47 @@ +2014-06-26 Glenn Morris + + * automated/package-x-test.el: Do not mess with load-path. + + * automated/Makefile.in (%.log): If error, dump log to stdout. + +2014-06-26 Stefan Monnier + + * automated/package-test.el (package-test-update-listing) + (package-test-update-archives, package-test-describe-package): + Adjust tests according to new package-list-unsigned. + +2014-06-26 Glenn Morris + + * automated/ert-tests.el (no-byte-compile): Set it. (Bug#17851) + + * automated/eieio-tests.el (no-byte-compile): Set it. (Bug#17852) + + * automated/Makefile.in: Simplify and parallelize. (Bug#15991) + (XARGS_LIMIT, BYTE_COMPILE_EXTRA_FLAGS) + (setwins, compile-targets, compile-main, compile-clean): Remove. + (GREP_OPTIONS): Unexport. + (.el.elc): Replace with pattern rule. + (%.elc, %.log): New pattern rules. + (ELFILES, LOGFILES): New variables. + (check): Depend on LOGFILES. Call ert-summarize-tests-batch-and-exit. + (clean, mostlyclean): New rules. + (bootstrap-clean): Simplify. + (bootstrap-clean, distclean): Depend on clean. + +2014-06-25 Glenn Morris + + * automated/flymake-tests.el (flymake-tests--current-face): + Sleep for longer. Avoid querying. + +2014-06-25 Dmitry Antipov + + * automated/fns-tests.el (fns-tests-compare-string): New test. + +2014-06-24 Michael Albinus + + * automated/tramp-tests.el (tramp-test26-process-file): Extend test + according to Bug#17815. + 2014-06-21 Fabián Ezequiel Gallina * automated/python-tests.el (python-util-strip-string-1): New test. diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index e0800f09eb0..2670aff5dc2 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in @@ -24,10 +24,6 @@ VPATH = $(srcdir) SEPCHAR = @SEPCHAR@ -# Empty for all systems except MinGW, where xargs needs an explicit -# limitation. -XARGS_LIMIT = @XARGS_LIMIT@ - # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. @@ -38,87 +34,75 @@ EMACS = ../../src/emacs # but we might as well be explicit. EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" -# Extra flags to pass to the byte compiler. -BYTE_COMPILE_EXTRA_FLAGS = - # Prevent any settings in the user environment causing problems. -unexport EMACSDATA EMACSDOC EMACSPATH +unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS # The actual Emacs command run in the targets below. # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= LC_ALL=C EMACS_TEST_DIRECTORY=$(srcdir) "$(EMACS)" $(EMACSOPT) -# Common command to find subdirectories -setwins=for file in `find $(srcdir) -type d -print`; do \ - case $$file in $(srcdir)*/data* | $(srcdir)*/flymake* ) ;; \ - *) wins="$$wins$${wins:+ }$$file" ;; \ - esac; \ - done - .PHONY: all check all: check -# The compilation stuff is copied from lisp/Makefile - see comments there. - -.SUFFIXES: .elc .el - -.el.elc: +%.elc: %.el @echo Compiling $< - @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< + @$(emacs) -f batch-byte-compile $< +## Ignore any test errors so we can continue to test other files. +## (It would be nice if we could get an error when running an +## individual test, but not when running check.) +## But compilation errors are always fatal. +## +## I'd prefer to use -emacs -f ert-run-tests-batch-and-exit rather +## than || true, since the former makes problems more obvious. +## I'd also prefer to @-hide the grep part and not the +## ert-run-tests-batch-and-exit part. +## +## We need to use $loadfile because: +## i) -L :$srcdir -l basename does not work, because we have files whose +## basename duplicates a file in lisp/ (eg eshell.el). +## ii) Although -l basename will automatically load .el or .elc, +## -l ./basename treats basename as a literal file (it would be nice +## to change this). +## +## Beware: it approximates `no-byte-compile', so watch out for false-positives! +%.log: ${srcdir}/%.el + @if grep '^;.*no-byte-compile: t' $< > /dev/null; then \ + loadfile=$<; \ + else \ + loadfile=$& $@ || { \ + stat=ERROR; \ + cat $@; }; \ + echo $$stat: $@ -.PHONY: compile-targets compile-main compile-clean +ELFILES = $(wildcard ${srcdir}/*.el) +LOGFILES = $(patsubst %.el,%.log,$(notdir ${ELFILES})) -# TARGETS is set dynamically in the recursive call from `compile-main'. -compile-targets: $(TARGETS) +## If we have to interrupt a hanging test, preserve the log so we can +## see what the problem was. +.PRECIOUS: %.log -# Compile all the Elisp files that need it. Beware: it approximates -# `no-byte-compile', so watch out for false-positives! -compile-main: compile-clean - @$(setwins); \ - els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ - for el in $$els; do \ - test -f $$el || continue; \ - test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \ - echo "$${el}c"; \ - done | xargs $(XARGS_LIMIT) echo | \ - while read chunk; do \ - $(MAKE) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ - done +check: ${LOGFILES} + $(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^ -# Erase left-over .elc files that do not have a corresponding .el file. -compile-clean: - @$(setwins); \ - elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \ - for el in $$(echo $$elcs | sed -e 's/\.elc/\.el/g'); do \ - if test -f "$$el" -o \! -f "$${el}c"; then :; else \ - echo rm "$${el}c"; \ - rm "$${el}c"; \ - fi \ - done +.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean +clean mostlyclean: + -rm -f *.log -.PHONY: bootstrap-clean distclean maintainer-clean +bootstrap-clean: clean + -rm -f ${srcdir}/*.elc -bootstrap-clean: - -cd $(srcdir) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc - -distclean: +distclean: clean rm -f Makefile maintainer-clean: distclean bootstrap-clean - -check: compile-main - @$(setwins); \ - pattern=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ - for el in $$pattern; do \ - test -f $$el || continue; \ - args="$$args -l $$el"; \ - els="$$els $$el"; \ - done; \ - echo Testing $$els; \ - $(emacs) $$args -f ert-run-tests-batch-and-exit - # Makefile ends here. diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 77ea75ddce2..9a8886231d1 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el @@ -1,7 +1,6 @@ ;;; eieio-tests.el -- eieio tests routines -;; Copyright (C) 1999-2003, 2005-2010, 2012-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1999-2003, 2005-2010, 2012-2014 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam @@ -888,3 +887,7 @@ Subclasses to override slot attributes.") (provide 'eieio-tests) ;;; eieio-tests.el ends here + +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index 53cbd1f1f88..45440e060c2 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el @@ -831,3 +831,7 @@ This macro is used to test if macroexpansion in `should' works." (provide 'ert-tests) ;;; ert-tests.el ends here + +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/test/automated/flymake-tests.el b/test/automated/flymake-tests.el index c9761050f73..e5f444e262b 100644 --- a/test/automated/flymake-tests.el +++ b/test/automated/flymake-tests.el @@ -33,17 +33,19 @@ ;; Warning predicate (defun flymake-tests--current-face (file predicate) (let ((buffer (find-file-noselect - (expand-file-name file flymake-tests-data-directory)))) + (expand-file-name file flymake-tests-data-directory))) + (i 0)) (unwind-protect (with-current-buffer buffer (setq-local flymake-warning-predicate predicate) (goto-char (point-min)) (flymake-mode 1) - ;; XXX: is this reliable enough? - (sleep-for (+ 0.5 flymake-no-changes-timeout)) + ;; Weirdness here... http://debbugs.gnu.org/17647#25 + (while (and flymake-is-running (< (setq i (1+ i)) 10)) + (sleep-for (+ 0.5 flymake-no-changes-timeout))) (flymake-goto-next-error) (face-at-point)) - (and buffer (kill-buffer buffer))))) + (and buffer (let (kill-buffer-query-functions) (kill-buffer buffer)))))) (ert-deftest warning-predicate-rx-gcc () "Test GCC warning via regexp predicate." diff --git a/test/automated/fns-tests.el b/test/automated/fns-tests.el index 21a9e4536af..461995b602e 100644 --- a/test/automated/fns-tests.el +++ b/test/automated/fns-tests.el @@ -69,3 +69,34 @@ (nreverse A) (should (equal [nil nil nil nil nil t t t t t] (vconcat A))) (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A)))))) + +(ert-deftest fns-tests-compare-strings () + (should-error (compare-strings)) + (should-error (compare-strings "xyzzy" "xyzzy")) + (should-error (compare-strings "xyzzy" 0 10 "zyxxy" 0 5)) + (should-error (compare-strings "xyzzy" 0 5 "zyxxy" -1 2)) + (should-error (compare-strings "xyzzy" 'foo nil "zyxxy" 0 1)) + (should-error (compare-strings "xyzzy" 0 'foo "zyxxy" 2 3)) + (should-error (compare-strings "xyzzy" 0 2 "zyxxy" 'foo 3)) + (should-error (compare-strings "xyzzy" nil 3 "zyxxy" 4 'foo)) + (should (compare-strings "" nil nil "" nil nil)) + (should (compare-strings "" 0 0 "" 0 0)) + (should (compare-strings "test" nil nil "test" nil nil)) + (should (compare-strings "test" nil nil "test" nil nil t)) + (should (compare-strings "test" nil nil "test" nil nil nil)) + (should (compare-strings "Test" nil nil "test" nil nil t)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "test" nil nil "Test" nil nil) 1)) + (should (= (compare-strings "foobaz" nil nil "barbaz" nil nil) 1)) + (should (= (compare-strings "barbaz" nil nil "foobar" nil nil) -1)) + (should (= (compare-strings "foobaz" nil nil "farbaz" nil nil) 2)) + (should (= (compare-strings "farbaz" nil nil "foobar" nil nil) -2)) + (should (compare-strings "abcxyz" 0 2 "abcprq" 0 2)) + (should (compare-strings "abcxyz" 0 -3 "abcprq" 0 -3)) + (should (= (compare-strings "abcxyz" 0 6 "abcprq" 0 6) 4)) + (should (= (compare-strings "abcprq" 0 6 "abcxyz" 0 6) -4)) + (should (compare-strings "xyzzy" -3 4 "azza" -3 3)) + (should (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil)) + (should (= (compare-strings "んにちはｺﾝﾆﾁﾊこ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) 1)) + (should (= (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "んにちはｺﾝﾆﾁﾊこ" nil nil) -1))) diff --git a/test/automated/package-test.el b/test/automated/package-test.el index e7c989de57a..b970cd7c9f8 100644 --- a/test/automated/package-test.el +++ b/test/automated/package-test.el @@ -265,7 +265,7 @@ Must called from within a `tar-mode' buffer." (should (package-installed-p 'simple-single)) (switch-to-buffer "*Packages*") (goto-char (point-min)) - (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) (kill-buffer buf)))) @@ -287,7 +287,7 @@ Must called from within a `tar-mode' buffer." ;; New version should be available and old version should be installed (goto-char (point-min)) (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) - (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+unsigned" nil t)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) @@ -318,7 +318,7 @@ Must called from within a `tar-mode' buffer." (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) - (should (search-forward "simple-single is an unsigned package." nil t)) + (should (search-forward "simple-single is an installed package." nil t)) (should (search-forward (format "Status: Installed in `%s/' (unsigned)." (expand-file-name "simple-single-1.3" package-user-dir)) diff --git a/test/automated/package-x-test.el b/test/automated/package-x-test.el index cce51b63561..d58915e7c7b 100644 --- a/test/automated/package-x-test.el +++ b/test/automated/package-x-test.el @@ -22,27 +22,12 @@ ;;; Commentary: -;; You may want to run this from a separate Emacs instance from your -;; main one, because a bug in the code below could mess with your -;; installed packages. - -;; Run this in a clean Emacs session using: -;; -;; $ emacs -Q --batch -L . -l package-x-test.el -f ert-run-tests-batch-and-exit - ;;; Code: (require 'package-x) (require 'ert) (require 'cl-lib) -(eval-when-compile (require 'package-test)) - -;; package-test is not normally in `load-path', so temporarily set -;; `load-path' to contain the current directory. -(let ((load-path (append (list (file-name-directory (or load-file-name - buffer-file-name))) - load-path))) - (require 'package-test)) +(require 'package-test) (defvar package-x-test--single-archive-entry-1-3 (cons 'simple-single diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el index d30a5b0c9a7..b010ab467f6 100644 --- a/test/automated/tramp-tests.el +++ b/test/automated/tramp-tests.el @@ -1246,9 +1246,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) - (let ((tmp-name (tramp--test-make-temp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) + (let* ((tmp-name (tramp--test-make-temp-name)) + (fnnd (file-name-nondirectory tmp-name)) + (default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions) (unwind-protect (progn ;; We cannot use "/bin/true" and "/bin/false"; those paths @@ -1259,17 +1260,25 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) - (should - (zerop - (process-file "ls" nil t nil (file-name-nondirectory tmp-name)))) + (should (zerop (process-file "ls" nil t nil fnnd))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while (re-search-forward tramp-color-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should (string-equal (format "%s\n" fnnd) (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + + ;; Second run. The output must be appended. + (should (zerop (process-file "ls" nil t t fnnd))) ;; `ls' could produce colorized output. (goto-char (point-min)) (while (re-search-forward tramp-color-escape-sequence-regexp nil t) (replace-match "" nil nil)) (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) - (buffer-string))))) + (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) + ;; A non-nil DISPLAY must not raise the buffer. + (should-not (get-buffer-window (current-buffer) t)))) + (ignore-errors (delete-file tmp-name))))) (ert-deftest tramp-test27-start-file-process () diff --git a/test/indent/shell.sh b/test/indent/shell.sh index 8e831bb8f11..4a30739e2d9 100755 --- a/test/indent/shell.sh +++ b/test/indent/shell.sh @@ -41,6 +41,13 @@ for foo in bar; do # bug#17721 } done +filter_3 () # bug#17842 +{ + tr -d '"`' | tr ' ' ' ' | \ + awk -F\; -f filter.awk | \ + grep -v "^," | sort -t, -k2,2 +} + echo -n $(( 5 << 2 )) # This should not be treated as a heredoc (bug#12770). 2