procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

manual upstream merge

Browse source
This commit is contained in:
Joakim Verona 2014-06-27 12:10:03 +02:00
commit 83c4c0569f
83 changed files with 1883 additions and 857 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
ChangeLog
View file

@ -1,3 +1,13 @@
2014-06-27 Glenn Morris <rgm@gnu.org>
* Makefile.in (src): No more need to pass BOOTSTRAPEMACS.
* make-dist: Exclude test/automated/*.log.
2014-06-26 Glenn Morris <rgm@gnu.org>
* Makefile.in (mostlyclean, clean): Maybe clean test/automated.
2014-06-21 Paul Eggert <eggert@cs.ucla.edu>
* configure.ac: Warn about --enable-link-time-optimization's issues

22
Makefile.in
View file

@ -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'

26
admin/ChangeLog
View file

@ -1,3 +1,29 @@
2014-06-26 Eli Zaretskii <eliz@gnu.org>
* notes/unicode: Some notes about what to do when a new Unicode
version is imported.
2014-06-26 Glenn Morris <rgm@gnu.org>
* authors.el: Move here from ../lisp/emacs-lisp.
2014-06-25 Glenn Morris <rgm@gnu.org>
* 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 <rgm@gnu.org>
* unidata/BidiMirroring.txt: Update to 7.0.0 (only comment changes).

9
lisp/emacs-lisp/authors.el → admin/authors.el
View file

@ -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")

35
admin/grammars/Makefile.in
View file

@ -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

33
admin/notes/unicode
View file

@ -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
-------------------------------------------------------------

21
admin/unidata/Makefile.in
View file

@ -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

4
admin/unidata/uvs.el
View file

@ -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"

9
doc/misc/ChangeLog
View file

@ -1,3 +1,12 @@
2014-06-24 Leo Liu <sdl.web@gmail.com>
* dired-x.texi (Omitting Files in Dired, Omitting Variables):
Fix key binding to dired-omit-mode. (Bug#16354)
2014-06-24 Eli Zaretskii <eliz@gnu.org>
* autotype.texi (Skeleton Language): Document the \n feature better.
2014-06-23 Glenn Morris <rgm@gnu.org>
* Makefile.in (%.texi): Disable implicit rules.

7
doc/misc/autotype.texi
View file

@ -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.

10
doc/misc/dired-x.texi
View file

@ -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

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2014-06-24 Eli Barzilay <eli@barzilay.org>
* NEWS: calculator.el user-visible changes.
2014-06-15 Michael Albinus <michael.albinus@gmx.de>
* NEWS: New Tramp method "nc".

6
etc/NEWS
View file

@ -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
---

10
lib-src/ChangeLog
View file

@ -1,3 +1,13 @@
2014-06-26 Glenn Morris <rgm@gnu.org>
* 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 <eggert@cs.ucla.edu>
Omit redundant extern decls.

43
lib-src/Makefile.in
View file

@ -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.

230
lisp/ChangeLog
View file

@ -1,3 +1,203 @@
2014-06-26 Glenn Morris <rgm@gnu.org>
* Makefile.in (update-authors): Update for moved authors.el.
2014-06-26 Leo Liu <sdl.web@gmail.com>
* skeleton.el (skeleton-end-hook): Default to nil and move the
work to skeleton-insert. (Bug#17850)
2014-06-26 Dmitry Antipov <dmantipov@yandex.ru>
* 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 <ueno@gnu.org>
* 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 <rgm@gnu.org>
* 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 <sdl.web@gmail.com>
* 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 <monnier@iro.umontreal.ca>
* emacs-lisp/package.el (package-list-unsigned): New var (bug#17625).
(package-desc-status): Obey it.
2014-06-26 Stephen Berman <stephen.berman@gmx.net>
* 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 <monnier@iro.umontreal.ca>
* 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 <juri@jurta.org>
* 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 <monnier@iro.umontreal.ca>
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 <rgm@gnu.org>
* 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 <rgm@gnu.org>
* 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 <monnier@iro.umontreal.ca>
* 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 <dmantipov@yandex.ru>
* 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 <leonard.a.randall@gmail.com> (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 <eli@barzilay.org>
* calculator.el (calculator-last-input): Drop 'ascii-character property
lookup.
2014-06-24 Leo Liu <sdl.web@gmail.com>
* 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 <eliz@gnu.org>
* 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 <michael.albinus@gmx.de>
* 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 <rgm@gnu.org>
* play/landmark.el (landmark-move-down, landmark-move-up):
Fix 2007-10-20 change - preserve horizontal position.
2014-06-23 Sam Steingold <sds@gnu.org>
* simple.el (kill-append): Remove undo boundary depending on ...
(kill-append-merge-undo): New user option.
2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <eliz@gnu.org>
* 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 <eli@barzilay.org>
* 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 <fgallina@gnu.org>
@ -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 <michael.albinus@gmx.de>
@ -12072,7 +12272,7 @@
2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu>
* 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 <monnier@iro.umontreal.ca>
* 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.

2
lisp/ChangeLog.16
View file

@ -8501,7 +8501,7 @@
2012-07-25 Jay Belanger <jay.p.belanger@gmail.com>
* 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 <julien@danjou.info>

19
lisp/Makefile.in
View file

@ -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.

9
lisp/align.el
View file

@ -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)

4
lisp/calc/calc-alg.el
View file

@ -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)

10
lisp/calculator.el
View file

@ -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)

19
lisp/calendar/todo-mode.el
View file

@ -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)

26
lisp/desktop.el
View file

@ -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'."

2
lisp/emacs-lisp/cl-macs.el
View file

@ -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

59
lisp/emacs-lisp/ert.el
View file

@ -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 ()

3
lisp/emacs-lisp/find-func.el
View file

@ -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.")

36
lisp/emacs-lisp/package.el
View file

@ -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'.

5
lisp/emulation/edt.el
View file

@ -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 ()

17
lisp/files.el
View file

@ -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))))

9
lisp/gnus/ChangeLog
View file

@ -1,3 +1,12 @@
2014-06-26 Glenn Morris <rgm@gnu.org>
* mm-util.el (help-function-arglist): Remove outdated declaration.
2014-06-24 Andreas Schwab <schwab@linux-m68k.org>
* html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted
attribute values. (Bug#17834)
2013-06-22 Dmitry Antipov <dmantipov@yandex.ru>
* gnus-sum.el (gnus-summary-edit-article-done):

80
lisp/gnus/html2text.el
View file

@ -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))
;;

2
lisp/gnus/mm-util.el
View file

@ -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)

2
lisp/help-fns.el
View file

@ -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 "

17
lisp/indent.el
View file

@ -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-map>\\[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

4
lisp/info.el
View file

@ -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.

102
lisp/international/characters.el
View file

@ -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

75
lisp/international/fontset.el
View file

@ -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

6
lisp/minibuffer.el
View file

@ -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 "")))

16
lisp/mouse.el
View file

@ -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)))

4
lisp/net/tramp-adb.el
View file

@ -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

4
lisp/net/tramp-sh.el
View file

@ -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

4
lisp/net/tramp-smb.el
View file

@ -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.

2
lisp/obsolete/pc-select.el
View file

@ -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

4
lisp/org/ChangeLog
View file

@ -1,3 +1,7 @@
2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
* org-compat.el (activate-mark): Set transient-mark-mode buffer-locally.
2014-06-22 Mario Lang <mlang@delysid.org>
* org-list.el (org-list-insert-item): The the -> the.

2
lisp/org/org-compat.el
View file

@ -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)))))

169
lisp/play/landmark.el
View file

@ -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: <brannon@rana.usc.edu>)
;; 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

2
lisp/progmodes/asm-mode.el
View file

@ -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."

3
lisp/progmodes/cc-guess.el
View file

@ -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)

612
lisp/progmodes/hideif.el
View file

@ -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.

41
lisp/progmodes/idlw-shell.el
View file

@ -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"

76
lisp/progmodes/sh-script.el
View file

@ -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)

172
lisp/ps-samp.el
View file

@ -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 <thompson@wg2.waii.com> or
;; "Jim Thompson" <thompson@wg2.waii.com>
((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 <thompson@wg2.waii.com> or
;; "Jim Thompson" <thompson@wg2.waii.com>
((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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

7
lisp/ruler-mode.el
View file

@ -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

36
lisp/simple.el
View file

@ -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.

15
lisp/skeleton.el
View file

@ -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)

10
lisp/subr.el
View file

@ -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.

3
lisp/textmodes/picture.el
View file

@ -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)))

2
lisp/textmodes/reftex-parse.el
View file

@ -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)

2
lisp/textmodes/reftex.el
View file

@ -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" "\

8
lisp/url/ChangeLog
View file

@ -1,3 +1,11 @@
2014-06-26 Leo Liu <sdl.web@gmail.com>
* 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 <rgm@gnu.org>
* url-util.el (url-make-private-file): Use with-file-modes.

16
lisp/url/url-handlers.el
View file

@ -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)

1
lisp/url/url-http.el
View file

@ -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)

4
make-dist
View file

@ -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

5
nextstep/ChangeLog
View file

@ -1,3 +1,8 @@
2014-06-25 Glenn Morris <rgm@gnu.org>
* Makefile.in (${ns_appbindir}): New.
(${ns_appbindir}/Emacs): Use order-only prereq to create output dir.
2014-06-15 Glenn Morris <rgm@gnu.org>
* Makefile.in (bootstrap-clean): New.

9
nextstep/Makefile.in
View file

@ -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

44
src/ChangeLog
View file

@ -1,3 +1,47 @@
2014-06-27 Glenn Morris <rgm@gnu.org>
* 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 <dmantipov@yandex.ru>
* fns.c (Fcompare_strings): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE.
2014-06-25 Dmitry Antipov <dmantipov@yandex.ru>
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 <dmantipov@yandex.ru>
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 <eggert@cs.ucla.edu>
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 <dmantipov@yandex.ru>
Simplify and cleanup character conversion stuff.

38
src/Makefile.in
View file

@ -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

15
src/coding.c
View file

@ -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);

35
src/composite.c
View file

@ -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;
}

94
src/fns.c
View file

@ -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;

5
src/image.c
View file

@ -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]);
}

18
src/lisp.h
View file

@ -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);

10
src/process.c
View file

@ -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)

44
test/ChangeLog
View file

@ -1,3 +1,47 @@
2014-06-26 Glenn Morris <rgm@gnu.org>
* 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 <monnier@iro.umontreal.ca>
* 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 <rgm@gnu.org>
* 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 <rgm@gnu.org>
* automated/flymake-tests.el (flymake-tests--current-face):
Sleep for longer. Avoid querying.
2014-06-25 Dmitry Antipov <dmantipov@yandex.ru>
* automated/fns-tests.el (fns-tests-compare-string): New test.
2014-06-24 Michael Albinus <michael.albinus@gmx.de>
* automated/tramp-tests.el (tramp-test26-process-file): Extend test
according to Bug#17815.
2014-06-21 Fabián Ezequiel Gallina <fgallina@gnu.org>
* automated/python-tests.el (python-util-strip-string-1): New test.

112
test/automated/Makefile.in
View file

@ -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=$<c; \
${MAKE} $$loadfile; \
fi; \
echo Testing $$loadfile; \
stat=OK ; \
$(emacs) -l ert -l $$loadfile \
-f ert-run-tests-batch-and-exit >& $@ || { \
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.

7
test/automated/eieio-tests.el
View file

@ -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 <zappo@gnu.org>
@ -888,3 +887,7 @@ Subclasses to override slot attributes.")
(provide 'eieio-tests)
;;; eieio-tests.el ends here
;; Local Variables:
;; no-byte-compile: t
;; End:

4
test/automated/ert-tests.el
View file

@ -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:

10
test/automated/flymake-tests.el
View file

@ -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."

31
test/automated/fns-tests.el
View file

@ -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)))

6
test/automated/package-test.el
View file

@ -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))

17
test/automated/package-x-test.el
View file

@ -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

27
test/automated/tramp-tests.el
View file

@ -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 ()

7
test/indent/shell.sh
View file

@ -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