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

merge upstream

Browse source
This commit is contained in:
Joakim Verona 2013-09-10 23:52:26 +02:00
parent 92aeabcc8a
commit 63dae8e97d
223 changed files with 6338 additions and 5496 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
ChangeLog
View file

@ -1,3 +1,70 @@
2013-09-09 Glenn Morris <rgm@gnu.org>
* configure.ac (LDFLAGS_NOCOMBRELOC): New variable.
(LDFLAGS): Move nocombreloc option from here...
(LD_SWITCH_SYSTEM_TEMACS): ... to here.
2013-09-08 Glenn Morris <rgm@gnu.org>
* configure.ac (--without-compress-install):
Rename from --without-compress-info. (Bug#9789)
(GZIP_INFO): Remove.
(GZIP_PROG): Allow --without-compress-install to disable it.
* Makefile.in (GZIP_INFO): Remove all references.
* info/dir: Tweak emacs-gnutls entry.
2013-09-07 Paul Eggert <eggert@cs.ucla.edu>
Port --without-x --enable-gcc-warnings to Fedora 19.
* configure.ac (WERROR_CFLAGS): Omit redundant use of
-Wmissing-field-initializers, -Wswitch, -Wtype-limits,
-Wunused-parameter. If there is no window system, also omit
-Wsuggest-attribute=const and -Wsuggest-attribute=noreturn; this
is needed for Fedora 19.
2013-09-05 Dmitry Antipov <dmantipov@yandex.ru>
Make --without-x compatible with --enable-gcc-warnings.
* configure.ac: If both --without-x and --enable-gcc-warnings are
specified, use -Wno-unused-variable, -Wno-unused-but-set-variable
and -Wno-unused-but-set-parameter.
2013-09-04 Paul Eggert <eggert@cs.ucla.edu>
Makefile improvements.
* Makefile.in (lib): Depend on am--refresh, to avoid a race.
(src): Remove duplicate dependency on FRC.
Invoke just one submake, not two. Avoid the need for 'pwd'.
2013-09-02 Jan Djärv <jan.h.d@swipnet.se>
* configure.ac: Add ns_check_file.
2013-08-31 Glenn Morris <rgm@gnu.org>
* configure.ac (--with-sound): Rename ossaudio to bsd-ossaudio,
and voxware to oss.
2013-08-31 Ulrich Müller <ulm@gentoo.org>
* configure.ac: Allow for --with-sound=voxware that will enable
sound but otherwise disable ALSA. This will use the OSS device,
typically /dev/dsp, for sound output. (Bug#15067)
2013-08-31 Glenn Morris <rgm@gnu.org>
* make-dist: Update for nt/INSTALL* changes.
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
* configure.ac (DOCMISC_W32): New var to replace DOCMISC_*_W32.
2013-08-27 Paul Eggert <eggert@cs.ucla.edu>
Simplify EMACS_TIME-related code.

39
Makefile.in
View file

@ -56,7 +56,7 @@
# make docs
# Make Emacs documentation files from their sources; requires makeinfo.
SHELL = /bin/sh
SHELL = @SHELL@
# This may not work with certain non-GNU make's. It only matters when
# inheriting a CDPATH not starting with the current directory.
@ -259,8 +259,6 @@ LN_S_FILEONLY = @LN_S_FILEONLY@
# We use gzip to compress installed .el files.
GZIP_PROG = @GZIP_PROG@
# If non-nil, gzip the installed Info and man pages.
GZIP_INFO = @GZIP_INFO@
# ============================= Targets ==============================
@ -352,9 +350,13 @@ epaths-force-w32: FRC
-e "/^.*#/s|@SRC@|$${w32srcdir}|g") && \
${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
# If lib/Makefile would build files in '.', then build them before
# building 'lib', to avoid races with parallel makes.
lib: am--refresh
lib-src src: $(NTDIR) lib
src: lib-src FRC
src: lib-src
# We need to build `emacs' in `src' to compile the *.elc files in `lisp'
# and `leim'.
@ -376,18 +378,15 @@ lib lib-src lisp leim nt: Makefile FRC
# 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.
src: Makefile FRC
boot=bootstrap-emacs$(EXEEXT); \
if [ ! -x "src/$$boot" ]; then \
cd $@; $(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="$$boot"; \
fi;
if [ -r .bzr/checkout/dirstate ]; then \
vcswitness="`pwd`/.bzr/checkout/dirstate"; \
fi; \
cd $@; $(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="" \
dirstate='.bzr/checkout/dirstate'; \
vcswitness='$$(srcdir)/../'$$dirstate; \
[ -r "$(srcdir)/$$dirstate" ] || vcswitness=''; \
cd $@ || exit; \
boot=bootstrap-emacs$(EXEEXT); \
[ ! -x "$$boot" ] || boot=''; \
$(MAKE) all $(MFLAGS) \
CC='${CC}' CFLAGS='${CFLAGS}' CPPFLAGS='${CPPFLAGS}' \
LDFLAGS='${LDFLAGS}' MAKE='${MAKE}' BOOTSTRAPEMACS="$$boot" \
VCSWITNESS="$$vcswitness"
blessmail: Makefile src FRC
@ -661,7 +660,7 @@ install-info: info
for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \
(cd $${thisdir}; \
${INSTALL_DATA} ${srcdir}/info/$$f $(DESTDIR)${infodir}/$$f); \
( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
[ -n "${GZIP_PROG}" ] || continue ; \
rm -f $(DESTDIR)${infodir}/$$f.gz; \
${GZIP_PROG} -9n $(DESTDIR)${infodir}/$$f; \
done; \
@ -683,7 +682,7 @@ install-man:
dest=`echo "$${page}" | sed -e 's/\.1$$//' -e '$(TRANSFORM)'`.1; \
(cd $${thisdir}; \
${INSTALL_DATA} ${mansrcdir}/$${page} $(DESTDIR)${man1dir}/$${dest}); \
( [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ] ) || continue ; \
[ -n "${GZIP_PROG}" ] || continue ; \
rm -f $(DESTDIR)${man1dir}/$${dest}.gz; \
${GZIP_PROG} -9n $(DESTDIR)${man1dir}/$${dest} || true; \
done
@ -753,12 +752,12 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
for elt in ${INFO_NONMISC} $${info_misc}; do \
(cd $${thisdir}; \
$(INSTALL_INFO) --remove --info-dir=$(DESTDIR)${infodir} $(DESTDIR)${infodir}/$$elt); \
if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
if [ -n "${GZIP_PROG}" ]; then \
ext=.gz; else ext=; fi; \
rm -f $$elt$$ext $$elt-[1-9]$$ext $$elt-[1-9][0-9]$$ext; \
done; \
fi)
(if [ -n "${GZIP_INFO}" ] && [ -n "${GZIP_PROG}" ]; then \
(if [ -n "${GZIP_PROG}" ]; then \
ext=.gz; else ext=; fi; \
if cd ${mansrcdir}; then \
for page in *.1; do \

5
admin/ChangeLog
View file

@ -1,3 +1,8 @@
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* unidata/Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-27 Glenn Morris <rgm@gnu.org>
* admin.el (manual-misc-manuals): Use INFO_COMMON rather than

3
admin/notes/bzr
View file

@ -347,6 +347,9 @@ Runs on commit. Projects can enable it themselves by using `bzr
config' to set post_commit_to option for a branch. See `bzr help email'
(if you have the plugin installed) for other options.
The From: address will be that of your Savannah account, rather than
your `bzr whoami' information.
Note: if you have the bzr-email plugin installed locally, then when
you commit to the Emacs repository it will also try to send a commit
email from your local machine. If your machine is not configured to

25
admin/notes/elpa
View file

@ -1,24 +1,21 @@
NOTES ON THE EMACS PACKAGE ARCHIVE
The GNU Emacs package archive, at elpa.gnu.org, is managed using a Bzr
branch named "elpa", hosted on Savannah. To check it out:
The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git
repository named "elpa", hosted on Savannah. To check it out:
bzr branch bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa elpa
git clone git://bzr.sv.gnu.org/emacs/elpa
cd elpa
echo "public_branch = bzr+ssh://USER@bzr.savannah.gnu.org/emacs/elpa" >> .bzr/branch/branch.conf
bzr bind bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/elpa
git remote set-url --push origin git+ssh://bzr.sv.gnu.org/srv/git/emacs/elpa
[create task branch for edits, etc.]
Changes to this branch propagate to elpa.gnu.org in a semi-manual way.
There exists a copy of the elpa branch on that machine. Someone with
access logs in, pulls the latest changes from Savannah, and runs a
"deployment" script. This script (which is itself kept in the Bzr
branch) generates the content visible at http://elpa.gnu.org/packages.
Changes to this branch propagate to elpa.gnu.org via a "deployment" script run
daily. This script (which is kept in elpa/admin/update-archive.sh) generates
the content visible at http://elpa.gnu.org/packages.
The reason we set things up this way, instead of using the package
upload commands in package-x.el, is to let Emacs hackers conveniently
edit the contents of the "elpa" branch. (In particular, multi-file
packages are stored on the branch in source form, not as tarfiles.)
A new package is released as soon as the "version number" of that package is
changed. So you can use `elpa' to work on a package without fear of releasing
those changes prematurely. And once the code is ready, just bump the
version number to make a new release of the package.
It is easy to use the elpa branch to deploy a "local" copy of the
package archive. For details, see the README file in the elpa branch.

23
admin/notes/hydra
View file

@ -5,15 +5,14 @@ See the end of the file for license conditions.
NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA
A continuous build for Emacs trunk can be found at
A continuous build for Emacs can be found at
http://hydra.nixos.org/jobset/gnu/emacs-trunk
http://hydra.nixos.org/jobset/gnu/emacs-24
* It builds (and runs ERT tests) on these platforms:
i686-cygwin
i686-freebsd
i686-linux
x86_64-darwin
x86_64-linux
* It builds Emacs on various platforms.
Sometimes jobs fail due to hydra problems rather than Emacs problems.
Eg it seems like the cygwin build will never work again.
http://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html
* Mail notifications
In addition to the web interface, Hydra can send notifications by
@ -27,15 +26,15 @@ http://lists.gnu.org/mailman/listinfo/emacs-buildstatus
* The Emacs jobset consists of the following jobs:
** The `tarball' job
which gets the source tree as input, and is just a `make dist' after
some autoconf/-make or bootstrap script.
which gets a checkout from bzr, and does a bootstrap followed
by running make-dist to create a tarball. If this job fails, all the
others will too (because they use the tarball as input).
** The `build' job
which gets the result of the tarball job as input, together with
system identifier, this job basically does a normal make and make install.
which starts from the tarball and does a normal build
** The 'coverage' job
is now running `make check'.
does a gcov build and then runs `make check'. Fails if any test fails.
* Nix expressions
The recipe for GNU Emacs are available via Git:

18
admin/nt/README-ftp-server
View file

@ -16,12 +16,6 @@ See the end of the file for license conditions.
accustomed to compiling programs themselves. Corresponding source
can be found in the parent directory in emacs-24.3.tar.gz.
If you have access to the World Wide Web, I would recommend pointing
your favorite web browser to the following document (if you haven't
already):
http://www.gnu.org/software/emacs/windows/ntemacs.html
* IMPORTANT LEGAL REMINDER
If you want to redistribute any of the precompiled distributions of
@ -230,16 +224,10 @@ See the end of the file for license conditions.
* Further information
If you have access to the World Wide Web, I would recommend pointing
your favorite web browser to following the document (if you haven't
already):
The Emacs on MS Windows FAQ is distributed with Emacs (info
manual "efaq-w32"), and at
http://www.gnu.org/software/emacs/windows/ntemacs.html
This document serves as an FAQ and a source for further information
about the Windows port and related software packages. Note that as
most of the information in that FAQ is for earlier versions, so some
information may not be relevant to Emacs-24.3.
http://www.gnu.org/software/emacs/manual/efaq-w32.html
In addition to the FAQ, there is a mailing list for discussing issues
related to the Windows port of Emacs. For information about the

2
admin/unidata/Makefile.in
View file

@ -21,7 +21,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
srcdir = @srcdir@
abs_builddir = @abs_builddir@

8
autogen/Makefile.in
View file

@ -423,11 +423,7 @@ DEFS = @DEFS@
DEPDIR = @DEPDIR@
DEPFLAGS = @DEPFLAGS@
DESLIB = @DESLIB@
DOCMISC_DVI_W32 = @DOCMISC_DVI_W32@
DOCMISC_HTML_W32 = @DOCMISC_HTML_W32@
DOCMISC_INFO_W32 = @DOCMISC_INFO_W32@
DOCMISC_PDF_W32 = @DOCMISC_PDF_W32@
DOCMISC_PS_W32 = @DOCMISC_PS_W32@
DOCMISC_W32 = @DOCMISC_W32@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
@ -681,7 +677,6 @@ GSETTINGS_LIBS = @GSETTINGS_LIBS@
GTK_CFLAGS = @GTK_CFLAGS@
GTK_LIBS = @GTK_LIBS@
GTK_OBJ = @GTK_OBJ@
GZIP_INFO = @GZIP_INFO@
GZIP_PROG = @GZIP_PROG@
HAVE_ALPHASORT = @HAVE_ALPHASORT@
HAVE_ATOLL = @HAVE_ATOLL@
@ -1224,6 +1219,7 @@ ns_appbindir = @ns_appbindir@
ns_appdir = @ns_appdir@
ns_appresdir = @ns_appresdir@
ns_appsrc = @ns_appsrc@
ns_check_file = @ns_check_file@
ns_self_contained = @ns_self_contained@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@

218
autogen/configure vendored
View file

@ -604,6 +604,7 @@ am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
SUBDIR_MAKEFILES_IN
ns_check_file
WINDOW_SYSTEM_OBJ
EMACS_HEAPSIZE
TEMACS_POST_LINK
@ -1397,11 +1398,7 @@ UNEXEC_OBJ
C_SWITCH_MACHINE
LD_SWITCH_SYSTEM
CANNOT_DUMP
DOCMISC_PS_W32
DOCMISC_PDF_W32
DOCMISC_INFO_W32
DOCMISC_HTML_W32
DOCMISC_DVI_W32
DOCMISC_W32
INFO_OPTS
INFO_EXT
HAVE_MAKEINFO
@ -1445,7 +1442,6 @@ build_vendor
build_cpu
build
PROFILING_CFLAGS
GZIP_INFO
cache_file
am__untar
am__tar
@ -1548,7 +1544,7 @@ with_gnutls
with_zlib
with_file_notification
with_makeinfo
with_compress_info
with_compress_install
with_pkg_config_prog
with_gameuser
with_gnustep_conf
@ -2246,8 +2242,8 @@ Optional Packages:
--with-mail-unlink unlink, rather than empty, mail spool after reading
--with-mailhost=HOSTNAME
string giving default POP mail host
--with-sound=VALUE compile with sound support (VALUE one of: yes,
ossaudio, alsa, no; default yes). Only for
--with-sound=VALUE compile with sound support (VALUE one of: yes, alsa,
oss, bsd-ossaudio, no; default yes). Only for
GNU/Linux, FreeBSD, NetBSD, MinGW.
--with-x-toolkit=KIT use an X toolkit (KIT one of: yes or gtk, gtk2,
gtk3, lucid or athena, motif, no)
@ -2281,7 +2277,9 @@ Optional Packages:
use a file notification library (LIB one of: yes,
gfile, inotify, w32, no)
--without-makeinfo don't require makeinfo for building manuals
--without-compress-info don't compress the installed Info pages
--without-compress-install
don't compress some files (.el, .info, etc.) when
installing. Equivalent to: make GZIP_PROG= install
--with-pkg-config-prog=FILENAME
file name of pkg-config for finding GTK and librsvg
--with-gameuser=USER user for shared game score files
@ -4155,9 +4153,9 @@ fi
# Check whether --with-sound was given.
if test "${with_sound+set}" = set; then :
withval=$with_sound; case "${withval}" in
yes|no|ossaudio|alsa) val=$withval ;;
yes|no|alsa|oss|bsd-ossaudio) val=$withval ;;
*) as_fn_error "\`--with-sound=$withval' is invalid;
this option's value should be \`yes', \`no', \`ossaudio', or \`alsa'." "$LINENO" 5
this option's value should be \`yes', \`no', \`alsa', \`oss', or \`bsd-ossaudio'." "$LINENO" 5
;;
esac
with_sound=$val
@ -4432,17 +4430,11 @@ fi
## This is an option because I do not know if all info/man support
## compressed files, nor how to test if they do so.
# Check whether --with-compress-info was given.
if test "${with_compress_info+set}" = set; then :
withval=$with_compress_info;
# Check whether --with-compress-install was given.
if test "${with_compress_install+set}" = set; then :
withval=$with_compress_install;
else
with_compress_info=$with_features
fi
if test $with_compress_info = yes; then
GZIP_INFO=yes
else
GZIP_INFO=
with_compress_install=$with_features
fi
@ -7659,6 +7651,13 @@ fi
# The following line should be removable at some point.
nw="$nw -Wsuggest-attribute=pure"
# This part is merely for shortening the command line,
# since -Wno-FOO needs to be added below regardless.
nw="$nw -Wmissing-field-initializers"
nw="$nw -Wswitch"
nw="$nw -Wtype-limits"
nw="$nw -Wunused-parameter"
# clang is unduly picky about some things.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the compiler is clang" >&5
$as_echo_n "checking whether the compiler is clang... " >&6; }
@ -8614,6 +8613,9 @@ fi
test $with_compress_install != yes && test -n "$GZIP_PROG" && \
GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)"
if test $opsys = gnu-linux; then
# Extract the first word of "paxctl", so it can be a program name with args.
set dummy paxctl; ac_word=$2
@ -8761,25 +8763,13 @@ INFO_OPTS=--no-split
if test $opsys = mingw32; then
DOCMISC_DVI_W32=efaq-w32.dvi
DOCMISC_HTML_W32=efaq-w32.html
DOCMISC_INFO_W32=efaq-w32.info
DOCMISC_PDF_W32=efaq-w32.pdf
DOCMISC_PS_W32=efaq-w32.ps
DOCMISC_W32=efaq-w32
else
DOCMISC_DVI_W32=
DOCMISC_HTML_W32=
DOCMISC_INFO_W32=
DOCMISC_PDF_W32=
DOCMISC_PS_W32=
DOCMISC_W32=
fi
if test x$GCC = xyes; then
test "x$GCC_LINK_TEST_OPTIONS" != x && \
ac_link="$ac_link $GCC_LINK_TEST_OPTIONS"
@ -8789,13 +8779,15 @@ else
fi
late_LDFLAGS=$LDFLAGS
late_LDFLAGS="$LDFLAGS"
if test x$GCC = xyes; then
LDFLAGS="$LDFLAGS -Wl,-znocombreloc"
LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc"
else
LDFLAGS="$LDFLAGS -znocombreloc"
LDFLAGS_NOCOMBRELOC="-znocombreloc"
fi
LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -znocombreloc" >&5
$as_echo_n "checking for -znocombreloc... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@ -8813,13 +8805,14 @@ if ac_fn_c_try_link "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
LDFLAGS=$late_LDFLAGS
LDFLAGS_NOCOMBRELOC=
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS="$late_LDFLAGS"
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
case "$opsys" in
@ -9097,7 +9090,10 @@ fi
done
if test "${with_sound}" = "ossaudio" || test "${with_sound}" = "yes"; then
test "${with_sound}" = "oss" && test "${have_sound_header}" != "yes" && \
as_fn_error "OSS sound support requested but not found." "$LINENO" 5
if test "${with_sound}" = "bsd-ossaudio" || test "${with_sound}" = "yes"; then
# Emulation library used on NetBSD.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _oss_ioctl in -lossaudio" >&5
$as_echo_n "checking for _oss_ioctl in -lossaudio... " >&6; }
@ -9141,8 +9137,8 @@ else
LIBSOUND=
fi
test "${with_sound}" = "ossaudio" && test -z "$LIBSOUND" && \
as_fn_error "ossaudio sound support requested but not found." "$LINENO" 5
test "${with_sound}" = "bsd-ossaudio" && test -z "$LIBSOUND" && \
as_fn_error "bsd-ossaudio sound support requested but not found." "$LINENO" 5
fi
@ -10352,6 +10348,137 @@ fi
## $window_system is now set to the window system we will
## ultimately use.
if test "$window_system" = none && test "$gl_gcc_warnings" = yes; then
# Too many warnings for now.
nw=
nw="$nw -Wsuggest-attribute=const"
nw="$nw -Wsuggest-attribute=noreturn"
gl_warn_set=
set x $WARN_CFLAGS; shift
for gl_warn_item
do
case " $nw " in
*" $gl_warn_item "*)
;;
*)
gl_warn_set="$gl_warn_set $gl_warn_item"
;;
esac
done
WARN_CFLAGS=$gl_warn_set
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-variable" >&5
$as_echo_n "checking whether C compiler handles -Wno-unused-variable... " >&6; }
if test "${gl_cv_warn_c__Wno_unused_variable+set}" = set; then :
$as_echo_n "(cached) " >&6
else
gl_save_compiler_FLAGS="$CFLAGS"
as_fn_append CFLAGS " $gl_unknown_warnings_are_errors -Wunused-variable"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
gl_cv_warn_c__Wno_unused_variable=yes
else
gl_cv_warn_c__Wno_unused_variable=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CFLAGS="$gl_save_compiler_FLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_variable" >&5
$as_echo "$gl_cv_warn_c__Wno_unused_variable" >&6; }
if test "x$gl_cv_warn_c__Wno_unused_variable" = x""yes; then :
as_fn_append WARN_CFLAGS " -Wno-unused-variable"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-but-set-variable" >&5
$as_echo_n "checking whether C compiler handles -Wno-unused-but-set-variable... " >&6; }
if test "${gl_cv_warn_c__Wno_unused_but_set_variable+set}" = set; then :
$as_echo_n "(cached) " >&6
else
gl_save_compiler_FLAGS="$CFLAGS"
as_fn_append CFLAGS " $gl_unknown_warnings_are_errors -Wunused-but-set-variable"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
gl_cv_warn_c__Wno_unused_but_set_variable=yes
else
gl_cv_warn_c__Wno_unused_but_set_variable=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CFLAGS="$gl_save_compiler_FLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_but_set_variable" >&5
$as_echo "$gl_cv_warn_c__Wno_unused_but_set_variable" >&6; }
if test "x$gl_cv_warn_c__Wno_unused_but_set_variable" = x""yes; then :
as_fn_append WARN_CFLAGS " -Wno-unused-but-set-variable"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler handles -Wno-unused-but-set-parameter" >&5
$as_echo_n "checking whether C compiler handles -Wno-unused-but-set-parameter... " >&6; }
if test "${gl_cv_warn_c__Wno_unused_but_set_parameter+set}" = set; then :
$as_echo_n "(cached) " >&6
else
gl_save_compiler_FLAGS="$CFLAGS"
as_fn_append CFLAGS " $gl_unknown_warnings_are_errors -Wunused-but-set-parameter"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
gl_cv_warn_c__Wno_unused_but_set_parameter=yes
else
gl_cv_warn_c__Wno_unused_but_set_parameter=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CFLAGS="$gl_save_compiler_FLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_warn_c__Wno_unused_but_set_parameter" >&5
$as_echo "$gl_cv_warn_c__Wno_unused_but_set_parameter" >&6; }
if test "x$gl_cv_warn_c__Wno_unused_but_set_parameter" = x""yes; then :
as_fn_append WARN_CFLAGS " -Wno-unused-but-set-parameter"
fi
fi
term_header=
HAVE_X_WINDOWS=no
HAVE_X11=no
@ -28925,6 +29052,8 @@ if test x$ac_enable_profiling != x ; then
esac
fi
LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS"
## MinGW-specific post-link processing of temacs.
@ -29066,10 +29195,13 @@ if test "$HAVE_NS" = "yes"; then
if test "$NS_IMPL_GNUSTEP" = yes; then
ac_config_files="$ac_config_files nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in"
ns_check_file=Resources/Info-gnustep.plist
else
ac_config_files="$ac_config_files nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in"
ns_check_file=Contents/Info.plist
fi
fi
SUBDIR_MAKEFILES="lib/Makefile lib-src/Makefile oldXMenu/Makefile doc/emacs/Makefile doc/misc/Makefile doc/lispintro/Makefile doc/lispref/Makefile src/Makefile lwlib/Makefile lisp/Makefile leim/Makefile nextstep/Makefile nt/Makefile"

91
configure.ac
View file

@ -167,12 +167,12 @@ AC_ARG_WITH([mailhost],[AS_HELP_STRING([--with-mailhost=HOSTNAME],
AC_DEFINE_UNQUOTED(MAILHOST, ["$withval"], [String giving fallback POP mail host.]))
AC_ARG_WITH([sound],[AS_HELP_STRING([--with-sound=VALUE],
[compile with sound support (VALUE one of: yes, ossaudio, alsa, no;
[compile with sound support (VALUE one of: yes, alsa, oss, bsd-ossaudio, no;
default yes). Only for GNU/Linux, FreeBSD, NetBSD, MinGW.])],
[ case "${withval}" in
yes|no|ossaudio|alsa) val=$withval ;;
yes|no|alsa|oss|bsd-ossaudio) val=$withval ;;
*) AC_MSG_ERROR([`--with-sound=$withval' is invalid;
this option's value should be `yes', `no', `ossaudio', or `alsa'.])
this option's value should be `yes', `no', `alsa', `oss', or `bsd-ossaudio'.])
;;
esac
with_sound=$val
@ -268,13 +268,9 @@ AC_SUBST(cache_file)
## This is an option because I do not know if all info/man support
## compressed files, nor how to test if they do so.
OPTION_DEFAULT_ON([compress-info],[don't compress the installed Info pages])
if test $with_compress_info = yes; then
GZIP_INFO=yes
else
GZIP_INFO=
fi
AC_SUBST(GZIP_INFO)
OPTION_DEFAULT_ON([compress-install],
[don't compress some files (.el, .info, etc.) when installing. Equivalent to:
make GZIP_PROG= install])
AC_ARG_WITH([pkg-config-prog],dnl
[AS_HELP_STRING([--with-pkg-config-prog=FILENAME],
@ -828,6 +824,13 @@ else
# The following line should be removable at some point.
nw="$nw -Wsuggest-attribute=pure"
# This part is merely for shortening the command line,
# since -Wno-FOO needs to be added below regardless.
nw="$nw -Wmissing-field-initializers"
nw="$nw -Wswitch"
nw="$nw -Wtype-limits"
nw="$nw -Wunused-parameter"
# clang is unduly picky about some things.
AC_CACHE_CHECK([whether the compiler is clang], [emacs_cv_clang],
[AC_COMPILE_IFELSE(
@ -945,6 +948,9 @@ AC_PATH_PROG(INSTALL_INFO, install-info, :,
dnl Don't use GZIP, which is used by gzip for additional parameters.
AC_PATH_PROG(GZIP_PROG, gzip)
test $with_compress_install != yes && test -n "$GZIP_PROG" && \
GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)"
if test $opsys = gnu-linux; then
AC_PATH_PROG(PAXCTL, paxctl,,
[$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin])
@ -1000,23 +1006,11 @@ AC_SUBST(INFO_EXT)
AC_SUBST(INFO_OPTS)
if test $opsys = mingw32; then
DOCMISC_DVI_W32=efaq-w32.dvi
DOCMISC_HTML_W32=efaq-w32.html
DOCMISC_INFO_W32=efaq-w32
DOCMISC_PDF_W32=efaq-w32.pdf
DOCMISC_PS_W32=efaq-w32.ps
DOCMISC_W32=efaq-w32
else
DOCMISC_DVI_W32=
DOCMISC_HTML_W32=
DOCMISC_INFO_W32=
DOCMISC_PDF_W32=
DOCMISC_PS_W32=
DOCMISC_W32=
fi
AC_SUBST(DOCMISC_DVI_W32)
AC_SUBST(DOCMISC_HTML_W32)
AC_SUBST(DOCMISC_INFO_W32)
AC_SUBST(DOCMISC_PDF_W32)
AC_SUBST(DOCMISC_PS_W32)
AC_SUBST(DOCMISC_W32)
dnl Add our options to ac_link now, after it is set up.
@ -1034,19 +1028,30 @@ dnl (Don't use `-z nocombreloc' as -z takes no arg on Irix.)
dnl Treat GCC specially since it just gives a non-fatal `unrecognized option'
dnl if not built to support GNU ld.
late_LDFLAGS=$LDFLAGS
dnl For a long time, -znocombreloc was added to LDFLAGS rather than
dnl LD_SWITCH_SYSTEM_TEMACS. That is:
dnl * inappropriate, as LDFLAGS is a user option but this is essential.
dnl Eg "make LDFLAGS=... all" could run into problems,
dnl http://bugs.debian.org/684788
dnl * unnecessary, since temacs is the only thing that actually needs it.
dnl Indeed this is where it was originally, prior to:
dnl http://lists.gnu.org/archive/html/emacs-pretest-bug/2004-03/msg00170.html
late_LDFLAGS="$LDFLAGS"
if test x$GCC = xyes; then
LDFLAGS="$LDFLAGS -Wl,-znocombreloc"
LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc"
else
LDFLAGS="$LDFLAGS -znocombreloc"
LDFLAGS_NOCOMBRELOC="-znocombreloc"
fi
LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC"
AC_MSG_CHECKING([for -znocombreloc])
AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
[AC_MSG_RESULT(yes)],
LDFLAGS=$late_LDFLAGS
LDFLAGS_NOCOMBRELOC=
[AC_MSG_RESULT(no)])
LDFLAGS="$late_LDFLAGS"
dnl The function dump-emacs will not be defined and temacs will do
dnl (load "loadup") automatically unless told otherwise.
@ -1321,12 +1326,15 @@ if test "${with_sound}" != "no"; then
#include <windows.h>
#endif
])
if test "${with_sound}" = "ossaudio" || test "${with_sound}" = "yes"; then
test "${with_sound}" = "oss" && test "${have_sound_header}" != "yes" && \
AC_MSG_ERROR([OSS sound support requested but not found.])
if test "${with_sound}" = "bsd-ossaudio" || test "${with_sound}" = "yes"; then
# Emulation library used on NetBSD.
AC_CHECK_LIB(ossaudio, _oss_ioctl, LIBSOUND=-lossaudio, LIBSOUND=)
test "${with_sound}" = "ossaudio" && test -z "$LIBSOUND" && \
AC_MSG_ERROR([ossaudio sound support requested but not found.])
dnl FIXME? If we did find ossaudio, should we set with_sound=ossaudio?
test "${with_sound}" = "bsd-ossaudio" && test -z "$LIBSOUND" && \
AC_MSG_ERROR([bsd-ossaudio sound support requested but not found.])
dnl FIXME? If we did find ossaudio, should we set with_sound=bsd-ossaudio?
dnl Traditionally, we go on to check for alsa too. Does that make sense?
fi
AC_SUBST(LIBSOUND)
@ -1786,6 +1794,18 @@ fi
## $window_system is now set to the window system we will
## ultimately use.
if test "$window_system" = none && test "$gl_gcc_warnings" = yes; then
# Too many warnings for now.
nw=
nw="$nw -Wsuggest-attribute=const"
nw="$nw -Wsuggest-attribute=noreturn"
gl_MANYWARN_COMPLEMENT([WARN_CFLAGS], [$WARN_CFLAGS], [$nw])
gl_WARN_ADD([-Wno-unused-variable])
gl_WARN_ADD([-Wno-unused-but-set-variable])
gl_WARN_ADD([-Wno-unused-but-set-parameter])
fi
term_header=
HAVE_X_WINDOWS=no
HAVE_X11=no
@ -4770,6 +4790,8 @@ if test x$ac_enable_profiling != x ; then
esac
fi
LD_SWITCH_SYSTEM_TEMACS="$LDFLAGS_NOCOMBRELOC $LD_SWITCH_SYSTEM_TEMACS"
AC_SUBST(LD_SWITCH_SYSTEM_TEMACS)
## MinGW-specific post-link processing of temacs.
@ -4949,10 +4971,13 @@ if test "$HAVE_NS" = "yes"; then
if test "$NS_IMPL_GNUSTEP" = yes; then
AC_CONFIG_FILES([nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist:nextstep/templates/Info-gnustep.plist.in \
nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop:nextstep/templates/Emacs.desktop.in])
ns_check_file=Resources/Info-gnustep.plist
else
AC_CONFIG_FILES([nextstep/Cocoa/Emacs.base/Contents/Info.plist:nextstep/templates/Info.plist.in \
nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings:nextstep/templates/InfoPlist.strings.in])
ns_check_file=Contents/Info.plist
fi
AC_SUBST(ns_check_file)
fi
dnl Obviously there is duplication here wrt $SUBDIR_MAKEFILES.

15
doc/emacs/ChangeLog
View file

@ -1,3 +1,18 @@
2013-09-04 Xue Fuqiao <xfq.free@gmail.com>
* maintaining.texi (VC Ignore): Mention `vc-ignore' with prefix argument.
2013-08-31 Ulrich Müller <ulm@gentoo.org>
* xresources.texi (Motif Resources):
Rename from LessTif Resources. Update xrefs. (Bug#15145)
* emacs.texi: Update menu.
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-17 Xue Fuqiao <xfq.free@gmail.com>
* text.texi (Enriched Justification): Minor fixes.

2
doc/emacs/Makefile.in
View file

@ -17,7 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
# NB If you add any more configure variables,
# update the sed rules in the dist target below.

2
doc/emacs/emacs.texi
View file

@ -1189,7 +1189,7 @@ X Options and Resources
* Resources:: Using X resources with Emacs (in general).
* Table of Resources:: Table of specific X resources that affect Emacs.
* Lucid Resources:: X resources for Lucid menus.
* LessTif Resources:: X resources for LessTif and Motif menus.
* Motif Resources:: X resources for Motif and LessTif menus.
* GTK resources:: Resources for GTK widgets.
GTK resources

14
doc/emacs/maintaining.texi
View file

@ -1043,12 +1043,14 @@ Ignore a file under current version control system. (@code{vc-ignore}).
@kindex C-x v G
@findex vc-ignore
Many source trees contain some files that do not need to be versioned,
such as editor backups, object or bytecode files, and built programs.
You can simply not add them, but then they’ll always crop up as
unknown files. You can also tell the version control system to ignore
these files by adding them to the ignore file at the top of the tree.
@kbd{C-x v G} (@code{vc-ignore}) can help you do this.
Many source trees contain some files that do not need to be
versioned, such as editor backups, object or bytecode files, and built
programs. You can simply not add them, but then they’ll always crop
up as unknown files. You can also tell the version control system to
ignore these files by adding them to the ignore file at the top of the
tree. @kbd{C-x v G} (@code{vc-ignore}) can help you do this. When
called with a prefix argument, you can remove a file from the ignored
file list.
@node VC Directory Mode
@subsection VC Directory Mode

20
doc/emacs/xresources.texi
View file

@ -27,7 +27,7 @@ system registry (@pxref{MS-Windows Registry}).
* Resources:: Using X resources with Emacs (in general).
* Table of Resources:: Table of specific X resources that affect Emacs.
* Lucid Resources:: X resources for Lucid menus.
* LessTif Resources:: X resources for LessTif and Motif menus.
* Motif Resources:: X resources for Motif and LessTif menus.
* GTK resources:: Resources for GTK widgets.
@end menu
@ -260,7 +260,7 @@ compiled with GTK+ support.
@ifnottex
@item @code{selectionFont} (class @code{SelectionFont})
Font name for pop-up menu items, in non-toolkit versions of Emacs. (For
toolkit versions, see @ref{Lucid Resources}, also see @ref{LessTif
toolkit versions, see @ref{Lucid Resources}, also see @ref{Motif
Resources}.)
@item @code{selectionTimeout} (class @code{SelectionTimeout})
@ -370,15 +370,15 @@ elements. Default is 1.
Margin of the menu bar, in characters. Default is 1.
@end table
@node LessTif Resources
@appendixsec LessTif Menu X Resources
@cindex Menu X Resources (LessTif widgets)
@cindex LessTif Widget X Resources
@node Motif Resources
@appendixsec Motif Menu X Resources
@cindex Menu X Resources (Motif widgets)
@cindex Motif Widget X Resources
If Emacs is compiled with the X toolkit support using LessTif or
Motif widgets, you can use X resources to customize the appearance of
the menu bar, pop-up menus, and dialog boxes. However, the resources
are organized differently from Lucid widgets.
If Emacs is compiled with the X toolkit support using Motif or
LessTif widgets, you can use X resources to customize the appearance
of the menu bar, pop-up menus, and dialog boxes. However, the
resources are organized differently from Lucid widgets.
The resource names for the menu bar are in the @samp{pane.menubar}
class, and they must be specified in this form:

15
doc/lispintro/ChangeLog
View file

@ -1,3 +1,18 @@
2013-09-01 Glenn Morris <rgm@gnu.org>
* emacs-lisp-intro.texi (beginning-of-buffer complete):
Put back a version of the removed paragraph about raw prefix arg.
2013-09-01 Dani Moncayo <dmoncayo@gmail.com>
* emacs-lisp-intro.texi (beginning-of-buffer complete):
Update function details. (Bug#15085)
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-12 Glenn Morris <rgm@gnu.org>
* emacs-lisp-intro.texi (Complete copy-region-as-kill): Fix typo.

2
doc/lispintro/Makefile.in
View file

@ -17,7 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
# NB If you add any more configure variables,
# update the sed rules in the dist target below.

16
doc/lispintro/emacs-lisp-intro.texi
View file

@ -6323,7 +6323,7 @@ and avoids clobbering the mark."
(/ (+ 10 (* size (prefix-numeric-value arg)))
10)))
(point-min))))
(if arg (forward-line 1)))
(if (and arg (not (consp arg))) (forward-line 1)))
@end group
@end smallexample
@ -6390,7 +6390,7 @@ to move point to the beginning of the next line if the command is
invoked with an argument:
@smallexample
(if arg (forward-line 1)))
(if (and arg (not (consp arg))) (forward-line 1))
@end smallexample
@noindent
@ -6399,14 +6399,10 @@ appropriate tenths position in the buffer. This is a flourish that
means that the cursor is always located @emph{at least} the requested
tenths of the way through the buffer, which is a nicety that is,
perhaps, not necessary, but which, if it did not occur, would be sure
to draw complaints.
On the other hand, it also means that if you specify the command with
a @kbd{C-u}, but without a number, that is to say, if the `raw prefix
argument' is simply a cons cell, then the command puts you at the
beginning of the second line @dots{} I don't know whether this is
intended or whether no one has dealt with the code to avoid this
happening.
to draw complaints. (The @code{(not (consp arg))} portion is so that
if you specify the command with a @kbd{C-u}, but without a number,
that is to say, if the `raw prefix argument' is simply a cons cell,
the command does not put you at the beginning of the second line.)
@node Second Buffer Related Review
@section Review

10
doc/lispref/ChangeLog
View file

@ -1,3 +1,13 @@
2013-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
* macros.texi (Defining Macros): Prefer "function" to "lambda
expression" (bug#15296).
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-26 Stefan Monnier <monnier@iro.umontreal.ca>
* variables.texi (File Local Variables): Don't recommend quoting! Ever!

2
doc/lispref/Makefile.in
View file

@ -17,7 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
# NB If you add any more configure variables,
# update the sed rules in the dist target below.

4
doc/lispref/macros.texi
View file

@ -191,8 +191,8 @@ During Compile}).
@section Defining Macros
A Lisp macro object is a list whose @sc{car} is @code{macro}, and
whose @sc{cdr} is a lambda expression. Expansion of the macro works
by applying the lambda expression (with @code{apply}) to the list of
whose @sc{cdr} is a function. Expansion of the macro works
by applying the function (with @code{apply}) to the list of
@emph{unevaluated} arguments from the macro call.
It is possible to use an anonymous Lisp macro just like an anonymous

4
doc/man/ChangeLog
View file

@ -1,3 +1,7 @@
2013-08-31 Ulrich Müller <ulm@gentoo.org>
* emacs.1: Update manual links.
2013-04-20 Petr Hracek <phracek@redhat.com> (tiny change)
* emacs.1: Add some more command-line options. (Bug#14165)

4
doc/man/emacs.1
View file

@ -445,7 +445,7 @@ Gives frames menu bars if
.IR on ;
don't have menu bars if
.IR off .
See the Emacs manual, sections "Lucid Resources" and "LessTif
See the Emacs manual, sections "Lucid Resources" and "Motif
Resources", for how to control the appearance of the menu bar
if you have one.
.TP
@ -492,7 +492,7 @@ The scroll bar width in pixels, equivalent to the frame parameter
Font name for pop-up menu items, in non-toolkit versions of
.IR Emacs .
(For toolkit versions, see the Emacs manual, sections
"Lucid Resources" and "LessTif Resources".)
"Lucid Resources" and "Motif Resources".)
.TP
.BR selectionTimeout " (class " SelectionTimeout )
Number of milliseconds to wait for a selection reply.

22
doc/misc/ChangeLog
View file

@ -1,5 +1,27 @@
2013-09-08 Glenn Morris <rgm@gnu.org>
* emacs-gnutls.texi: Tweak direntry.
2013-09-06 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Alternative Syntax): Remove chapter.
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
Try to reduce redundancy in doc/misc/Makefile.in.
* Makefile.in (DOCMISC_W32): New var to replace DOCMISC_*_W32.
(TARGETS): New intermediate variable.
(DVI_TARGETS, HTML_TARGETS, PDF_TARGETS, PS_TARGETS): Use it.
2013-08-27 Glenn Morris <rgm@gnu.org>
* efaq.texi (Emacs for MS-Windows): Update location of MS FAQ.
* efaq.texi: Rename from faq.texi, to match its output files.
* Makefile.in: Update for faq.texi name change.

246
doc/misc/Makefile.in
View file

@ -17,7 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
# Where to find the source code. $(srcdir) will be the man-aux
# subdirectory of the source tree. This is
@ -60,11 +60,7 @@ MAKEINFO = @MAKEINFO@
MAKEINFO_OPTS = --force -I$(emacsdir)
## On MS Windows, efaq-w32; otherwise blank.
DOCMISC_DVI_W32 = @DOCMISC_DVI_W32@
DOCMISC_HTML_W32 = @DOCMISC_HTML_W32@
DOCMISC_INFO_W32 = @DOCMISC_INFO_W32@
DOCMISC_PDF_W32 = @DOCMISC_PDF_W32@
DOCMISC_PS_W32 = @DOCMISC_PS_W32@
DOCMISC_W32 = @DOCMISC_W32@
## Info files to build and install on all platforms.
INFO_COMMON = ada-mode auth autotype bovine calc ccmode cl \
@ -84,237 +80,15 @@ INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_INFO_W32)
## because the info files are pre-built in release tarfiles.
INFO_TARGETS = $(INFO_COMMON) efaq-w32
DVI_TARGETS = $(DOCMISC_DVI_W32) \
ada-mode.dvi \
auth.dvi \
autotype.dvi \
bovine.dvi \
calc.dvi \
cc-mode.dvi \
cl.dvi \
dbus.dvi \
dired-x.dvi \
ebrowse.dvi \
ede.dvi \
ediff.dvi \
edt.dvi \
efaq.dvi \
eieio.dvi \
emacs-mime.dvi \
epa.dvi \
erc.dvi \
ert.dvi \
eshell.dvi \
eudc.dvi \
flymake.dvi \
forms.dvi \
gnus.dvi \
emacs-gnutls.dvi \
htmlfontify.dvi \
idlwave.dvi \
ido.dvi \
info.dvi \
mairix-el.dvi \
message.dvi \
mh-e.dvi \
newsticker.dvi \
nxml-mode.dvi \
org.dvi \
pcl-cvs.dvi \
pgg.dvi \
rcirc.dvi \
reftex.dvi \
remember.dvi \
sasl.dvi \
sc.dvi \
semantic.dvi \
ses.dvi \
sieve.dvi \
smtpmail.dvi \
speedbar.dvi \
srecode.dvi \
todo-mode.dvi \
tramp.dvi \
url.dvi \
vip.dvi \
viper.dvi \
widget.dvi \
wisent.dvi \
woman.dvi
# There are some naming differences between the info targets and the other
# targets, so let's resolve them here.
TARGETS_1 = $(INFO_INSTALL:ccmode=cc-mode)
TARGETS = $(TARGETS_1:info.info=info)
HTML_TARGETS = $(DOCMISC_HTML_W32) \
ada-mode.html \
auth.html \
autotype.html \
bovine.html \
calc.html \
cc-mode.html \
cl.html \
dbus.html \
dired-x.html \
ebrowse.html \
ede.html \
ediff.html \
edt.html \
efaq.html \
eieio.html \
emacs-mime.html \
epa.html \
erc.html \
ert.html \
eshell.html \
eudc.html \
flymake.html \
forms.html \
gnus.html \
emacs-gnutls.html \
htmlfontify.html \
idlwave.html \
ido.html \
info.html \
mairix-el.html \
message.html \
mh-e.html \
newsticker.html \
nxml-mode.html \
org.html \
pcl-cvs.html \
pgg.html \
rcirc.html \
reftex.html \
remember.html \
sasl.html \
sc.html \
semantic.html \
ses.html \
sieve.html \
smtpmail.html \
speedbar.html \
srecode.html \
todo-mode.html \
tramp.html \
url.html \
vip.html \
viper.html \
widget.html \
wisent.html \
woman.html
PDF_TARGETS = $(DOCMISC_PDF_W32) \
ada-mode.pdf \
auth.pdf \
autotype.pdf \
bovine.pdf \
calc.pdf \
cc-mode.pdf \
cl.pdf \
dbus.pdf \
dired-x.pdf \
ebrowse.pdf \
ede.pdf \
ediff.pdf \
edt.pdf \
efaq.pdf \
eieio.pdf \
emacs-mime.pdf \
epa.pdf \
erc.pdf \
ert.pdf \
eshell.pdf \
eudc.pdf \
flymake.pdf \
forms.pdf \
gnus.pdf \
htmlfontify.pdf \
emacs-gnutls.pdf \
idlwave.pdf \
ido.pdf \
info.pdf \
mairix-el.pdf \
message.pdf \
mh-e.pdf \
newsticker.pdf \
nxml-mode.pdf \
org.pdf \
pcl-cvs.pdf \
pgg.pdf \
rcirc.pdf \
reftex.pdf \
remember.pdf \
sasl.pdf \
sc.pdf \
semantic.pdf \
ses.pdf \
sieve.pdf \
smtpmail.pdf \
speedbar.pdf \
srecode.pdf \
todo-mode.pdf \
tramp.pdf \
url.pdf \
vip.pdf \
viper.pdf \
widget.pdf \
wisent.pdf \
woman.pdf
PS_TARGETS = $(DOCMISC_PS_W32) \
ada-mode.ps \
auth.ps \
autotype.ps \
bovine.ps \
calc.ps \
cc-mode.ps \
cl.ps \
dbus.ps \
dired-x.ps \
ebrowse.ps \
ede.ps \
ediff.ps \
edt.ps \
efaq.ps \
eieio.ps \
emacs-mime.ps \
epa.ps \
erc.ps \
ert.ps \
eshell.ps \
eudc.ps \
flymake.ps \
forms.ps \
gnus.ps \
htmlfontify.ps \
emacs-gnutls.ps \
idlwave.ps \
ido.ps \
info.ps \
mairix-el.ps \
message.ps \
mh-e.ps \
newsticker.ps \
nxml-mode.ps \
org.ps \
pcl-cvs.ps \
pgg.ps \
rcirc.ps \
reftex.ps \
remember.ps \
sasl.ps \
sc.ps \
semantic.ps \
ses.ps \
sieve.ps \
smtpmail.ps \
speedbar.ps \
srecode.ps \
todo-mode.ps \
tramp.ps \
url.ps \
vip.ps \
viper.ps \
widget.ps \
wisent.ps \
woman.ps
DVI_TARGETS = $(TARGETS:=.dvi)
HTML_TARGETS = $(TARGETS:=.html)
PDF_TARGETS = $(TARGETS:=.pdf)
PS_TARGETS = $(TARGETS:=.ps)
TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf

5
doc/misc/efaq.texi
View file

@ -3452,8 +3452,9 @@ lack certain features, such as the Emacs Lisp extension language.
@cindex Emacs for MS-Windows
@cindex Microsoft Windows, Emacs for
There is a @uref{http://www.gnu.org/software/emacs/windows/ntemacs.html,
separate FAQ} for Emacs on MS-Windows. For MS-DOS, @pxref{Emacs for MS-DOS}.
There is a separate FAQ for Emacs on MS-Windows,
@pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}.
For MS-DOS, @pxref{Emacs for MS-DOS}.
@node Emacs for GNUstep

2
doc/misc/emacs-gnutls.texi
View file

@ -25,7 +25,7 @@ modify this GNU manual.''
@dircategory Emacs network features
@direntry
* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
* Emacs GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
@end direntry
@titlepage

42
doc/misc/tramp.texi
View file

@ -225,7 +225,6 @@ Configuring @value{tramp} for use
Using @value{tramp}
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
@ -2356,7 +2355,6 @@ minute you have already forgotten that you hit that key!
@menu
* Filename Syntax:: @value{tramp} filename conventions.
* Alternative Syntax:: URL-like filename syntax.
* Filename completion:: Filename completion.
* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
* Remote processes:: Integration with other @value{emacsname} packages.
@ -2453,46 +2451,6 @@ by adding @file{#<port>} to the host name, like in @file{@trampfn{ssh,
daniel, melancholia#42, .emacs}}.
@node Alternative Syntax
@section URL-like filename syntax
@cindex filename syntax
@cindex filename examples
Additionally to the syntax described in the previous chapter, it is
possible to use a URL-like syntax for @value{tramp}. This can be
switched on by customizing the variable @code{tramp-syntax}. Please
note that this feature is experimental for the time being.
The variable @code{tramp-syntax} must be set before requiring @value{tramp}:
@lisp
(setq tramp-syntax 'url)
(require 'tramp)
@end lisp
Then, a @value{tramp} filename would look like this:
@file{/@var{method}://@var{user}@@@var{machine}:@var{port}/@var{path/to.file}}.
@file{/@var{method}://} is mandatory, all other parts are optional.
@file{:@var{port}} is useful for methods only who support this.
The last example from the previous section would look like this:
@file{/ssh://daniel@@melancholia/.emacs}.
For the time being, @code{tramp-syntax} can have the following values:
@itemize @w{}
@ifset emacs
@item @code{ftp}---That is the default syntax
@item @code{url}---URL-like syntax
@end ifset
@ifset xemacs
@item @code{sep}---That is the default syntax
@item @code{url}---URL-like syntax
@item @code{ftp}---EFS-like syntax
@end ifset
@end itemize
@node Filename completion
@section Filename completion
@cindex filename completion

6
etc/ChangeLog
View file

@ -1,3 +1,9 @@
2013-09-09 Glenn Morris <rgm@gnu.org>
* refcards/Makefile (PS_ENGLISH, PS_CZECH, PS_FRENCH, PS_GERMAN)
(PS_POLISH, PS_PORTUGUESE, PS_RUSSIAN, PS_SLOVAKIAN, PS_TARGETS):
Use substitution refs.
2013-08-15 Glenn Morris <rgm@gnu.org>
* refcards/calccard.pdf, refcards/cs-dired-ref.pdf:

41
etc/NEWS
View file

@ -34,6 +34,10 @@ build time. To prevent this, use the configure option
`--with-file-notification-no'. See below for file-notify features.
FIXME? This feature is not available for the Nextstep port. (?)
** The configure option `without-compress-info' has been generalized,
and renamed to `without-compress-install'. It now prevents compression
of _any_ files during installation.
** The configure option --with-crt-dir has been removed.
It is no longer needed, as the crt*.o files are no longer linked
specially.
@ -262,8 +266,9 @@ whole tree revisions.
*** In VC directory mode, `L' lists the change log for the current VC
controlled tree in a window.
*** `C-x v G' (globally) and `G' (in VC directory mode) ignores a
file under current version control system.
*** `C-x v G' (globally) and `G' (in VC directory mode) ignores a file
under current version control system. When called with a prefix
argument, you can remove a file from the ignored file list.
** cl-lib
@ -331,6 +336,10 @@ This is useful to avoid a query when you have no key for that name.
*** key bindings to navigate through and select the completions.
*** The icomplete-separator is customizable, and its default has changed.
*** Removed icomplete-show-key-bindings.
*** Icomplete-mode by defaults applies to all forms of minibuffer completion.
(setq icomplete-with-completion-tables '(internal-complete-buffer))
will revert to the old behavior.
** Ido
*** Ido has a manual now.
@ -460,6 +469,8 @@ todo-mode.el has been made obsolete and renamed otodo-mode.el.
** Tramp
*** The experimental url syntax for remote file names is withdrawn.
+++
*** New connection method "adb", which allows to access Android
devices by the Android Debug Bridge. The variable `tramp-adb-program'
@ -603,9 +614,20 @@ file using `set-file-extended-attributes'.
** `visited-file-modtime' now returns -1 for nonexistent files.
Formerly it returned a list (-1 LOW USEC PSEC), but this was ambiguous
in the presence of files with negative time stamps.
** The cars of the elements in `interpreter-mode-alist' are now treated
as regexps rather than literal strings. For the time being, any
element whose car does not start with "\\" is still treated as a
literal string, so this change should not cause any incompatibilities
if you have code that just adds elements to the list, only if you are
actually using interpreter-mode-alist for something.
* Lisp Changes in Emacs 24.4
** The second argument of `eval' can now be a lexical-environment.
** `with-demoted-errors' takes an additional argument `format'.
+++
** New function `define-error'.
@ -753,6 +775,11 @@ used in place of the 9th element of `file-attributes'.
`preserve-extended-attributes' as it now handles both SELinux context
and ACL entries.
** The `common-substring' argument of display-completion-list is obsolete.
Either use `completion-all-completions' which already returns highlighted
strings (including for partial or substring completion) or call
`completion-hilit-commonality' to add the highlight.
** Changes to the Emacs Lisp Coding Conventions in Emacs 24.4
*** The package descriptor and name of global variables, constants,
@ -762,12 +789,10 @@ meant to be used by other packages.
* Changes in Emacs 24.4 on Non-Free Operating Systems
** Emacs for MS-Windows can now be built by running the configure script
using the MSYS environment and MinGW development tools.
This is from now on the preferred method of building Emacs on
MS-Windows. The Windows-specific configure.bat and makefile.w32-in
files are deprecated. See the file nt/INSTALL.MSYS for detailed
instructions.
** The procedure for building Emacs on MS-Windows has changed.
It is now built by running the same configure script as on all other
platforms. This requires the MSYS environment and MinGW development
tools. See the updated instructions in nt/INSTALL for details.
Using the Posix configure script and Makefile's also means a change in
the directory structure of the Emacs installation on Windows. It is

6
etc/PROBLEMS
View file

@ -3016,9 +3016,9 @@ You can enter M-f6 by typing ESC f6.
*** MS-Windows 95/98/ME: subprocesses do not terminate properly.
This is a limitation of the Operating System, and can cause problems
when shutting down Windows. Ensure that all subprocesses are exited
cleanly before exiting Emacs. For more details, see the FAQ at
http://www.gnu.org/software/emacs/windows/.
when shutting down Windows. Ensure that all subprocesses are exited
cleanly before exiting Emacs. For more details, see the Emacs on MS
Windows FAQ (info manual "efaq-w32").
*** MS-Windows 95/98/ME: crashes when Emacs invokes non-existent programs.

44
etc/refcards/Makefile
View file

@ -58,42 +58,16 @@ PDF_SLOVAKIAN = \
PDF_TARGETS = $(PDF_ENGLISH) $(PDF_CZECH) $(PDF_FRENCH) $(PDF_GERMAN) \
$(PDF_POLISH) $(PDF_PORTUGUESE) $(PDF_RUSSIAN) $(PDF_SLOVAKIAN)
PS_ENGLISH = \
calccard.ps \
dired-ref.ps \
gnus-booklet.ps \
gnus-refcard.ps \
orgcard.ps \
refcard.ps \
survival.ps \
vipcard.ps \
viperCard.ps
PS_ENGLISH = $(PDF_ENGLISH:.pdf=.ps)
PS_CZECH = $(PDF_CZECH:.pdf=.ps)
PS_FRENCH = $(PDF_FRENCH:.pdf=.ps)
PS_GERMAN = $(PDF_GERMAN:.pdf=.ps)
PS_POLISH = $(PDF_POLISH:.pdf=.ps)
PS_PORTUGUESE = $(PDF_PORTUGUESE:.pdf=.ps)
PS_RUSSIAN = $(PDF_RUSSIAN:.pdf=.ps)
PS_SLOVAKIAN = $(PDF_SLOVAKIAN:.pdf=.ps)
PS_CZECH = \
cs-dired-ref.ps \
cs-refcard.ps \
cs-survival.ps
PS_FRENCH = \
fr-dired-ref.ps \
fr-refcard.ps \
fr-survival.ps \
PS_GERMAN = de-refcard.ps
PS_POLISH = pl-refcard.ps
PS_PORTUGUESE = pt-br-refcard.ps
PS_RUSSIAN = ru-refcard.ps
PS_SLOVAKIAN = \
sk-dired-ref.ps \
sk-refcard.ps \
sk-survival.ps
PS_TARGETS = $(PS_ENGLISH) $(PS_CZECH) $(PS_FRENCH) $(PS_GERMAN) \
$(PS_POLISH) $(PS_PORTUGUESE) $(PS_RUSSIAN) $(PS_SLOVAKIAN)
PS_TARGETS = $(PDF_TARGETS:.pdf=.ps)
## For emacsver.tex.

BIN
etc/spook.lines
View file

Binary file not shown.

2
info/dir
View file

@ -41,7 +41,7 @@ Emacs editing modes
Emacs network features
* EUDC: (eudc). Emacs client for directory servers (LDAP, PH).
* Gnus: (gnus). The newsreader Gnus.
* GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
* Emacs GnuTLS: (emacs-gnutls). The Emacs GnuTLS integration.
* Mairix: (mairix-el). Emacs interface to the Mairix mail indexer.
* MH-E: (mh-e). Emacs interface to the MH mail system.
* Message: (message). Mail and news composition mode that

11
leim/ChangeLog
View file

@ -1,3 +1,14 @@
2013-09-05 Jean Haidouk <haidouk@yandex.com> (tiny change)
* quail/latin-alt.el ("french-alt-postfix", "latin-alt-postfix"):
* quail/latin-pre.el ("french-prefix"):
* quail/latin-post.el ("french-postfix"): Add `œ' and `Œ'.
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-06-21 Juanma Barranquero <lekktu@gmail.com>
* quail/croatian.el ("croatian-prefix"):

5
leim/Makefile.in
View file

@ -21,10 +21,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
# Avoid trouble on systems where the `SHELL' variable might be
# inherited from the environment.
SHELL = /bin/sh
SHELL = @SHELL@
# Here are the things that we expect ../configure to edit.
srcdir=@srcdir@

8
leim/quail/latin-alt.el
View file

@ -938,7 +938,7 @@ Par exemple: a` -> à e' -> é.
En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
Par exemple: e'' -> e'
<e dans l'o> n'est pas disponible."
Πest produit par O/."
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
@ -959,7 +959,9 @@ Par exemple: e'' -> e'
("i^" ?î)
("i\"" ?ï)
("O^" ?Ô)
("O/" ?Œ)
("o^" ?ô)
("o/" ?œ)
("U`" ?Ù)
("U^" ?Û)
("U\"" ?Ü)
@ -988,7 +990,9 @@ Par exemple: e'' -> e'
("i^^" ["i^"])
("i\"\"" ["i\""])
("O^^" ["O^"])
("O//" ["O/"])
("o^^" ["o^"])
("o//" ["o/"])
("U``" ["U`"])
("U^^" ["U^"])
("U\"\"" ["U\""])
@ -1423,6 +1427,7 @@ Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
("O'" ?Ó)
("O-" ?Ō)
("O/" ?Ø)
("O/" ?Œ)
("O:" ?Ő)
("O\"" ?Ö)
("O^" ?Ô)
@ -1515,6 +1520,7 @@ Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
("o'" ?ó)
("o-" ?ō)
("o/" ?ø)
("o/" ?œ)
("o:" ?ő)
("o\"" ?ö)
("o^" ?ô)

8
leim/quail/latin-post.el
View file

@ -1013,7 +1013,7 @@ Par exemple: a` -> à e' -> é.
En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
Par exemple: e'' -> e'
<e dans l'o> n'est pas disponible."
Πest produit par O/."
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
@ -1034,7 +1034,9 @@ Par exemple: e'' -> e'
("i^" ?î)
("i\"" ?ï)
("O^" ?Ô)
("O/" ?Œ)
("o^" ?ô)
("o/" ?œ)
("U`" ?Ù)
("U^" ?Û)
("U\"" ?Ü)
@ -1063,7 +1065,9 @@ Par exemple: e'' -> e'
("i^^" ["i^"])
("i\"\"" ["i\""])
("O^^" ["O^"])
("O//" ["O/"])
("o^^" ["o^"])
("o//" ["o/"])
("U``" ["U`"])
("U^^" ["U^"])
("U\"\"" ["U\""])
@ -2099,7 +2103,7 @@ of characters from a single Latin-N charset.
dot | . | z. -> ż
stroke | / | d/ -> đ
nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> °
others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> ° o/ -> œ
| various | << -> « >> -> » o_ -> º a_ -> ª
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'

4
leim/quail/latin-pre.el
View file

@ -264,6 +264,7 @@ Key translation rules are:
diaeresis | \" | \"i -> ï
cedilla | ~ or , | ~c -> ç ,c -> ç
symbol | ~ | ~> -> » ~< -> «
misc | / | /o -> œ
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
@ -295,6 +296,9 @@ Key translation rules are:
("\"e" ?ë)
("\"i" ?ï)
("\" " ?\")
("/o" ?œ)
("/O" ?Œ)
("/ " ?/)
("~<" ?\«)
("~>" ?\»)
("~C" ?Ç)

5
lib-src/ChangeLog
View file

@ -1,3 +1,8 @@
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-10 Eli Zaretskii <eliz@gnu.org>
* update-game-score.exe.manifest: New file.

5
lib-src/Makefile.in
View file

@ -18,10 +18,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
# Avoid trouble on systems where the `SHELL' variable might be
# inherited from the environment.
SHELL = /bin/sh
SHELL = @SHELL@
# Following ../lisp/Makefile.in.
EMACS = ../src/emacs

542
lisp/ChangeLog
View file

@ -1,3 +1,537 @@
2013-09-10 Glenn Morris <rgm@gnu.org>
* files.el (interpreter-mode-alist): Convert to regexps.
(set-auto-mode): Adapt for this. (Bug#15306)
* progmodes/cperl-mode.el (cperl-clobber-mode-lists):
Comment out unused variable.
* progmodes/cc-mode.el (interpreter-mode-alist):
* progmodes/python.el (interpreter-mode-alist):
* progmodes/ruby-mode.el (interpreter-mode-alist): Convert to regexps.
* progmodes/sh-script.el (sh-set-shell):
No longer use interpreter-mode-alist to get list of shells.
* progmodes/cc-mode.el (awk-mode): Remove duplicate autoload.
2013-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el: Use set-temporary-overlay-map for universal-argument.
(universal-argument-map): Don't use default-bindings.
Bind switch-frame explicitly. Replace universal-argument-minus with
a conditional binding.
(universal-argument-num-events, saved-overriding-map): Remove.
(restore-overriding-map): Remove.
(universal-argument--mode): Rename from save&set-overriding-map,
and rewrite.
(universal-argument, universal-argument-more, negative-argument)
(digit-argument): Adjust accordingly.
(universal-argument-minus): Remove.
(universal-argument-other-key): Remove.
* subr.el (with-demoted-errors): Add `format' argument.
2013-09-10 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-cleanup): Remove. Functionality added to
`tramp-cleanup-connection'.
* net/tramp-cmds.el (tramp-cleanup-connection): Add optional
parameters KEEP-DEBUG and KEEP-PASSWORD.
* net/tramp.el (tramp-file-name-handler):
* net/tramp-adb.el (tramp-adb-maybe-open-connection):
* net/tramp-sh.el (tramp-open-connection-setup-interactive-shell)
(tramp-maybe-open-connection):
* net/tramp-smb.el (tramp-smb-maybe-open-connection):
Use `tramp-cleanup-connection'.
* net/tramp-sh.el (tramp-maybe-open-connection):
Catch 'uname-changed inside the progress reporter.
2013-09-10 Glenn Morris <rgm@gnu.org>
* simple.el (read-minibuffer): Unbreak it. (Bug#15318)
* dired-x.el (dired-mark-sexp): Unbreak for systems where ls
returns "alternate access method" in mode (eg "-rw-r--r--.").
2013-09-08 Glenn Morris <rgm@gnu.org>
* saveplace.el (load-save-place-alist-from-file):
Demote errors. (Bug#15305)
2013-09-08 Michael Albinus <michael.albinus@gmx.de>
Improve compatibility with older Emacsen, and XEmacs.
* net/tramp.el (tramp-find-method, tramp-find-user): Call `propertize'
only if it is bound. It isn't for XEmacs.
(with-tramp-progress-reporter): Do not let-bind `result'.
This yields to scoping errors in XEmacs.
(tramp-handle-make-auto-save-file-name): New function, moved from
tramp-sh.el.
* net/tramp-adb.el (tramp-adb-file-name-handler-alist): Add handler
for `make-auto-save-file-name'.
(tramp-adb--gnu-switches-to-ash):
Use `tramp-compat-replace-regexp-in-string'.
* net/tramp-cache.el (tramp-cache-print): Call
`substring-no-properties' only if it is bound. It isn't for XEmacs.
* net/tramp-cmds.el (tramp-bug): Call `propertize' only if it is
bound. It isn't for XEmacs.
* net/tramp-compat.el (tramp-compat-copy-file):
Catch `wrong-number-of-arguments' error.
(tramp-compat-replace-regexp-in-string): New defun.
* net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add handler
for `make-auto-save-file-name'.
(tramp-gvfs-handle-copy-file): Use `tramp-compat-funcall' for
`copy-file'.
(tramp-gvfs-file-gvfs-monitor-file-process-filter)
(tramp-gvfs-file-name): Use `tramp-compat-replace-regexp-in-string'.
(tramp-synce-list-devices): Use `push' instead of `pushnew'.
* net/tramp-gw.el (tramp-gw-open-network-stream):
Use `tramp-compat-replace-regexp-in-string'.
* net/tramp-sh.el (tramp-sh-file-name-handler-alist):
Call `tramp-handle-make-auto-save-file-name'.
(tramp-sh-handle-make-auto-save-file-name): Move to tramp.el.
(tramp-sh-file-gvfs-monitor-dir-process-filter)
(tramp-sh-file-inotifywait-process-filter):
Use `tramp-compat-replace-regexp-in-string'.
(tramp-compute-multi-hops): Use `push' instead of `pushnew'.
* net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add handler
for `make-auto-save-file-name'.
(tramp-smb-handle-copy-directory):
Call `tramp-compat-replace-regexp-in-string'.
(tramp-smb-get-file-entries): Use `push' instead of `pushnew'.
(tramp-smb-handle-copy-file): Improve error message.
(tramp-smb-handle-rename-file): Rename directly only in case
`newname' does not exist yet. This is a restriction of smbclient.
(tramp-smb-maybe-open-connection): Rerun the function only when
`auth-sources' is non-nil.
2013-09-08 Kenichi Handa <handa@gnu.org>
* international/characters.el: Set category "^" (Combining) for
more characters.
2013-09-07 Alan Mackenzie <acm@muc.de>
Correctly fontify Java class constructors.
* progmodes/cc-langs.el (c-type-decl-suffix-key): Now matches ")"
in Java Mode.
(c-recognize-typeless-decls): Set the Java value to t.
* progmodes/cc-engine.el (c-forward-decl-or-cast-1):
While handling a "(", add a check for, effectively, Java, and handle a
"typeless" declaration there.
2013-09-07 Roland Winkler <winkler@gnu.org>
* textmodes/bibtex.el (bibtex-biblatex-entry-alist): Add optional
field subtitle for entry type book.
2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el: Make minibuffer-complete call completion-in-region
rather than other way around.
(completion--some, completion-pcm--find-all-completions):
Don't delay signals when debugging.
(minibuffer-completion-contents): Beware fields within the
minibuffer contents.
(completion-all-sorted-completions): Use defvar-local.
(completion--do-completion, completion--cache-all-sorted-completions)
(completion-all-sorted-completions, minibuffer-force-complete):
Add args `beg' and `end'.
(completion--in-region-1): New fun, extracted from minibuffer-complete.
(minibuffer-complete): Use completion-in-region.
(completion-complete-and-exit): New fun, extracted from
minibuffer-complete-and-exit.
(minibuffer-complete-and-exit): Use it.
(completion--complete-and-exit): Rename from
minibuffer--complete-and-exit.
(completion-in-region--single-word): New function, extracted from
minibuffer-complete-word.
(minibuffer-complete-word): Use it.
(display-completion-list): Make `common-substring' argument obsolete.
(completion--in-region): Call completion--in-region-1 instead of
minibuffer-complete.
(completion-help-at-point): Pass boundaries to
minibuffer-completion-help as args rather than via an overlay.
(completion-pcm--string->pattern): Use `any-delim'.
(completion-pcm--optimize-pattern): New function.
(completion-pcm--pattern->regex): Handle `any-delim'.
* icomplete.el (icomplete-forward-completions)
(icomplete-backward-completions, icomplete-completions):
Adjust calls to completion-all-sorted-completions and
completion--cache-all-sorted-completions.
(icomplete-with-completion-tables): Default to t.
* emacs-lisp/crm.el (crm--current-element): Rename from
crm--select-current-element. Don't put an overlay but return the
boundaries instead.
(crm--completion-command): Take two new args to bind to the boundaries.
(crm-completion-help): Adjust accordingly.
(crm-complete): Use completion-in-region.
(crm-complete-word): Use completion-in-region--single-word.
(crm-complete-and-exit): Use completion-complete-and-exit.
2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
* dired-x.el (dired-mark-sexp): Bind the vars lexically rather
than dynamically.
2013-09-06 Juri Linkov <juri@jurta.org>
* info.el (Info-display-images-node): When image file doesn't exist
display text version of the image if it's provided in the Info file.
Otherwise, display the location of missing image from SRC attribute.
Add help-echo text property from ALT attribute. (Bug#15279)
2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
* abbrev.el (edit-abbrevs-mode-map): Rename from edit-abbrevs-map.
(edit-abbrevs-mode): Use define-derived-mode.
* epa.el (epa--encode-coding-string, epa--decode-coding-string)
(epa--select-safe-coding-system, epa--derived-mode-p): Make it obvious
that it's defined.
(epa-key-list-mode, epa-key-mode, epa-info-mode):
Use define-derived-mode.
* epg.el (epg-start-encrypt): Minor CSE simplification.
2013-09-06 William Xu <william.xwl@gmail.com>
* arc-mode.el: Add support for 7za (bug#15264).
(archive-7z-program): New var.
(archive-zip-extract, archive-zip-expunge, archive-zip-update)
(archive-zip-update-case, archive-7z-extract, archive-7z-expunge)
(archive-7z-update, archive-zip-extract, archive-7z-summarize): Use it.
2013-09-06 Michael Albinus <michael.albinus@gmx.de>
Remove URL syntax.
* net/tramp.el (tramp-syntax, tramp-prefix-format)
(tramp-postfix-method-format, tramp-prefix-ipv6-format)
(tramp-postfix-ipv6-format, tramp-prefix-port-format)
(tramp-postfix-host-format, tramp-file-name-regexp)
(tramp-completion-file-name-regexp)
(tramp-completion-dissect-file-name)
(tramp-handle-substitute-in-file-name): Remove 'url case.
(tramp-file-name-regexp-url)
(tramp-completion-file-name-regexp-url): Remove constants.
2013-09-06 Glenn Morris <rgm@gnu.org>
* replace.el (replace-string): Doc fix re start/end. (Bug#15275)
2013-09-05 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-font-lock-keywords): Move "Perl-ish
keywords" below "here-doc beginnings" (Bug#15270).
2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (pop): Use `car-safe'.
* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove hack
to detect unused `pop' return value.
* progmodes/python.el (python-nav-beginning-of-block): Remove unused
var `block-regexp'.
(python-nav--forward-sexp): Remove unused var `re-search-fn'.
(python-fill-string): Remove unused var `marker'.
(python-skeleton-add-menu-items): Remove unused var `items'.
* international/mule-cmds.el: Require CL.
(find-coding-systems-for-charsets): Avoid add-to-list.
(sanitize-coding-system-list): New function, extracted from
select-safe-coding-system-interactively.
(select-safe-coding-system-interactively): Use it.
(read-input-method-name): Accept symbols for `default'.
* emacs-lisp/advice.el (defadvice): Add indent rule.
2013-09-05 Daniel Hackney <dan@haxney.org>
* dired-x.el:
* net/ange-ftp.el:
* net/browse-url.el:
* net/dbus.el:
* net/eudc.el:
* net/eudcb-ldap.el:
* net/eww.el:
* net/imap.el:
* printing.el:
* vc/ediff-diff.el:
* vc/ediff-init.el:
* vc/ediff-merg.el:
* vc/ediff-mult.el:
* vc/ediff-util.el:
* vc/ediff-wind.el:
* vc/ediff.el:
* vc/emerge.el:
* vc/pcvs.el:
* vc/vc-annotate.el: Prefix unused arguments with `_' to silence
byte compiler. Remove some unused let-bound variables.
2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el: Use `car-safe' rather than `car' to access
a "ref-cell", since it gets better optimized (bug#14883).
2013-09-05 Glenn Morris <rgm@gnu.org>
* progmodes/cc-awk.el (c-forward-sws): Declare.
2013-09-04 Glenn Morris <rgm@gnu.org>
* generic-x.el [rul-generic-mode]: Require cc-mode.
(c++-mode-syntax-table): Declare.
(rul-generic-mode-syntax-table): Init in the defvar.
2013-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
* vc/vc-dispatcher.el (vc-run-delayed): New macro.
(vc-do-command, vc-set-async-update):
* vc/vc-mtn.el (vc-mtn-dir-status):
* vc/vc-hg.el (vc-hg-dir-status, vc-hg-dir-status-files)
(vc-hg-pull, vc-hg-merge-branch):
* vc/vc-git.el (vc-git-dir-status-goto-stage, vc-git-pull)
(vc-git-merge-branch):
* vc/vc-cvs.el (vc-cvs-print-log, vc-cvs-dir-status)
(vc-cvs-dir-status-files):
* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch, vc-bzr-dir-status)
(vc-bzr-dir-status-files):
* vc/vc-arch.el (vc-arch-dir-status): Use vc-run-delayed.
* vc/vc-annotate.el: Use lexical-binding.
(vc-annotate-display-select, vc-annotate): Use vc-run-delayed.
(vc-sentinel-movepoint): Declare.
(vc-annotate): Don't use `goto-line'.
* vc/vc.el (vc-diff-internal): Prefer a closure to `(lambda...).
(vc-diff-internal, vc-log-internal-common): Use vc-run-delayed.
(vc-sentinel-movepoint): Declare.
* vc/vc-svn.el: Use lexical-binding.
(vc-svn-dir-status, vc-svn-dir-status-files): Use vc-run-delayed.
* vc/vc-sccs.el:
* vc/vc-rcs.el: Use lexical-binding.
* autorevert.el (auto-revert-notify-handler): Explicitly ignore
`deleted'. Don't drop errors silently.
* emacs-lisp/gv.el (gv-get): Warn about CL-compiled places.
2013-09-04 Xue Fuqiao <xfq.free@gmail.com>
* vc/vc.el (vc-ignore): Rewrite.
(vc-default-ignore): New function.
(vc-default-ignore-completion-table): Use find-ignore-file.
* vc/vc-bzr.el (vc-bzr-ignore, vc-bzr-ignore-completion-table):
* vc/vc-git.el (vc-git-ignore, vc-git-ignore-completion-table):
* vc/vc-hg.el (vc-hg-ignore, vc-hg-ignore-completion-table):
Remove. Most code moved to vc.el.
2013-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
* net/tramp-gvfs.el (tramp-gvfs-mount-spec, tramp-synce-list-devices):
* net/tramp-smb.el (tramp-smb-get-file-entries):
* net/tramp-sh.el (tramp-sh-handle-insert-directory)
(tramp-compute-multi-hops): Fix misuses of `add-to-list'.
* net/eww.el (eww-display-raw): Remove unused argument `charset'.
Update call to it.
(eww-change-select): Remove unused var `properties'.
(eww-make-unique-file-name): Remove unused var `base'.
* finder.el (finder-compile-keywords): Don't mess with windows.
* calculator.el (calculator-funcall): Fix typo in last change.
* vc/vc-git.el (vc-git-checkin): Make it possible to commit a merge.
* emacs-lisp/package.el (package-activate-1): Don't let a missing
<pkg>-autoloads.el file stop us.
* net/tramp.el (with-parsed-tramp-file-name): Silence compiler
warnings, and factor out common code.
2013-09-03 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/ruby-mode.el (ruby-calculate-indent): Consider
two-character operators and whether the character preceding them
changes their meaning (Bug#15208).
2013-09-02 Fabián Ezequiel Gallina <fgallina@gnu.org>
Format code sent to Python shell for robustness.
* progmodes/python.el (python-shell-buffer-substring):
New function.
(python-shell-send-region, python-shell-send-buffer): Use it.
2013-09-02 Michael Albinus <michael.albinus@gmx.de>
* net/tramp-compat.el (tramp-compat-user-error): Move it ...
* net/tramp.el (tramp-user-error): ... here.
(tramp-find-method, tramp-check-proper-host)
(tramp-dissect-file-name, tramp-debug-message)
(tramp-handle-shell-command):
* net/tramp-adb.el (tramp-adb-handle-shell-command):
* net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees.
* net/tramp-cache.el (tramp-cache-print): Don't print text properties.
2013-09-02 Martin Rudalics <rudalics@gmx.at>
* avoid.el (mouse-avoidance-point-position)
(mouse-avoidance-too-close-p): Handle case where posn-at-point
returns nil.
2013-09-02 Fabián Ezequiel Gallina <fgallina@gnu.org>
* progmodes/python.el (python-shell-completion-get-completions):
Drop use of deleted `comint-last-prompt-overlay'.
(python-nav-if-name-main): New command.
2013-09-01 Glenn Morris <rgm@gnu.org>
* Makefile.in (setwins, setwins_almost, setwins_for_subdirs):
Avoid leading space in $wins. Otherwise the sed command used by
eg compile-main ends up containing "/*.el". (Bug#15170)
* frame.el (frame-background-mode): Doc fix. (Bug#15226)
2013-08-30 Glenn Morris <rgm@gnu.org>
* emacs-lisp/bytecomp.el (byte-recompile-directory):
Fix is-this-a-directory logic. (Bug#15220)
2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/css-mode.el: Use SMIE.
(css-smie-grammar): New var.
(css-smie--forward-token, css-smie--backward-token)
(css-smie-rules): New functions.
(css-mode): Use them.
(css-navigation-syntax-table): Remove var.
(css-backward-sexp, css-forward-sexp, css-indent-calculate-virtual)
(css-indent-calculate, css-indent-line): Remove functions.
Misc changes to reduce use of `(lambda...); and other cleanups.
* cus-edit.el: Use lexical-binding.
(customize-push-and-save, customize-apropos)
(custom-buffer-create-internal): Use closures.
* progmodes/bat-mode.el (bat-mode-syntax-table): "..." are strings.
* progmodes/ada-xref.el: Use setq.
* net/tramp.el (with-tramp-progress-reporter): Avoid setq.
* dframe.el: Use lexical-binding.
(dframe-frame-mode): Fix calling convention for hooks. Use a closure.
* speedbar.el (speedbar-frame-mode): Adjust call accordingly.
* descr-text.el: Use lexical-binding.
(describe-text-widget, describe-text-sexp, describe-property-list):
Use closures.
* comint.el (comint-history-isearch-push-state): Use a closure.
* calculator.el: Use lexical-binding.
(calculator-number-to-string): Make it work with lexical-binding.
(calculator-funcall): Same and use cl-letf.
* emacs-lisp/lisp.el (lisp--company-doc-buffer)
(lisp--company-doc-string, lisp--company-location): New functions.
(lisp-completion-at-point): Use them to improve Company support.
* progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for formal
params of lambda expressions.
(ruby-smie--implicit-semi-p): Refine rule (bug#15208).
(ruby-smie--opening-pipe-p): New function.
(ruby-smie--forward-token, ruby-smie--backward-token): Handle Ruby
symbols and matched |...| for formal params.
(ruby-smie-rules): Don't let the formal params of a "do" prevent it
from being treated as hanging. Handle "rescue".
2013-08-29 Glenn Morris <rgm@gnu.org>
* progmodes/cc-engine.el (c-pull-open-brace):
Move definition before use.
2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-macs.el (cl-defsubst): Make it clear that args
are immutable. Don't use `unsafe' any more.
(cl--defsubst-expand): Don't substitute at the same time as keeping
a residual unused let-binding. Don't use `unsafe' any more.
2013-08-29 Glenn Morris <rgm@gnu.org>
* calendar/cal-china.el (calendar-chinese-year-cache):
Recenter on 2015.
* nxml/nxml-util.el (nxml-debug-clear-inside):
Use cl-loop rather than loop.
* net/eww.el (eww-mode-map): Lower-case menu bar entries look bad.
* progmodes/sh-script.el (sh-builtins) <bash>: Add some bash4-isms.
2013-08-28 Glenn Morris <rgm@gnu.org>
* progmodes/antlr-mode.el: No need to require cc-mode twice.
* progmodes/cc-bytecomp.el (cc-require): Handle uncompiled case.
* progmodes/cc-mode.el (c-define-abbrev-table): Handle NAME unbound.
2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (repeat-complex-command--called-interactively-skip):
New function.
(repeat-complex-command): Use it (bug#14136).
* progmodes/cc-mode.el: Minor cleanup of var declarations.
(c-define-abbrev-table): Add `doc' argument.
(c-mode-abbrev-table, c++-mode-abbrev-table)
(objc-mode-abbrev-table, java-mode-abbrev-table)
(idl-mode-abbrev-table, pike-mode-abbrev-table)
(awk-mode-abbrev-table): Use it.
(c-mode-syntax-table, c-mode-map, c++-mode-syntax-table)
(c++-mode-map, objc-mode-syntax-table, objc-mode-map)
(java-mode-syntax-table, java-mode-map, idl-mode-syntax-table)
(idl-mode-map, pike-mode-syntax-table, pike-mode-map, awk-mode-map):
Move initialization into the declaration; and remove any
autoload cookie.
* epg.el (epg--process-filter): Use with-current-buffer, save-excursion
and dynamic let binding.
* vc/smerge-mode.el: Remove redundant :group args.
* emacs-lisp/package.el (package-activate-1): Don't add unnecessarily
to load-path.
2013-08-28 Juri Linkov <juri@jurta.org>
* isearch.el (isearch-reread-key-sequence-naturally): Use non-nil
arg DONT-DOWNCASE-LAST of `read-key-sequence'.
(isearch-other-meta-char): Handle an undefined shifted printing
character by downshifting it. (Bug#15200)
2013-08-28 Juri Linkov <juri@jurta.org>
* isearch.el (isearch-search): Change regexp error message for
non-regexp searches. (Bug#15166)
2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
* Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
for portability to hosts where /bin/sh has problems.
2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el (cconv--analyse-function): Improve warning.
2013-08-27 Juri Linkov <juri@jurta.org>
* isearch.el (isearch-other-meta-char): Don't store kmacro commands
@ -12,8 +546,8 @@
2013-08-27 Martin Rudalics <rudalics@gmx.at>
* window.el (display-buffer-use-some-window): Add missing
argument in call of get-largest-window (Bug#15185). Reported by
Stephen Leake.
argument in call of get-largest-window (Bug#15185).
Reported by Stephen Leake.
2013-08-27 Glenn Morris <rgm@gnu.org>
@ -38,8 +572,8 @@
* net/tramp-adb.el (tramp-adb-maybe-open-connection):
* net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* net/tramp-sh.el (tramp-maybe-open-connection):
* net/tramp-smb.el (tramp-smb-maybe-open-connection): Apply
`tramp-check-proper-host'.
* net/tramp-smb.el (tramp-smb-maybe-open-connection):
Apply `tramp-check-proper-host'.
2013-08-26 Tassilo Horn <tsdh@gnu.org>

2
lisp/ChangeLog.12
View file

@ -17355,7 +17355,7 @@
* calc/calc-embed.el (calc-do-embedded): Update help message.
* calc/calc-prog.el (calc-user-define-invokation): Update help message.
* calc/calc-prog.el (calc-user-define-invocation): Update help message.
2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca>

8
lisp/Makefile.in
View file

@ -17,7 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
SHELL = /bin/sh
SHELL = @SHELL@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
@ -118,7 +118,7 @@ emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
setwins=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* ) ;; \
*) wins="$$wins $$file" ;; \
*) wins="$$wins$${wins:+ }$$file" ;; \
esac; \
done
@ -126,7 +126,7 @@ setwins=subdirs=`find . -type d -print`; \
setwins_almost=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */obsolete | */term ) ;; \
*) wins="$$wins $$file" ;; \
*) wins="$$wins$${wins:+ }$$file" ;; \
esac; \
done
@ -134,7 +134,7 @@ setwins_almost=subdirs=`find . -type d -print`; \
setwins_for_subdirs=subdirs=`find . -type d -print`; \
for file in $$subdirs; do \
case $$file in */.* | */.*/* | */=* | */cedet* ) ;; \
*) wins="$$wins $$file" ;; \
*) wins="$$wins$${wins:+ }$$file" ;; \
esac; \
done

19
lisp/abbrev.el
View file

@ -67,13 +67,15 @@ be replaced by its expansion."
(put 'abbrev-mode 'safe-local-variable 'booleanp)
(defvar edit-abbrevs-map
(defvar edit-abbrevs-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
(define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
(define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
map)
"Keymap used in `edit-abbrevs'.")
(define-obsolete-variable-alias 'edit-abbrevs-map
'edit-abbrevs-mode-map "24.4")
(defun kill-all-abbrevs ()
"Undefine all defined abbrevs."
@ -144,16 +146,6 @@ Otherwise display all abbrevs."
(set-buffer-modified-p nil)
(current-buffer))))
(defun edit-abbrevs-mode ()
"Major mode for editing the list of abbrev definitions.
\\{edit-abbrevs-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'edit-abbrevs-mode)
(setq mode-name "Edit-Abbrevs")
(use-local-map edit-abbrevs-map)
(run-mode-hooks 'edit-abbrevs-mode-hook))
(defun edit-abbrevs ()
"Alter abbrev definitions by editing a list of them.
Selects a buffer containing a list of abbrev definitions with
@ -1013,6 +1005,11 @@ SORTFUN is passed to `sort' to change the default ordering."
(sort entries (lambda (x y)
(funcall sortfun (nth 2 x) (nth 2 y)))))))
;; Keep it after define-abbrev-table, since define-derived-mode uses
;; define-abbrev-table.
(define-derived-mode edit-abbrevs-mode special-mode "Edit-Abbrevs"
"Major mode for editing the list of abbrev definitions.")
(provide 'abbrev)
;;; abbrev.el ends here

23
lisp/arc-mode.el
View file

@ -218,9 +218,14 @@ Archive and member name will be added."
;; ------------------------------
;; Zip archive configuration
(defvar archive-7z-program (let ((7z (or (executable-find "7z")
(executable-find "7za"))))
(when 7z
(file-name-nondirectory 7z))))
(defcustom archive-zip-extract
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
((executable-find "7z") '("7z" "x" "-so"))
(archive-7z-program `(,archive-7z-program "x" "-so"))
((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
(t '("unzip" "-qq" "-c")))
"Program and its options to run in order to extract a zip file member.
@ -239,7 +244,7 @@ be added."
(defcustom archive-zip-expunge
(cond ((executable-find "zip") '("zip" "-d" "-q"))
((executable-find "7z") '("7z" "d"))
(archive-7z-program `(,archive-7z-program "d"))
((executable-find "pkzip") '("pkzip" "-d"))
(t '("zip" "-d" "-q")))
"Program and its options to run in order to delete zip file members.
@ -252,7 +257,7 @@ Archive and member names will be added."
(defcustom archive-zip-update
(cond ((executable-find "zip") '("zip" "-q"))
((executable-find "7z") '("7z" "u"))
(archive-7z-program `(,archive-7z-program "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q")))
"Program and its options to run in order to update a zip file member.
@ -266,7 +271,7 @@ file. Archive and member name will be added."
(defcustom archive-zip-update-case
(cond ((executable-find "zip") '("zip" "-q" "-k"))
((executable-find "7z") '("7z" "u"))
(archive-7z-program `(,archive-7z-program "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q" "-k")))
"Program and its options to run in order to update a case fiddled zip member.
@ -321,7 +326,7 @@ Archive and member name will be added."
;; 7z archive configuration
(defcustom archive-7z-extract
'("7z" "x" "-so")
`(,archive-7z-program "x" "-so")
"Program and its options to run in order to extract a 7z file member.
Extraction should happen to standard output. Archive and member name will
be added."
@ -333,7 +338,7 @@ be added."
:group 'archive-7z)
(defcustom archive-7z-expunge
'("7z" "d")
`(,archive-7z-program "d")
"Program and its options to run in order to delete 7z file members.
Archive and member names will be added."
:version "24.1"
@ -344,7 +349,7 @@ Archive and member names will be added."
:group 'archive-7z)
(defcustom archive-7z-update
'("7z" "u")
`(,archive-7z-program "u")
"Program and its options to run in order to update a 7z file member.
Options should ensure that specified directory will be put into the 7z
file. Archive and member name will be added."
@ -1864,7 +1869,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(cond
((member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip"))
(archive-*-extract archive name archive-zip-extract))
((equal (car archive-zip-extract) "7z")
((equal (car archive-zip-extract) archive-7z-program)
(let ((archive-7z-extract archive-zip-extract))
(archive-7z-extract archive name)))
(t
@ -2088,7 +2093,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(file buffer-file-name)
(files ()))
(with-temp-buffer
(call-process "7z" nil t nil "l" "-slt" file)
(call-process archive-7z-program nil t nil "l" "-slt" file)
(goto-char (point-min))
;; Four dashes start the meta info section that should be skipped.
;; Archive members start with more than four dashes.

49
lisp/autorevert.el
View file

@ -531,7 +531,7 @@ will use an up-to-date value of `auto-revert-interval'"
(defun auto-revert-notify-handler (event)
"Handle an EVENT returned from file notification."
(ignore-errors
(with-demoted-errors
(let* ((descriptor (car event))
(action (nth 1 event))
(file (nth 2 event))
@ -541,28 +541,31 @@ will use an up-to-date value of `auto-revert-interval'"
;; Check, that event is meant for us.
(cl-assert descriptor)
;; We do not handle `deleted', because nothing has to be refreshed.
(cl-assert (memq action '(attribute-changed changed created renamed)) t)
;; Since we watch a directory, a file name must be returned.
(cl-assert (stringp file))
(when (eq action 'renamed) (cl-assert (stringp file1)))
;; Loop over all buffers, in order to find the intended one.
(dolist (buffer buffers)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and (stringp buffer-file-name)
(or
(and (memq action '(attribute-changed changed created))
(string-equal
(file-name-nondirectory file)
(file-name-nondirectory buffer-file-name)))
(and (eq action 'renamed)
(string-equal
(file-name-nondirectory file1)
(file-name-nondirectory buffer-file-name)))))
;; Mark buffer modified.
(setq auto-revert-notify-modified-p t)
;; No need to check other buffers.
(cl-return))))))))
(unless (eq action 'deleted)
(cl-assert (memq action '(attribute-changed changed created renamed))
t)
;; Since we watch a directory, a file name must be returned.
(cl-assert (stringp file))
(when (eq action 'renamed) (cl-assert (stringp file1)))
;; Loop over all buffers, in order to find the intended one.
(dolist (buffer buffers)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and (stringp buffer-file-name)
(or
(and (memq action '(attribute-changed changed
created))
(string-equal
(file-name-nondirectory file)
(file-name-nondirectory buffer-file-name)))
(and (eq action 'renamed)
(string-equal
(file-name-nondirectory file1)
(file-name-nondirectory buffer-file-name)))))
;; Mark buffer modified.
(setq auto-revert-notify-modified-p t)
;; No need to check other buffers.
(cl-return)))))))))
(defun auto-revert-active-p ()
"Check if auto-revert is active (in current buffer or globally)."

36
lisp/avoid.el
View file

@ -41,9 +41,9 @@
;;
;; (if (eq window-system 'x)
;; (mouse-avoidance-set-pointer-shape
;; (eval (nth (random 4)
;; '(x-pointer-man x-pointer-spider
;; x-pointer-gobbler x-pointer-gumby)))))
;; (nth (random 4)
;; (list x-pointer-man x-pointer-spider
;; x-pointer-gobbler x-pointer-gumby))))
;;
;; For completely random pointer shape, replace the setq above with:
;; (setq x-pointer-shape (mouse-avoidance-random-shape))
@ -154,13 +154,15 @@ TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
(defun mouse-avoidance-point-position ()
"Return the position of point as (FRAME X . Y).
Analogous to `mouse-position'."
(let ((edges (window-inside-edges))
(x-y (posn-x-y (posn-at-point))))
(cons (selected-frame)
(cons (+ (car edges)
(/ (car x-y) (frame-char-width)))
(+ (car (cdr edges))
(/ (cdr x-y) (frame-char-height)))))))
(let* ((edges (window-inside-edges))
(posn-at-point (posn-at-point))
(x-y (and posn-at-point (posn-x-y posn-at-point))))
(when x-y
(cons (selected-frame)
(cons (+ (car edges)
(/ (car x-y) (frame-char-width)))
(+ (car (cdr edges))
(/ (cdr x-y) (frame-char-height))))))))
;(defun mouse-avoidance-point-position-test ()
; (interactive)
@ -185,19 +187,21 @@ MOUSE is the current mouse position as returned by `mouse-position'.
Acceptable distance is defined by `mouse-avoidance-threshold'."
(let* ((frame (car mouse))
(mouse-y (cdr (cdr mouse)))
(tool-bar-lines (frame-parameter nil 'tool-bar-lines)))
(tool-bar-lines (frame-parameter nil 'tool-bar-lines))
point)
(or tool-bar-lines
(setq tool-bar-lines 0))
(if (and mouse-y (< mouse-y tool-bar-lines))
nil
(let ((point (mouse-avoidance-point-position))
(mouse-x (car (cdr mouse))))
(cond
((and mouse-y (< mouse-y tool-bar-lines))
nil)
((setq point (mouse-avoidance-point-position))
(let ((mouse-x (car (cdr mouse))))
(and (eq frame (car point))
(not (null mouse-x))
(< (abs (- mouse-x (car (cdr point))))
mouse-avoidance-threshold)
(< (abs (- mouse-y (cdr (cdr point))))
mouse-avoidance-threshold))))))
mouse-avoidance-threshold)))))))
(defun mouse-avoidance-banish-destination ()
"The position to which Mouse Avoidance mode `banish' moves the mouse.

48
lisp/calculator.el
View file

@ -1,4 +1,4 @@
;;; calculator.el --- a [not so] simple calculator for Emacs
;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
@ -131,8 +131,8 @@ The displayer is a symbol, a string or an expression. A symbol should
be the name of a one-argument function, a string is used with a single
argument and an expression will be evaluated with the variable `num'
bound to whatever should be displayed. If it is a function symbol, it
should be able to handle special symbol arguments, currently 'left and
'right which will be sent by special keys to modify display parameters
should be able to handle special symbol arguments, currently `left' and
`right' which will be sent by special keys to modify display parameters
associated with the displayer function (for example to change the number
of digits displayed).
@ -241,6 +241,8 @@ Examples:
;;;=====================================================================
;;; Code:
(eval-when-compile (require 'cl-lib))
;;;---------------------------------------------------------------------
;;; Variables
@ -1124,11 +1126,10 @@ the 'left or 'right when one of the standard modes is used."
(format calculator-displayer num))
((symbolp calculator-displayer)
(funcall calculator-displayer num))
((and (consp calculator-displayer)
(eq 'std (car calculator-displayer)))
((eq 'std (car-safe calculator-displayer))
(calculator-standard-displayer num (cadr calculator-displayer)))
((listp calculator-displayer)
(eval calculator-displayer))
(eval calculator-displayer `((num. ,num))))
(t (prin1-to-string num t))))
;; operators are printed here
(t (prin1-to-string (nth 1 num) t))))
@ -1273,29 +1274,24 @@ arguments."
;; smaller than calculator-epsilon (1e-15). I don't think this is
;; necessary now.
(if (symbolp f)
(cond ((and X Y) (funcall f X Y))
(X (funcall f X))
(t (funcall f)))
(cond ((and X Y) (funcall f X Y))
(X (funcall f X))
(t (funcall f)))
;; f is an expression
(let* ((__f__ f) ; so we can get this value below...
(TX (calculator-truncate X))
(let* ((TX (calculator-truncate X))
(TY (and Y (calculator-truncate Y)))
(DX (if calculator-deg (/ (* X pi) 180) X))
(L calculator-saved-list)
(Fbound (fboundp 'F))
(Fsave (and Fbound (symbol-function 'F)))
(Dbound (fboundp 'D))
(Dsave (and Dbound (symbol-function 'D))))
;; a shortened version of flet
(fset 'F (function
(lambda (&optional x y)
(calculator-funcall __f__ x y))))
(fset 'D (function
(lambda (x)
(if calculator-deg (/ (* x 180) float-pi) x))))
(unwind-protect (eval f)
(if Fbound (fset 'F Fsave) (fmakunbound 'F))
(if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
(L calculator-saved-list))
(cl-letf (((symbol-function 'F)
(lambda (&optional x y) (calculator-funcall f x y)))
((symbol-function 'D)
(lambda (x) (if calculator-deg (/ (* x 180) float-pi) x))))
(eval f `((X . ,X)
(Y . ,Y)
(TX . ,TX)
(TY . ,TY)
(DX . ,DX)
(L . ,L))))))
(error 0)))
;;;---------------------------------------------------------------------

28
lisp/calendar/cal-china.el
View file

@ -327,19 +327,7 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
(defvar calendar-chinese-year-cache
;; Maintainers: delete existing value, position point at start of
;; empty line, then call M-: (calendar-chinese-year-cache-init N)
'((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273)
(6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450))
(2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628)
(5 730657) (6 730687) (7 730716) (8 730745) (9 730775) (10 730804)
(11 730834))
(2002 (12 730863) (1 730893) (2 730923) (3 730953) (4 730982) (5 731012)
(6 731041) (7 731071) (8 731100) (9 731129) (10 731159) (11 731188))
(2003 (12 731218) (1 731247) (2 731277) (3 731307) (4 731336) (5 731366)
(6 731396) (7 731425) (8 731455) (9 731484) (10 731513) (11 731543))
(2004 (12 731572) (1 731602) (2 731631) (2.5 731661) (3 731690) (4 731720)
(5 731750) (6 731779) (7 731809) (8 731838) (9 731868) (10 731897)
(11 731927))
(2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104)
'((2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104)
(6 732133) (7 732163) (8 732193) (9 732222) (10 732252) (11 732281))
(2006 (12 732311) (1 732340) (2 732370) (3 732399) (4 732429) (5 732458)
(6 732488) (7 732517) (7.5 732547) (8 732576) (9 732606) (10 732636)
@ -376,7 +364,19 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
(6 737243) (7 737272) (8 737301) (9 737331) (10 737360) (11 737389))
(2020 (12 737419) (1 737449) (2 737478) (3 737508) (4 737538) (4.5 737568)
(5 737597) (6 737627) (7 737656) (8 737685) (9 737715) (10 737744)
(11 737774)))
(11 737774))
(2021 (12 737803) (1 737833) (2 737862) (3 737892) (4 737922) (5 737951)
(6 737981) (7 738010) (8 738040) (9 738069) (10 738099) (11 738128))
(2022 (12 738158) (1 738187) (2 738217) (3 738246) (4 738276) (5 738305)
(6 738335) (7 738365) (8 738394) (9 738424) (10 738453) (11 738483))
(2023 (12 738512) (1 738542) (2 738571) (2.5 738601) (3 738630) (4 738659)
(5 738689) (6 738719) (7 738748) (8 738778) (9 738808) (10 738837)
(11 738867))
(2024 (12 738896) (1 738926) (2 738955) (3 738985) (4 739014) (5 739043)
(6 739073) (7 739102) (8 739132) (9 739162) (10 739191) (11 739221))
(2025 (12 739251) (1 739280) (2 739310) (3 739339) (4 739369) (5 739398)
(6 739427) (6.5 739457) (7 739486) (8 739516) (9 739545) (10 739575)
(11 739605)))
"Alist of Chinese year structures as determined by `chinese-year'.
The default can be nil, but some values are precomputed for efficiency.")

5
lisp/cedet/ChangeLog
View file

@ -1,3 +1,8 @@
2013-09-05 Glenn Morris <rgm@gnu.org>
* semantic/fw.el (semantic-make-local-hook):
Simplify by dropping Emacs <= 20.
2013-07-29 David Engster <deng@randomsample.de>
* lisp/cedet/cedet.el (cedet-packages): Remove speedbar since its

3
lisp/cedet/semantic/fw.el
View file

@ -123,8 +123,7 @@
(defalias 'semantic-make-local-hook
(if (and (not (featurep 'xemacs))
(>= emacs-major-version 21))
(if (featurep 'emacs)
#'identity #'make-local-hook))
(defalias 'semantic-mode-line-update

5
lisp/comint.el
View file

@ -1562,8 +1562,9 @@ or to the last history element for a backward search."
"Save a function restoring the state of input history search.
Save `comint-input-ring-index' to the additional state parameter
in the search status stack."
`(lambda (cmd)
(comint-history-isearch-pop-state cmd ,comint-input-ring-index)))
(let ((index comint-input-ring-index))
(lambda (cmd)
(comint-history-isearch-pop-state cmd index))))
(defun comint-history-isearch-pop-state (_cmd hist-pos)
"Restore the input history search state.

41
lisp/cus-edit.el
View file

@ -1,4 +1,4 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*-
;;
;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
;;
@ -1057,8 +1057,8 @@ the resulting list value now. Otherwise, add an entry to
(let ((coding-system-for-read nil))
(customize-save-variable list-var (eval list-var)))
(add-hook 'after-init-hook
`(lambda ()
(customize-push-and-save ',list-var ',elts)))))
(lambda ()
(customize-push-and-save list-var elts)))))
;;;###autoload
(defun customize ()
@ -1415,6 +1415,7 @@ suggest to customize that face, if it's customizable."
"*Customize Saved*"))))
(declare-function apropos-parse-pattern "apropos" (pattern))
(defvar apropos-regexp)
;;;###autoload
(defun customize-apropos (pattern &optional type)
@ -1431,23 +1432,23 @@ If TYPE is `groups', include only groups."
(require 'apropos)
(unless (memq type '(nil options faces groups))
(error "Invalid setting type %s" (symbol-name type)))
(apropos-parse-pattern pattern)
(apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck!
(let (found)
(mapatoms
`(lambda (symbol)
(when (string-match-p apropos-regexp (symbol-name symbol))
,(if (memq type '(nil groups))
'(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
,(if (memq type '(nil faces))
'(if (custom-facep symbol)
(push (list symbol 'custom-face) found)))
,(if (memq type '(nil options))
`(if (and (boundp symbol)
(eq (indirect-variable symbol) symbol)
(or (get symbol 'saved-value)
(custom-variable-p symbol)))
(push (list symbol 'custom-variable) found))))))
(lambda (symbol)
(when (string-match-p apropos-regexp (symbol-name symbol))
(if (memq type '(nil groups))
(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
(if (memq type '(nil faces))
(if (custom-facep symbol)
(push (list symbol 'custom-face) found)))
(if (memq type '(nil options))
(if (and (boundp symbol)
(eq (indirect-variable symbol) symbol)
(or (get symbol 'saved-value)
(custom-variable-p symbol)))
(push (list symbol 'custom-variable) found))))))
(unless found
(error "No customizable %s matching %s" (symbol-name type) pattern))
(custom-buffer-create
@ -1621,8 +1622,8 @@ or a regular expression.")
(widget-create
'editable-field
:size 40 :help-echo echo
:action `(lambda (widget &optional event)
(customize-apropos (split-string (widget-value widget)))))))
:action (lambda (widget &optional _event)
(customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button

21
lisp/descr-text.el
View file

@ -1,4 +1,4 @@
;;; descr-text.el --- describe text mode
;;; descr-text.el --- describe text mode -*- lexical-binding:t -*-
;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc.
@ -23,7 +23,7 @@
;;; Commentary:
;;; Describe-Text Mode.
;; Describe-Text Mode.
;;; Code:
@ -36,8 +36,7 @@
"Insert text to describe WIDGET in the current buffer."
(insert-text-button
(symbol-name (if (symbolp widget) widget (car widget)))
'action `(lambda (&rest ignore)
(widget-browse ',widget))
'action (lambda (&rest _ignore) (widget-browse widget))
'help-echo "mouse-2, RET: browse this widget")
(insert " ")
(insert-text-button
@ -55,10 +54,10 @@
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
"[Show]" 'action `(lambda (&rest ignore)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(princ ',pp)))
"[Show]" 'action (lambda (&rest _ignore)
(with-output-to-temp-buffer
"*Pp Eval Output*"
(princ pp)))
'help-echo "mouse-2, RET: pretty print value in another buffer"))))
(defun describe-property-list (properties)
@ -81,8 +80,8 @@ into help buttons that call `describe-text-category' or
(cond ((eq key 'category)
(insert-text-button
(symbol-name value)
'action `(lambda (&rest ignore)
(describe-text-category ',value))
'action (lambda (&rest _ignore)
(describe-text-category value))
'follow-link t
'help-echo "mouse-2, RET: describe this category"))
((memq key '(face font-lock-face mouse-face))
@ -663,7 +662,7 @@ relevant to POS."
((and (< char 32) (not (memq char '(9 10))))
'escape-glyph)))))
(if face (list (list "hardcoded face"
`(insert-text-button
`(insert-text-button ;FIXME: Wrap in lambda!
,(symbol-name face)
'type 'help-face
'help-args '(,face))))))

42
lisp/dframe.el
View file

@ -1,4 +1,4 @@
;;; dframe --- dedicate frame support modes
;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
@ -259,9 +259,15 @@ This buffer will have `dframe-frame-mode' run on it.
FRAME-NAME is the name of the frame to create.
LOCAL-MODE-FN is the function used to call this one.
PARAMETERS are frame parameters to apply to this dframe.
DELETE-HOOK are hooks to run when deleting a frame.
POPUP-HOOK are hooks to run before showing a frame.
CREATE-HOOK are hooks to run after creating a frame."
DELETE-HOOK is a hook to run when deleting a frame.
POPUP-HOOK is a hook to run before showing a frame.
CREATE-HOOK is a hook to run after creating a frame."
(let ((conv-hook (lambda (val)
(let ((sym (make-symbol "hook")))
(set sym val) sym))))
(if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook)))
(if (consp create-hook) (setq create-hook (funcall conv-hook create-hook)))
(if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook))))
;; toggle frame on and off.
(if (not arg) (if (dframe-live-p (symbol-value frame-var))
(setq arg -1) (setq arg 1)))
@ -270,7 +276,7 @@ CREATE-HOOK are hooks to run after creating a frame."
;; turn the frame off on neg number
(if (and (numberp arg) (< arg 0))
(progn
(run-hooks 'delete-hook)
(run-hooks delete-hook)
(if (and (symbol-value frame-var)
(frame-live-p (symbol-value frame-var)))
(progn
@ -279,7 +285,7 @@ CREATE-HOOK are hooks to run after creating a frame."
(set frame-var nil))
;; Set this as our currently attached frame
(setq dframe-attached-frame (selected-frame))
(run-hooks 'popup-hook)
(run-hooks popup-hook)
;; Updated the buffer passed in to contain all the hacks needed
;; to make it work well in a dedicated window.
(with-current-buffer (symbol-value buffer-var)
@ -331,15 +337,15 @@ CREATE-HOOK are hooks to run after creating a frame."
(setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
;; If this buffer is killed, we must make sure that we destroy
;; the frame the dedicated window is in.
(add-hook 'kill-buffer-hook `(lambda ()
(let ((skilling (boundp 'skilling)))
(if skilling
nil
(if dframe-controlled
(progn
(funcall dframe-controlled -1)
(setq ,buffer-var nil)
)))))
(add-hook 'kill-buffer-hook (lambda ()
(let ((skilling (boundp 'skilling)))
(if skilling
nil
(if dframe-controlled
(progn
(funcall dframe-controlled -1)
(set buffer-var nil)
)))))
t t)
)
;; Get the frame to work in
@ -396,7 +402,7 @@ CREATE-HOOK are hooks to run after creating a frame."
(switch-to-buffer (symbol-value buffer-var))
(set-window-dedicated-p (selected-window) t))
;; Run hooks (like reposition)
(run-hooks 'create-hook)
(run-hooks create-hook)
;; Frame name
(if (and (or (null window-system) (eq window-system 'pc))
(fboundp 'set-frame-name))
@ -602,7 +608,7 @@ Argument E is the event deleting the frame."
If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR
frame is selected. If the FRAME-VAR is active, then select the
attached frame. If FRAME-VAR is nil, ACTIVATOR is called to
created it. HOOK is an optional argument of hooks to run when
created it. HOOK is an optional hook to run when
selecting FRAME-VAR."
(interactive)
(if (eq (selected-frame) (symbol-value frame-var))
@ -616,7 +622,7 @@ selecting FRAME-VAR."
)
(other-frame 0)
;; If updates are off, then refresh the frame (they want it now...)
(run-hooks 'hook))
(run-hooks hook))
(defun dframe-close-frame ()

35
lisp/dired-x.el
View file

@ -1,4 +1,4 @@
;;; dired-x.el --- extra Dired functionality
;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*-
;; Copyright (C) 1993-1994, 1997, 2001-2013 Free Software Foundation,
;; Inc.
@ -1185,7 +1185,7 @@ results in
(setq count (1+ count)
start (1+ start)))
;; ... and prepend a "../" for each slash found:
(dotimes (_n count)
(dotimes (_ count)
(setq name1 (concat "../" name1)))))
(make-symbolic-link
(directory-file-name name1) ; must not link to foo/
@ -1397,22 +1397,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent."
;; Does anyone use this? - lrd 6/29/93.
;; Apparently people do use it. - lrd 12/22/97.
(with-no-warnings
;; Warnings are suppressed to avoid "global/dynamic var `X' lacks a prefix".
;; This is unbearably ugly, but not more than having global variables
;; named size, time, name or s, however practical it can be while writing
;; `dired-mark-sexp' predicates.
(defvar inode)
(defvar s)
(defvar mode)
(defvar nlink)
(defvar uid)
(defvar gid)
(defvar size)
(defvar time)
(defvar name)
(defvar sym))
(defun dired-mark-sexp (predicate &optional unflag-p)
"Mark files for which PREDICATE returns non-nil.
With a prefix arg, unmark or unflag those files instead.
@ -1475,6 +1459,9 @@ to mark all zero length files."
s nil))
(setq mode (buffer-substring (point) (+ mode-len (point))))
(forward-char mode-len)
;; Skip any extended attributes marker ("." or "+").
(or (looking-at " ")
(forward-char 1))
(setq nlink (read (current-buffer)))
;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid.
(setq uid (buffer-substring (1+ (point))
@ -1505,7 +1492,17 @@ to mark all zero length files."
(line-end-position))
""))
t)
(eval predicate)))
(eval predicate
`((inode . ,inode)
(s . ,s)
(mode . ,mode)
(nlink . ,nlink)
(uid . ,uid)
(gid . ,gid)
(size . ,size)
(time . ,time)
(name . ,name)
(sym . ,sym)))))
(format "'%s file" predicate))))

2
lisp/dired.el
View file

@ -4352,7 +4352,7 @@ instead.
;;;***
;;;### (autoloads nil "dired-x" "dired-x.el" "1419d865898f84c17f172320e578380c")
;;;### (autoloads nil "dired-x" "dired-x.el" "11fd4a8afa32507cc32d4a04d852587f")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\

2
lisp/emacs-lisp/advice.el
View file

@ -3190,7 +3190,7 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
(declare (doc-string 3)
(declare (doc-string 3) (indent 2)
(debug (&define name ;; thing being advised.
(name ;; class is [&or "before" "around" "after"
;; "activation" "deactivation"]

12
lisp/emacs-lisp/byte-opt.el
View file

@ -533,18 +533,6 @@
((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors
(eq tmp 'error-free)
;; Detect the expansion of (pop foo).
;; There is no need to compile the call to `car' there.
(and (eq fn 'car)
(eq (car-safe (cadr form)) 'prog1)
(let ((var (cadr (cadr form)))
(last (nth 2 (cadr form))))
(and (symbolp var)
(null (nthcdr 3 (cadr form)))
(eq (car-safe last) 'setq)
(eq (cadr last) var)
(eq (car-safe (nth 2 last)) 'cdr)
(eq (cadr (nth 2 last)) var))))
(progn
(byte-compile-warn "value returned from %s is unused"
(prin1-to-string form))

20
lisp/emacs-lisp/bytecomp.el
View file

@ -1,7 +1,7 @@
;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2013 Free Software
;; Foundation, Inc.
;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2013
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@ -1593,14 +1593,14 @@ that already has a `.elc' file."
(message "Checking %s..." directory)
(dolist (file (directory-files directory))
(let ((source (expand-file-name file directory)))
(if (and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
(file-directory-p source)
(not (file-symlink-p source)))
;; This file is a subdirectory. Handle them differently.
(when (or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
(setq directories (nconc directories (list source))))
(if (file-directory-p source)
(and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
(not (file-symlink-p source))
;; This file is a subdirectory. Handle them differently.
(or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
(setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
;; The next 2 tests avoid compiling lock files

23
lisp/emacs-lisp/cconv.el
View file

@ -55,7 +55,7 @@
;;
;; If a variable is mutated (updated by setq), and it is used in a closure
;; we wrap its definition with list: (list val) and we also replace
;; var => (car var) wherever this variable is used, and also
;; var => (car-safe var) wherever this variable is used, and also
;; (setq var value) => (setcar var value) where it is updated.
;;
;; If defun argument is closure mutable, we letbind it and wrap it's
@ -211,9 +211,9 @@ Returns a form where all lambdas don't have any free variables."
;; If `fv' is a variable that's wrapped in a cons-cell,
;; we want to put the cons-cell itself in the closure,
;; rather than just a copy of its current content.
(`(car ,iexp . ,_)
(`(car-safe ,iexp . ,_)
(push iexp envector)
(push `(,fv . (car (internal-get-closed-var ,i))) new-env))
(push `(,fv . (car-safe (internal-get-closed-var ,i))) new-env))
(_
(push exp envector)
(push `(,fv . (internal-get-closed-var ,i)) new-env))))
@ -224,7 +224,7 @@ Returns a form where all lambdas don't have any free variables."
(dolist (arg args)
(if (not (member (cons (list arg) parentform) cconv-captured+mutated))
(if (assq arg new-env) (push `(,arg) new-env))
(push `(,arg . (car ,arg)) new-env)
(push `(,arg . (car-safe ,arg)) new-env)
(push `(,arg (list ,arg)) letbind)))
(setq body-new (mapcar (lambda (form)
@ -254,7 +254,7 @@ ENV is a lexical environment mapping variables to the expression
used to get its value. This is used for variables that are copied into
closures, moved into cons cells, ...
ENV is a list where each entry takes the shape either:
(VAR . (car EXP)): VAR has been moved into the car of a cons-cell, and EXP
(VAR . (car-safe EXP)): VAR has been moved into the car of a cons-cell, and EXP
is an expression that evaluates to this cons-cell.
(VAR . (internal-get-closed-var N)): VAR has been copied into the closure
environment's Nth slot.
@ -320,9 +320,9 @@ places where they originally did not directly appear."
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
(cl-pushnew fv new-extend)
(if (and (eq 'car (car-safe (cdr (assq fv env))))
(if (and (eq 'car-safe (car-safe (cdr (assq fv env))))
(not (memq fv funargs)))
(push `(,fv . (car ,fv)) funcbody-env)))
(push `(,fv . (car-safe ,fv)) funcbody-env)))
`(function (lambda ,funcvars .
,(mapcar (lambda (form)
(cconv-convert
@ -332,7 +332,7 @@ places where they originally did not directly appear."
;; Check if it needs to be turned into a "ref-cell".
((member (cons binder form) cconv-captured+mutated)
;; Declared variable is mutated and captured.
(push `(,var . (car ,var)) new-env)
(push `(,var . (car-safe ,var)) new-env)
`(list ,(cconv-convert value env extend)))
;; Normal default case.
@ -448,7 +448,7 @@ places where they originally did not directly appear."
(value (cconv-convert (pop forms) env extend)))
(push (pcase sym-new
((pred symbolp) `(setq ,sym-new ,value))
(`(car ,iexp) `(setcar ,iexp ,value))
(`(car-safe ,iexp) `(setcar ,iexp ,value))
;; This "should never happen", but for variables which are
;; mutated+captured+unused, we may end up trying to `setq'
;; on a closed-over variable, so just drop the setq.
@ -472,7 +472,7 @@ places where they originally did not directly appear."
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
(pcase exp
(`(car ,iexp . ,_) iexp)
(`(car-safe ,iexp . ,_) iexp)
(_ exp))))
fvs)
,@(mapcar (lambda (arg)
@ -552,7 +552,8 @@ FORM is the parent form that binds this var."
(cond
((byte-compile-not-lexical-var-p arg)
(byte-compile-log-warning
(format "Argument %S is not a lexical variable" arg)))
(format "Lexical argument shadows the dynamic variable %S"
arg)))
((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
(t (let ((varstruct (list arg nil nil nil nil)))
(cl-pushnew arg byte-compile-lexical-variables)

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

@ -2693,15 +2693,16 @@ macro that returns its `&whole' argument."
;;;###autoload
(defmacro cl-defsubst (name args &rest body)
"Define NAME as a function.
Like `defun', except the function is automatically declared `inline',
Like `defun', except the function is automatically declared `inline' and
the arguments are immutable.
ARGLIST allows full Common Lisp conventions, and BODY is implicitly
surrounded by (cl-block NAME ...).
The function's arguments should be treated as immutable.
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(declare (debug cl-defun) (indent 2))
(let* ((argns (cl--arglist-args args)) (p argns)
(pbody (cons 'progn body))
(unsafe (not (cl--safe-expr-p pbody))))
(pbody (cons 'progn body)))
(while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
`(progn
,(if p nil ; give up if defaults refer to earlier args
@ -2717,10 +2718,10 @@ surrounded by (cl-block NAME ...).
;; does not pay attention to the argvs (and
;; cl-expr-access-order itself is also too naive).
nil
,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
,(and (memq '&key args) 'cl-whole) nil ,@argns)))
(cl-defun ,name ,args ,@body))))
(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs)
(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs)
(if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
(if (cl--simple-exprs-p argvs) (setq simple t))
(let* ((substs ())
@ -2728,7 +2729,7 @@ surrounded by (cl-block NAME ...).
(cl-mapcar (lambda (argn argv)
(if (or simple (macroexp-const-p argv))
(progn (push (cons argn argv) substs)
(and unsafe (list argn argv)))
nil)
(list argn argv)))
argns argvs))))
;; FIXME: `sublis/subst' will happily substitute the symbol

60
lisp/emacs-lisp/crm.el
View file

@ -157,33 +157,32 @@ Functions'."
predicate
flag)))
(defun crm--select-current-element ()
(defun crm--current-element ()
"Parse the minibuffer to find the current element.
Place an overlay on the element, with a `field' property, and return it."
(let* ((bob (minibuffer-prompt-end))
(start (save-excursion
Return the element's boundaries as (START . END)."
(let ((bob (minibuffer-prompt-end)))
(cons (save-excursion
(if (re-search-backward crm-separator bob t)
(match-end 0)
bob)))
(end (save-excursion
bob))
(save-excursion
(if (re-search-forward crm-separator nil t)
(match-beginning 0)
(point-max))))
(ol (make-overlay start end nil nil t)))
(overlay-put ol 'field (make-symbol "crm"))
ol))
(point-max))))))
(defmacro crm--completion-command (command)
"Make COMMAND a completion command for `completing-read-multiple'."
`(let ((ol (crm--select-current-element)))
(unwind-protect
,command
(delete-overlay ol))))
(defmacro crm--completion-command (beg end &rest body)
"Run BODY with BEG and END bound to the current element's boundaries."
(declare (indent 2) (debug (sexp sexp &rest body)))
`(let* ((crm--boundaries (crm--current-element))
(,beg (car crm--boundaries))
(,end (cdr crm--boundaries)))
,@body))
(defun crm-completion-help ()
"Display a list of possible completions of the current minibuffer element."
(interactive)
(crm--completion-command (minibuffer-completion-help))
(crm--completion-command beg end
(minibuffer-completion-help beg end))
nil)
(defun crm-complete ()
@ -192,13 +191,18 @@ If no characters can be completed, display a list of possible completions.
Return t if the current element is now a valid match; otherwise return nil."
(interactive)
(crm--completion-command (minibuffer-complete)))
(crm--completion-command beg end
(completion-in-region beg end
minibuffer-completion-table
minibuffer-completion-predicate)))
(defun crm-complete-word ()
"Complete the current element at most a single word.
Like `minibuffer-complete-word' but for `completing-read-multiple'."
(interactive)
(crm--completion-command (minibuffer-complete-word)))
(crm--completion-command beg end
(completion-in-region--single-word
beg end minibuffer-completion-table minibuffer-completion-predicate)))
(defun crm-complete-and-exit ()
"If all of the minibuffer elements are valid completions then exit.
@ -211,16 +215,14 @@ This function is modeled after `minibuffer-complete-and-exit'."
(goto-char (minibuffer-prompt-end))
(while
(and doexit
(let ((ol (crm--select-current-element)))
(goto-char (overlay-end ol))
(unwind-protect
(catch 'exit
(minibuffer-complete-and-exit)
;; This did not throw `exit', so there was a problem.
(setq doexit nil))
(goto-char (overlay-end ol))
(delete-overlay ol))
(not (eobp)))
(crm--completion-command beg end
(let ((end (copy-marker end t)))
(goto-char end)
(setq doexit nil)
(completion-complete-and-exit beg end
(lambda () (setq doexit t)))
(goto-char end)
(not (eobp))))
(looking-at crm-separator))
;; Skip to the next element.
(goto-char (match-end 0)))

7
lisp/emacs-lisp/eldoc.el
View file

@ -185,6 +185,7 @@ expression point is on."
(add-hook 'post-self-insert-hook prn-info nil t)
(remove-hook 'post-self-insert-hook prn-info t))))
;; FIXME: This changes Emacs's behavior when the file is loaded!
(add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode)
;;;###autoload
@ -487,11 +488,11 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(defun eldoc-beginning-of-sexp ()
(let ((parse-sexp-ignore-comments t)
(num-skipped-sexps 0))
(condition-case err
(condition-case _
(progn
;; First account for the case the point is directly over a
;; beginning of a nested sexp.
(condition-case err
(condition-case _
(let ((p (point)))
(forward-sexp -1)
(forward-sexp 1)
@ -518,7 +519,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(let ((defn (and (fboundp fsym)
(symbol-function fsym))))
(and (symbolp defn)
(condition-case err
(condition-case _
(setq defn (indirect-function fsym))
(error (setq defn nil))))
defn))

4
lisp/emacs-lisp/gv.el
View file

@ -102,7 +102,9 @@ DO must return an Elisp expression."
;; Follow aliases.
(setq me (cons (symbol-function head) (cdr place))))
(if (eq me place)
(error "%S is not a valid place expression" place)
(if (and (symbolp head) (get head 'setf-method))
(error "Incompatible place needs recompilation: %S" head)
(error "%S is not a valid place expression" place))
(gv-get me do)))))))
;;;###autoload

73
lisp/emacs-lisp/lisp.el
View file

@ -752,6 +752,57 @@ considered."
(mapcar #'symbol-name (lisp--local-variables))))))
lastvars)))))
;; FIXME: Support for Company brings in features which straddle eldoc.
;; We should consolidate this, so that major modes can provide all that
;; data all at once:
;; - a function to extract "the reference at point" (may be more complex
;; than a mere string, to distinguish various namespaces).
;; - a function to jump to such a reference.
;; - a function to show the signature/interface of such a reference.
;; - a function to build a help-buffer about that reference.
;; FIXME: Those functions should also be used by the normal completion code in
;; the *Completions* buffer.
(defun lisp--company-doc-buffer (str)
(let ((symbol (intern-soft str)))
;; FIXME: we really don't want to "display-buffer and then undo it".
(save-window-excursion
;; Make sure we don't display it in another frame, otherwise
;; save-window-excursion won't be able to undo it.
(let ((display-buffer-overriding-action
'(nil . ((inhibit-switch-frame . t)))))
(ignore-errors
(cond
((fboundp symbol) (describe-function symbol))
((boundp symbol) (describe-variable symbol))
((featurep symbol) (describe-package symbol))
((facep symbol) (describe-face symbol))
(t (signal 'user-error nil)))
(help-buffer))))))
(defun lisp--company-doc-string (str)
(let* ((symbol (intern-soft str))
(doc (if (fboundp symbol)
(documentation symbol t)
(documentation-property symbol 'variable-documentation t))))
(and (stringp doc)
(string-match ".*$" doc)
(match-string 0 doc))))
(declare-function find-library-name "find-func" (library))
(defun lisp--company-location (str)
(let ((sym (intern-soft str)))
(cond
((fboundp sym) (find-definition-noselect sym nil))
((boundp sym) (find-definition-noselect sym 'defvar))
((featurep sym)
(require 'find-func)
(cons (find-file-noselect (find-library-name
(symbol-name sym)))
0))
((facep sym) (find-definition-noselect sym 'defface)))))
(defun lisp-completion-at-point (&optional _predicate)
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
(with-syntax-table emacs-lisp-mode-syntax-table
@ -783,7 +834,10 @@ considered."
lisp--local-variables-completion-table
obarray) ;Could be anything.
:annotation-function
(lambda (str) (if (fboundp (intern-soft str)) " <f>")))
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
:company-doc-buffer #'lisp--company-doc-buffer
:company-docsig #'lisp--company-doc-string
:company-location #'lisp--company-location)
;; Looks like a funcall position. Let's double check.
(save-excursion
(goto-char (1- beg))
@ -800,10 +854,12 @@ considered."
;; we should use something like a symbol-property.
(`declare
(list t (mapcar (lambda (x) (symbol-name (car x)))
(delete-dups
(append
macro-declarations-alist
defun-declarations-alist)))))
(delete-dups
;; FIXME: We should include some
;; docstring with each entry.
(append
macro-declarations-alist
defun-declarations-alist)))))
((and (or `condition-case `condition-case-unless-debug)
(guard (save-excursion
(ignore-errors
@ -811,7 +867,12 @@ considered."
(< (point) beg)))))
(list t obarray
:predicate (lambda (sym) (get sym 'error-conditions))))
(_ (list nil obarray #'fboundp))))))))
(_ (list nil obarray
:predicate #'fboundp
:company-doc-buffer #'lisp--company-doc-buffer
:company-docsig #'lisp--company-doc-string
:company-location #'lisp--company-location
))))))))
(when end
(let ((tail (if (null (car table-etc))
(cdr table-etc)

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

@ -457,19 +457,27 @@ Return the max version (as a string) if the package is held at a lower version."
(defun package-activate-1 (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(pkg-dir (package-desc-dir pkg-desc))
(pkg-dir-dir (file-name-as-directory pkg-dir)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
(package-desc-full-name pkg-desc)))
;; Add to load path, add autoloads, and activate the package.
(let ((old-lp load-path))
(with-demoted-errors
(load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t))
(when (and (eq old-lp load-path)
(not (or (member pkg-dir load-path)
(member pkg-dir-dir load-path))))
;; Old packages don't add themselves to the `load-path', so we have to
;; do it ourselves.
(push pkg-dir load-path)))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
(push pkg-dir Info-directory-list))
;; Add to load path, add autoloads, and activate the package.
(push pkg-dir load-path)
(load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)
(push name package-activated-list)
;; Don't return nil.
t))

71
lisp/epa.el
View file

@ -268,62 +268,40 @@ You should bind this variable with `let', but do not set it globally.")
(epg-sub-key-id (car (epg-key-sub-key-list
(widget-get widget :value))))))
(eval-and-compile
(if (fboundp 'encode-coding-string)
(defalias 'epa--encode-coding-string 'encode-coding-string)
(defalias 'epa--encode-coding-string 'identity)))
(defalias 'epa--encode-coding-string
(if (fboundp 'encode-coding-string) #'encode-coding-string #'identity))
(eval-and-compile
(if (fboundp 'decode-coding-string)
(defalias 'epa--decode-coding-string 'decode-coding-string)
(defalias 'epa--decode-coding-string 'identity)))
(defalias 'epa--decode-coding-string
(if (fboundp 'decode-coding-string) #'decode-coding-string #'identity))
(defun epa-key-list-mode ()
(define-derived-mode epa-key-list-mode special-mode "Keys"
"Major mode for `epa-list-keys'."
(kill-all-local-variables)
(buffer-disable-undo)
(setq major-mode 'epa-key-list-mode
mode-name "Keys"
truncate-lines t
(setq truncate-lines t
buffer-read-only t)
(use-local-map epa-key-list-mode-map)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(epa-font-lock-keywords t))
(setq-local font-lock-defaults '(epa-font-lock-keywords t))
;; In XEmacs, auto-initialization of font-lock is not effective
;; if buffer-file-name is not set.
(font-lock-set-defaults)
(make-local-variable 'epa-exit-buffer-function)
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function 'epa--key-list-revert-buffer)
(run-mode-hooks 'epa-key-list-mode-hook))
(setq-local revert-buffer-function #'epa--key-list-revert-buffer))
(defun epa-key-mode ()
(define-derived-mode epa-key-mode special-mode "Key"
"Major mode for a key description."
(kill-all-local-variables)
(buffer-disable-undo)
(setq major-mode 'epa-key-mode
mode-name "Key"
truncate-lines t
(setq truncate-lines t
buffer-read-only t)
(use-local-map epa-key-mode-map)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(epa-font-lock-keywords t))
(setq-local font-lock-defaults '(epa-font-lock-keywords t))
;; In XEmacs, auto-initialization of font-lock is not effective
;; if buffer-file-name is not set.
(font-lock-set-defaults)
(make-local-variable 'epa-exit-buffer-function)
(run-mode-hooks 'epa-key-mode-hook))
(make-local-variable 'epa-exit-buffer-function))
(defun epa-info-mode ()
(define-derived-mode epa-info-mode special-mode "Info"
"Major mode for `epa-info-buffer'."
(kill-all-local-variables)
(buffer-disable-undo)
(setq major-mode 'epa-info-mode
mode-name "Info"
truncate-lines t
buffer-read-only t)
(use-local-map epa-info-mode-map)
(run-mode-hooks 'epa-info-mode-hook))
(setq truncate-lines t
buffer-read-only t))
(defun epa-mark-key (&optional arg)
"Mark a key on the current line.
@ -951,10 +929,10 @@ See the reason described in the `epa-verify-region' documentation."
(error "No cleartext tail"))
(epa-verify-region cleartext-start cleartext-end))))))
(eval-and-compile
(defalias 'epa--select-safe-coding-system
(if (fboundp 'select-safe-coding-system)
(defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
(defun epa--select-safe-coding-system (_from _to)
#'select-safe-coding-system
(lambda (_from _to)
buffer-file-coding-system)))
;;;###autoload
@ -1026,16 +1004,16 @@ If no one is selected, default secret key is used. "
'start-open t
'end-open t)))))
(eval-and-compile
(defalias 'epa--derived-mode-p
(if (fboundp 'derived-mode-p)
(defalias 'epa--derived-mode-p 'derived-mode-p)
(defun epa--derived-mode-p (&rest modes)
#'derived-mode-p
(lambda (&rest modes)
"Non-nil if the current major mode is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards."
(let ((parent major-mode))
(while (and (not (memq parent modes))
(setq parent (get parent 'derived-mode-parent))))
parent))))
(while (and (not (memq parent modes))
(setq parent (get parent 'derived-mode-parent))))
parent))))
;;;###autoload
(defun epa-encrypt-region (start end recipients sign signers)
@ -1138,6 +1116,7 @@ If no one is selected, symmetric encryption will be performed. ")
(if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string
(epg-context-result-for context 'import))))
;; FIXME: Why not use the (otherwise unused) epa--derived-mode-p?
(if (eq major-mode 'epa-key-list-mode)
(apply #'epa--list-keys epa-list-keys-arguments))))

56
lisp/epg.el
View file

@ -1278,37 +1278,34 @@ This function is for internal use only."
(defun epg--process-filter (process input)
(if epg-debug
(save-excursion
(unless epg-debug-buffer
(setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
(set-buffer epg-debug-buffer)
(with-current-buffer
(or epg-debug-buffer
(setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
(goto-char (point-max))
(insert input)))
(if (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
(goto-char (point-max))
(insert input)
(unless epg-process-filter-running
(unwind-protect
(progn
(setq epg-process-filter-running t)
(goto-char epg-read-point)
(beginning-of-line)
(while (looking-at ".*\n") ;the input line finished
(if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
(let* ((status (match-string 1))
(string (match-string 2))
(symbol (intern-soft (concat "epg--status-"
status))))
(if (member status epg-pending-status-list)
(setq epg-pending-status-list nil))
(if (and symbol
(fboundp symbol))
(funcall symbol epg-context string))
(setq epg-last-status (cons status string))))
(forward-line)
(setq epg-read-point (point))))
(setq epg-process-filter-running nil))))))
(save-excursion
(goto-char (point-max))
(insert input)
(unless epg-process-filter-running
(let ((epg-process-filter-running t))
(goto-char epg-read-point)
(beginning-of-line)
(while (looking-at ".*\n") ;the input line finished
(if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
(let* ((status (match-string 1))
(string (match-string 2))
(symbol (intern-soft (concat "epg--status-"
status))))
(if (member status epg-pending-status-list)
(setq epg-pending-status-list nil))
(if (and symbol
(fboundp symbol))
(funcall symbol epg-context string))
(setq epg-last-status (cons status string))))
(forward-line)
(setq epg-read-point (point)))))))))
(defun epg-read-output (context)
"Read the output file CONTEXT and return the content as a string."
@ -2418,9 +2415,8 @@ If you are unsure, use synchronous version of this function
(list "--" (epg-data-file plain)))))
;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
(unless (eq (epg-context-protocol context) 'CMS)
(if sign
(epg-wait-for-status context '("BEGIN_SIGNING"))
(epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
(epg-wait-for-status context
(if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION"))))
(when (epg-data-string plain)
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)

109
lisp/files.el
View file

@ -2447,48 +2447,43 @@ and `magic-mode-alist', which determines modes based on file contents.")
(mapcar
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
'(("perl" . perl-mode)
("perl5" . perl-mode)
("miniperl" . perl-mode)
("wish" . tcl-mode)
("wishx" . tcl-mode)
("tcl" . tcl-mode)
("tclsh" . tcl-mode)
("expect" . tcl-mode)
("scm" . scheme-mode)
("ash" . sh-mode)
("bash" . sh-mode)
("bash2" . sh-mode)
("csh" . sh-mode)
("dtksh" . sh-mode)
("es" . sh-mode)
("itcsh" . sh-mode)
("jsh" . sh-mode)
("ksh" . sh-mode)
("oash" . sh-mode)
("pdksh" . sh-mode)
("rbash" . sh-mode)
("rc" . sh-mode)
("rpm" . sh-mode)
("sh" . sh-mode)
("sh5" . sh-mode)
("tcsh" . sh-mode)
("wksh" . sh-mode)
("wsh" . sh-mode)
("zsh" . sh-mode)
("tail" . text-mode)
("more" . text-mode)
("less" . text-mode)
("pg" . text-mode)
("make" . makefile-gmake-mode) ; Debian uses this
("guile" . scheme-mode)
("clisp" . lisp-mode)
("emacs" . emacs-lisp-mode)))
'(("\\`\\(mini\\)?perl5?\\'" . perl-mode)
("\\`wishx?\\'" . tcl-mode)
("\\`tcl\\(sh\\)?\\'" . tcl-mode)
("\\`expect\\'" . tcl-mode)
("\\`scm\\'" . scheme-mode)
("\\`[acjkwz]sh\\'" . sh-mode)
("\\`bash2?\\'" . sh-mode)
("\\`dtksh\\'" . sh-mode)
("\\`es\\'" . sh-mode)
("\\`itcsh\\'" . sh-mode)
("\\`oash\\'" . sh-mode)
("\\`pdksh\\'" . sh-mode)
("\\`rbash\\'" . sh-mode)
("\\`rc\\'" . sh-mode)
("\\`rpm\\'" . sh-mode)
("\\`sh5?\\'" . sh-mode)
("\\`tcsh\\'" . sh-mode)
("\\`wksh\\'" . sh-mode)
("\\`tail\\'" . text-mode)
("\\`more\\'" . text-mode)
("\\`less\\'" . text-mode)
("\\`pg\\'" . text-mode)
("\\`make\\'" . makefile-gmake-mode) ; Debian uses this
("\\`guile\\'" . scheme-mode)
("\\`clisp\\'" . lisp-mode)
("\\`emacs\\'" . emacs-lisp-mode)))
"Alist mapping interpreter names to major modes.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
Each element looks like (INTERPRETER . MODE).
If INTERPRETER matches the name of the interpreter specified in the first line
of a script, mode MODE is enabled.
Each element looks like (REGEXP . MODE).
If REGEXP matches the name (minus any directory part) of the interpreter
specified in the first line of a script, enable major mode MODE.
Emacs versions earlier than 24.4 treat the car of each element as a
literal string that must match the entire name, rather than a regexp.
For backwards compatibility, any REGEXP that does not begin with \"\\\\\"
continues to be treated in this way. This behavior may be removed in
future and should not be relied upon.
See also `auto-mode-alist'.")
@ -2683,19 +2678,27 @@ we don't actually set it to the same mode the buffer already has."
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
(unless done
(setq mode (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2)
""))
;; Map interpreter name to a mode, signaling we're done at the
;; same time.
done (assoc (file-name-nondirectory mode)
interpreter-mode-alist))
;; If we found an interpreter mode to use, invoke it now.
(if done
(set-auto-mode-0 (cdr done) keep-mode-if-same)))
(and (not done)
(setq mode (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2))))
;; Map interpreter name to a mode, signaling we're done at the
;; same time.
(setq done (assoc-default
(file-name-nondirectory mode)
;; Backwards compat: if car of i-m-alist does not start
;; with "\\", treat as literal string.
(mapcar (lambda (e)
(if (string-match-p "\\`\\\\" (car e))
e
(cons
(format "\\`%s\\'" (regexp-quote (car e)))
(cdr e))))
interpreter-mode-alist)
#'string-match-p))
;; If we found an interpreter mode to use, invoke it now.
(set-auto-mode-0 done keep-mode-if-same))
;; Next try matching the buffer beginning against magic-mode-alist.
(unless done
(if (setq done (save-excursion

4
lisp/finder.el
View file

@ -225,8 +225,8 @@ from; the default is `load-path'."
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
(save-excursion
(find-file generated-finder-keywords-file)
(with-current-buffer
(find-file-noselect generated-finder-keywords-file)
(setq buffer-undo-list t)
(erase-buffer)
(insert (autoload-rubric generated-finder-keywords-file

7
lisp/frame.el
View file

@ -872,8 +872,11 @@ If there is no frame by that name, signal an error."
"The brightness of the background.
Set this to the symbol `dark' if your background color is dark,
`light' if your background is light, or nil (automatic by default)
if you want Emacs to examine the brightness for you. Don't set this
variable with `setq'; this won't have the expected effect."
if you want Emacs to examine the brightness for you.
If you change this without using customize, you should use
`frame-set-background-mode' to update existing frames;
e.g. (mapc 'frame-set-background-mode (frame-list))."
:group 'faces
:set #'(lambda (var value)
(set-default var value)

24
lisp/generic-x.el
View file

@ -1283,18 +1283,22 @@ like an INI file. You can add this hook to `find-file-hook'."
"WIN32SMINOR")
"Function argument constants used in InstallShield 3 and 5."))
(defvar rul-generic-mode-syntax-table nil
;; c++-mode-syntax-table used to be autoloaded, with an initial nil value.
;; This file did not load cc-mode, and therefore rul-generic-mode-syntax-table
;; would have different values according to whether or not cc-mode
;; happened to be loaded before this file was.
(require 'cc-mode)
(defvar c++-mode-syntax-table)
(defvar rul-generic-mode-syntax-table
(let ((table (make-syntax-table c++-mode-syntax-table)))
(modify-syntax-entry ?\r "> b" table)
(modify-syntax-entry ?\n "> b" table)
(modify-syntax-entry ?/ ". 124b" table)
(modify-syntax-entry ?* ". 23" table)
table)
"Syntax table to use in `rul-generic-mode' buffers.")
(setq rul-generic-mode-syntax-table
(make-syntax-table c++-mode-syntax-table))
(modify-syntax-entry ?\r "> b" rul-generic-mode-syntax-table)
(modify-syntax-entry ?\n "> b" rul-generic-mode-syntax-table)
(modify-syntax-entry ?/ ". 124b" rul-generic-mode-syntax-table)
(modify-syntax-entry ?* ". 23" rul-generic-mode-syntax-table)
;; here manually instead
(defun generic-rul-mode-setup-function ()
(make-local-variable 'parse-sexp-ignore-comments)

4
lisp/gnus/ChangeLog
View file

@ -1,3 +1,7 @@
2013-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-temp-files-delete): Fix file deletion logic.
2013-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-util.el (mm-coding-system-priorities): Exclude iso-2022-jp-2 and

22
lisp/gnus/mm-decode.el
View file

@ -607,19 +607,19 @@ files left at the next time."
(split-string (buffer-string) "\n" t))))
fails)
(dolist (temp (append cache mm-temp-files-to-be-deleted))
(unless (and (file-exists-p temp)
(if (file-directory-p temp)
;; A parent directory left at the previous time.
(when (and (file-exists-p temp)
(if (file-directory-p temp)
;; A parent directory left at the previous time.
(progn
(ignore-errors (delete-directory temp))
(file-exists-p temp))
;; Delete a temporary file and its parent directory.
(ignore-errors (delete-file temp))
(or (file-exists-p temp)
(progn
(setq temp (file-name-directory temp))
(ignore-errors (delete-directory temp))
(not (file-exists-p temp)))
;; Delete a temporary file and its parent directory.
(ignore-errors (delete-file temp))
(and (not (file-exists-p temp))
(progn
(setq temp (file-name-directory temp))
(ignore-errors (delete-directory temp))
(not (file-exists-p temp))))))
(file-exists-p temp)))))
(push temp fails)))
(if fails
;; Schedule the deletion of the files left at the next time.

24
lisp/icomplete.el
View file

@ -158,11 +158,13 @@ minibuffer completion.")
(add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
;;;_ = icomplete-with-completion-tables
(defvar icomplete-with-completion-tables '(internal-complete-buffer)
(defcustom icomplete-with-completion-tables t
"Specialized completion tables with which icomplete should operate.
Icomplete does not operate with any specialized completion tables
except those on this list.")
except those on this list."
:type '(choice (const :tag "All" t)
(repeat function)))
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
@ -177,24 +179,28 @@ except those on this list.")
Second entry becomes the first and can be selected with
`minibuffer-force-complete-and-exit'."
(interactive)
(let* ((comps (completion-all-sorted-completions))
(let* ((beg (minibuffer-prompt-end))
(end (point-max))
(comps (completion-all-sorted-completions beg end))
(last (last comps)))
(when comps
(setcdr last (cons (car comps) (cdr last)))
(completion--cache-all-sorted-completions (cdr comps)))))
(completion--cache-all-sorted-completions beg end (cdr comps)))))
(defun icomplete-backward-completions ()
"Step backward completions by one entry.
Last entry becomes the first and can be selected with
`minibuffer-force-complete-and-exit'."
(interactive)
(let* ((comps (completion-all-sorted-completions))
(let* ((beg (minibuffer-prompt-end))
(end (point-max))
(comps (completion-all-sorted-completions beg end))
(last-but-one (last comps 2))
(last (cdr last-but-one)))
(when (consp last) ; At least two elements in comps
(setcdr last-but-one (cdr last))
(push (car last) comps)
(completion--cache-all-sorted-completions comps))))
(completion--cache-all-sorted-completions beg end comps))))
;;;_ > icomplete-mode (&optional prefix)
;;;###autoload
@ -263,7 +269,8 @@ and `minibuffer-setup-hook'."
"Insert icomplete completions display.
Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
and `minibuffer-setup-hook'."
(when (and icomplete-mode (icomplete-simple-completing-p))
(when (and icomplete-mode
(icomplete-simple-completing-p)) ;Shouldn't be necessary.
(save-excursion
(goto-char (point-max))
; Insert the match-status information:
@ -319,7 +326,8 @@ matches exist. \(Keybindings for uniquely matched commands
are exhibited within the square braces.)"
(let* ((md (completion--field-metadata (field-beginning)))
(comps (completion-all-sorted-completions))
(comps (completion-all-sorted-completions
(minibuffer-prompt-end) (point-max)))
(last (if (consp comps) (last comps)))
(base-size (cdr last))
(open-bracket (if require-match "(" "["))

11
lisp/info.el
View file

@ -1595,17 +1595,20 @@ escaped (\\\",\\\\)."
""))
(image (if (file-exists-p image-file)
(create-image image-file)
"[broken image]")))
(or (cdr (assoc-string "text" parameter-alist))
(and src (concat "[broken image:" src "]"))
"[broken image]"))))
(if (not (get-text-property start 'display))
(add-text-properties
start (point) `(display ,image rear-nonsticky (display)))))
start (point)
`(display ,image rear-nonsticky (display)
help-echo ,(cdr (assoc-string "alt" parameter-alist))))))
;; text-only display, show alternative text if provided, or
;; otherwise a clue that there's meant to be a picture
(delete-region start (point))
(insert (or (cdr (assoc-string "text" parameter-alist))
(cdr (assoc-string "alt" parameter-alist))
(and src
(concat "[image:" src "]"))
(and src (concat "[image:" src "]"))
"[image]"))))))
(set-buffer-modified-p nil)))

2
lisp/international/characters.el
View file

@ -792,7 +792,7 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Combining diacritics
(modify-category-entry '(#x300 . #x362) ?^)
;; Combining marks
(modify-category-entry '(#x20d0 . #x20e3) ?^)
(modify-category-entry '(#x20d0 . #x20ff) ?^)
;; Fixme: syntax for symbols &c
)

68
lisp/international/mule-cmds.el
View file

@ -30,6 +30,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
@ -548,7 +550,7 @@ Emacs, but is unlikely to be what you really want now."
(coding-system-charset-list cs)))
(charsets charsets))
(if (coding-system-get cs :ascii-compatible-p)
(add-to-list 'cs-charsets 'ascii))
(cl-pushnew 'ascii cs-charsets))
(if (catch 'ok
(when cs-charsets
(while charsets
@ -636,6 +638,36 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see). This variable
overrides that argument.")
(defun sanitize-coding-system-list (codings)
"Return a list of coding systems presumably more user-friendly than CODINGS."
;; Change each safe coding system to the corresponding
;; mime-charset name if it is also a coding system. Such a name
;; is more friendly to users.
(setq codings
(mapcar (lambda (cs)
(let ((mime-charset (coding-system-get cs 'mime-charset)))
(if (and mime-charset (coding-system-p mime-charset)
(coding-system-equal cs mime-charset))
mime-charset cs)))
codings))
;; Don't offer variations with locking shift, which you
;; basically never want.
(let (l)
(dolist (elt codings (setq codings (nreverse l)))
(unless (or (eq 'coding-category-iso-7-else
(coding-system-category elt))
(eq 'coding-category-iso-8-else
(coding-system-category elt)))
(push elt l))))
;; Remove raw-text, emacs-mule and no-conversion unless nothing
;; else is available.
(or (delq 'raw-text
(delq 'emacs-mule
(delq 'no-conversion (copy-sequence codings))))
codings))
(defun select-safe-coding-system-interactively (from to codings unsafe
&optional rejected default)
"Select interactively a coding system for the region FROM ... TO.
@ -667,35 +699,7 @@ DEFAULT is the coding system to use by default in the query."
from to coding 11)))))
unsafe)))
;; Change each safe coding system to the corresponding
;; mime-charset name if it is also a coding system. Such a name
;; is more friendly to users.
(let ((l codings)
mime-charset)
(while l
(setq mime-charset (coding-system-get (car l) :mime-charset))
(if (and mime-charset (coding-system-p mime-charset)
(coding-system-equal (car l) mime-charset))
(setcar l mime-charset))
(setq l (cdr l))))
;; Don't offer variations with locking shift, which you
;; basically never want.
(let (l)
(dolist (elt codings (setq codings (nreverse l)))
(unless (or (eq 'coding-category-iso-7-else
(coding-system-category elt))
(eq 'coding-category-iso-8-else
(coding-system-category elt)))
(push elt l))))
;; Remove raw-text, emacs-mule and no-conversion unless nothing
;; else is available.
(setq codings
(or (delq 'raw-text
(delq 'emacs-mule
(delq 'no-conversion codings)))
'(raw-text emacs-mule no-conversion)))
(setq codings (sanitize-coding-system-list codings))
(let ((window-configuration (current-window-configuration))
(bufname (buffer-name))
@ -1421,7 +1425,9 @@ The return value is a string."
;; buffer local.
(input-method (completing-read prompt input-method-alist
nil t nil 'input-method-history
default)))
(if (and default (symbolp default))
(symbol-name default)
default))))
(if (and input-method (symbolp input-method))
(setq input-method (symbol-name input-method)))
(if (> (length input-method) 0)

30
lisp/isearch.el
View file

@ -2249,7 +2249,9 @@ the bottom."
Return the key sequence as a string/vector."
(isearch-unread-key-sequence keylist)
(let (overriding-terminal-local-map)
(read-key-sequence nil))) ; This will go through function-key-map, if nec.
;; This will go through function-key-map, if nec.
;; The arg DONT-DOWNCASE-LAST prevents premature shift-translation.
(read-key-sequence nil nil t)))
(defun isearch-lookup-scroll-key (key-seq)
"If KEY-SEQ is bound to a scrolling command, return it as a symbol.
@ -2307,6 +2309,16 @@ Isearch mode."
(lookup-key local-function-key-map key)))
(while keylist
(setq key (car keylist))
;; Handle an undefined shifted printing character
;; by downshifting it if that makes it printing.
;; (As read-key-sequence would normally do,
;; if we didn't have a default definition.)
(if (and (integerp key)
(memq 'shift (event-modifiers key))
(>= key (+ ?\s (- ?\S-a ?a)))
(/= key (+ 127 (- ?\S-a ?a)))
(< key (+ 256 (- ?\S-a ?a))))
(setq key (- key (- ?\S-a ?a))))
;; If KEY is a printing char, we handle it here
;; directly to avoid the input method and keyboard
;; coding system translating it.
@ -2784,10 +2796,18 @@ update the match data, and return point."
(invalid-regexp
(setq isearch-error (car (cdr lossage)))
(if (string-match
"\\`Premature \\|\\`Unmatched \\|\\`Invalid "
isearch-error)
(setq isearch-error "incomplete input")))
(cond
((string-match
"\\`Premature \\|\\`Unmatched \\|\\`Invalid "
isearch-error)
(setq isearch-error "incomplete input"))
((and (not isearch-regexp)
(string-match "\\`Regular expression too big" isearch-error))
(cond
(isearch-word
(setq isearch-error "Too many words"))
((and isearch-lax-whitespace search-whitespace-regexp)
(setq isearch-error "Too many spaces for whitespace matching"))))))
(search-failed
(setq isearch-success nil)

1338
lisp/ldefs-boot.el
View file

File diff suppressed because it is too large Load diff

223
lisp/minibuffer.el
View file

@ -38,7 +38,7 @@
;;; Bugs:
;; - completion-all-sorted-completions list all the completions, whereas
;; - completion-all-sorted-completions lists all the completions, whereas
;; it should only lists the ones that `try-completion' would consider.
;; E.g. it should honor completion-ignored-extensions.
;; - choose-completion can't automatically figure out the boundaries
@ -145,7 +145,7 @@ Like CL's `some'."
(let ((firsterror nil)
res)
(while (and (not res) xs)
(condition-case err
(condition-case-unless-debug err
(setq res (funcall fun (pop xs)))
(error (unless firsterror (setq firsterror err)) nil)))
(or res
@ -623,7 +623,8 @@ If ARGS are provided, then pass MESSAGE through `format'."
(message nil)))
;; Clear out any old echo-area message to make way for our new thing.
(message nil)
(setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
(setq message (if (and (null args)
(string-match-p "\\` *\\[.+\\]\\'" message))
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
@ -651,7 +652,7 @@ If ARGS are provided, then pass MESSAGE through `format'."
"Return the user input in a minibuffer before point as a string.
In Emacs-22, that was what completion commands operated on."
(declare (obsolete nil "24.4"))
(buffer-substring (field-beginning) (point)))
(buffer-substring (minibuffer-prompt-end) (point)))
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
@ -670,8 +671,7 @@ If the value is t the *Completion* buffer is displayed whenever completion
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
the second failed attempt to complete."
:type '(choice (const nil) (const t) (const lazy))
:group 'minibuffer)
:type '(choice (const nil) (const t) (const lazy)))
(defconst completion-styles-alist
'((emacs21
@ -750,7 +750,6 @@ The available styles are listed in `completion-styles-alist'.
Note that `completion-category-overrides' may override these
styles for specific categories, such as files, buffers, etc."
:type completion--styles-type
:group 'minibuffer
:version "23.1")
(defcustom completion-category-overrides
@ -880,7 +879,7 @@ Moves point to the end of the new text."
(defcustom completion-cycle-threshold nil
"Number of completion candidates below which cycling is used.
Depending on this setting `minibuffer-complete' may use cycling,
Depending on this setting `completion-in-region' may use cycling,
like `minibuffer-force-complete'.
If nil, cycling is never used.
If t, cycling is always used.
@ -894,8 +893,7 @@ completion candidates than this number."
(over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
(if over (cdr over) completion-cycle-threshold)))
(defvar completion-all-sorted-completions nil)
(make-variable-buffer-local 'completion-all-sorted-completions)
(defvar-local completion-all-sorted-completions nil)
(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil)
@ -906,8 +904,8 @@ completion candidates than this number."
(if completion-show-inline-help
(minibuffer-message msg)))
(defun completion--do-completion (&optional try-completion-function
expect-exact)
(defun completion--do-completion (beg end &optional
try-completion-function expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
@ -926,9 +924,7 @@ E = after completion we now have an Exact match.
TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
EXPECT-EXACT, if non-nil, means that there is no need to tell the user
when the buffer's text is already an exact match."
(let* ((beg (field-beginning))
(end (field-end))
(string (buffer-substring beg end))
(let* ((string (buffer-substring beg end))
(md (completion--field-metadata beg))
(comp (funcall (or try-completion-function
'completion-try-completion)
@ -963,7 +959,8 @@ when the buffer's text is already an exact match."
(if unchanged
(goto-char end)
;; Insert in minibuffer the chars we got.
(completion--replace beg end completion))
(completion--replace beg end completion)
(setq end (+ beg (length completion))))
;; Move point to its completion-mandated destination.
(forward-char (- comp-pos (length completion)))
@ -972,7 +969,8 @@ when the buffer's text is already an exact match."
;; whether this is a unique completion or not, so try again using
;; the real case (this shouldn't recurse again, because the next
;; time try-completion will return either t or the exact string).
(completion--do-completion try-completion-function expect-exact)
(completion--do-completion beg end
try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
(let* ((exact (test-completion completion
@ -995,7 +993,7 @@ when the buffer's text is already an exact match."
minibuffer-completion-predicate
""))
comp-pos)))
(completion-all-sorted-completions))))
(completion-all-sorted-completions beg end))))
(completion--flush-all-sorted-completions)
(cond
((and (consp (cdr comps)) ;; There's something to cycle.
@ -1006,8 +1004,8 @@ when the buffer's text is already an exact match."
;; Not more than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
(completion--cache-all-sorted-completions comps)
(minibuffer-force-complete))
(completion--cache-all-sorted-completions beg end comps)
(minibuffer-force-complete beg end))
(completed
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
@ -1024,14 +1022,14 @@ when the buffer's text is already an exact match."
(if (pcase completion-auto-help
(`lazy (eq this-command last-command))
(_ completion-auto-help))
(minibuffer-completion-help)
(minibuffer-completion-help beg end)
(completion--message "Next char not unique")))
;; If the last exact completion and this one were the same, it
;; means we've already given a "Complete, but not unique" message
;; and the user's hit TAB again, so now we give him help.
(t
(if (and (eq this-command last-command) completion-auto-help)
(minibuffer-completion-help))
(minibuffer-completion-help beg end))
(completion--done completion 'exact
(unless expect-exact
"Complete, but not unique"))))
@ -1045,6 +1043,11 @@ If no characters can be completed, display a list of possible completions.
If you repeat this command after it displayed such a list,
scroll the window of possible completions."
(interactive)
(completion-in-region (minibuffer-prompt-end) (point-max)
minibuffer-completion-table
minibuffer-completion-predicate))
(defun completion--in-region-1 (beg end)
;; If the previous command was not this,
;; mark the completion buffer obsolete.
(setq this-command 'completion-at-point)
@ -1067,17 +1070,17 @@ scroll the window of possible completions."
nil)))
;; If we're cycling, keep on cycling.
((and completion-cycling completion-all-sorted-completions)
(minibuffer-force-complete)
(minibuffer-force-complete beg end)
t)
(t (pcase (completion--do-completion)
(t (pcase (completion--do-completion beg end)
(#b000 nil)
(_ t)))))
(defun completion--cache-all-sorted-completions (comps)
(defun completion--cache-all-sorted-completions (beg end comps)
(add-hook 'after-change-functions
'completion--flush-all-sorted-completions nil t)
(setq completion--all-sorted-completions-location
(cons (copy-marker (field-beginning)) (copy-marker (field-end))))
(cons (copy-marker beg) (copy-marker end)))
(setq completion-all-sorted-completions comps))
(defun completion--flush-all-sorted-completions (&optional start end _len)
@ -1097,10 +1100,10 @@ scroll the window of possible completions."
(if (eq (car bounds) base) md-at-point
(completion-metadata (substring string 0 base) table pred))))
(defun completion-all-sorted-completions ()
(defun completion-all-sorted-completions (start end)
(or completion-all-sorted-completions
(let* ((start (field-beginning))
(end (field-end))
(let* ((start (or start (minibuffer-prompt-end)))
(end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
(all (completion-all-completions
@ -1138,18 +1141,20 @@ scroll the window of possible completions."
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
(completion--cache-all-sorted-completions (nconc all base-size))))))
(completion--cache-all-sorted-completions
start end (nconc all base-size))))))
(defun minibuffer-force-complete-and-exit ()
"Complete the minibuffer with first of the matches and exit."
(interactive)
(minibuffer-force-complete)
(minibuffer--complete-and-exit
(completion--complete-and-exit
(minibuffer-prompt-end) (point-max) #'exit-minibuffer
;; If the previous completion completed to an element which fails
;; test-completion, then we shouldn't exit, but that should be rare.
(lambda () (minibuffer-message "Incomplete"))))
(defun minibuffer-force-complete ()
(defun minibuffer-force-complete (&optional start end)
"Complete the minibuffer to an exact match.
Repeated uses step through the possible completions."
(interactive)
@ -1157,10 +1162,10 @@ Repeated uses step through the possible completions."
;; FIXME: Need to deal with the extra-size issue here as well.
;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
(let* ((start (copy-marker (field-beginning)))
(end (field-end))
(let* ((start (copy-marker (or start (minibuffer-prompt-end))))
(end (or end (point-max)))
;; (md (completion--field-metadata start))
(all (completion-all-sorted-completions))
(all (completion-all-sorted-completions start end))
(base (+ start (or (cdr (last all)) 0))))
(cond
((not (consp all))
@ -1173,10 +1178,11 @@ Repeated uses step through the possible completions."
'finished (when done "Sole completion"))))
(t
(completion--replace base end (car all))
(setq end (+ base (length (car all))))
(completion--done (buffer-substring-no-properties start (point)) 'sole)
;; Set cycling after modifying the buffer since the flush hook resets it.
(setq completion-cycling t)
(setq this-command 'completion-at-point) ;For minibuffer-complete.
(setq this-command 'completion-at-point) ;For completion-in-region.
;; If completing file names, (car all) may be a directory, so we'd now
;; have a new set of possible completions and might want to reset
;; completion-all-sorted-completions to nil, but we prefer not to,
@ -1184,7 +1190,7 @@ Repeated uses step through the possible completions."
;; through the previous possible completions.
(let ((last (last all)))
(setcdr last (cons (car all) (cdr last)))
(completion--cache-all-sorted-completions (cdr all)))
(completion--cache-all-sorted-completions start end (cdr all)))
;; Make sure repeated uses cycle, even though completion--done might
;; have added a space or something that moved us outside of the field.
;; (bug#12221).
@ -1223,27 +1229,32 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
`minibuffer-confirm-exit-commands', and accept the input
otherwise."
(interactive)
(minibuffer--complete-and-exit
(completion-complete-and-exit (minibuffer-prompt-end) (point-max)
#'exit-minibuffer))
(defun completion-complete-and-exit (beg end exit-function)
(completion--complete-and-exit
beg end exit-function
(lambda ()
(pcase (condition-case nil
(completion--do-completion nil 'expect-exact)
(completion--do-completion beg end
nil 'expect-exact)
(error 1))
((or #b001 #b011) (exit-minibuffer))
((or #b001 #b011) (funcall exit-function))
(#b111 (if (not minibuffer-completion-confirm)
(exit-minibuffer)
(funcall exit-function)
(minibuffer-message "Confirm")
nil))
(_ nil)))))
(defun minibuffer--complete-and-exit (completion-function)
(defun completion--complete-and-exit (beg end
exit-function completion-function)
"Exit from `require-match' minibuffer.
COMPLETION-FUNCTION is called if the current buffer's content does not
appear to be a match."
(let ((beg (field-beginning))
(end (field-end)))
(cond
;; Allow user to specify null string
((= beg end) (exit-minibuffer))
((= beg end) (funcall exit-function))
((test-completion (buffer-substring beg end)
minibuffer-completion-table
minibuffer-completion-predicate)
@ -1269,7 +1280,7 @@ appear to be a match."
;; that file.
(= (length string) (length compl)))
(completion--replace beg end compl))))
(exit-minibuffer))
(funcall exit-function))
((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
;; The user is permitted to exit with an input that's rejected
@ -1280,13 +1291,13 @@ appear to be a match."
;; catches most minibuffer typos).
(and (eq minibuffer-completion-confirm 'confirm-after-completion)
(not (memq last-command minibuffer-confirm-exit-commands))))
(exit-minibuffer)
(funcall exit-function)
(minibuffer-message "Confirm")
nil))
(t
;; Call do-completion, but ignore errors.
(funcall completion-function)))))
(funcall completion-function))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
@ -1381,9 +1392,18 @@ After one word is completed as much as possible, a space or hyphen
is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
(pcase (completion--do-completion 'completion--try-word-completion)
(completion-in-region--single-word
(minibuffer-prompt-end) (point-max)
minibuffer-completion-table minibuffer-completion-predicate))
(defun completion-in-region--single-word (beg end collection
&optional predicate)
(let ((minibuffer-completion-table collection)
(minibuffer-completion-predicate predicate))
(pcase (completion--do-completion beg end
#'completion--try-word-completion)
(#b000 nil)
(_ t)))
(_ t))))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
@ -1395,7 +1415,6 @@ in columns in the *Completions* buffer.
If the value is `horizontal', display completions sorted
horizontally in alphabetical order, rather than down the screen."
:type '(choice (const horizontal) (const vertical))
:group 'minibuffer
:version "23.2")
(defun completion--insert-strings (strings)
@ -1504,15 +1523,13 @@ See also `display-completion-list'.")
(defface completions-first-difference
'((t (:inherit bold)))
"Face added on the first uncommon character in completions in *Completions* buffer."
:group 'completion)
"Face added on the first uncommon character in completions in *Completions* buffer.")
(defface completions-common-part '((t nil))
"Face added on the common prefix substring in completions in *Completions* buffer.
The idea of `completions-common-part' is that you can use it to
make the common parts less visible than normal, so that the rest
of the differing parts is, by contrast, slightly highlighted."
:group 'completion)
of the differing parts is, by contrast, slightly highlighted.")
(defun completion-hilit-commonality (completions prefix-len base-size)
(when completions
@ -1555,12 +1572,8 @@ alternative, the second serves as annotation.
The actual completion alternatives, as inserted, are given `mouse-face'
properties of `highlight'.
At the end, this runs the normal hook `completion-setup-hook'.
It can find the completion buffer in `standard-output'.
The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string
specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
the completions buffer."
It can find the completion buffer in `standard-output'."
(declare (advertised-calling-convention (completions) "24.4"))
(if common-substring
(setq completions (completion-hilit-commonality
completions (length common-substring)
@ -1647,19 +1660,19 @@ variables.")
(equal pre-msg (and exit-fun (current-message))))
(completion--message message))))
(defun minibuffer-completion-help ()
(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
(interactive)
(message "Making completion list...")
(let* ((start (field-beginning))
(end (field-end))
(string (field-string))
(let* ((start (or start (minibuffer-prompt-end)))
(end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
(completions (completion-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
(- (point) (field-beginning))
(- (point) start)
md)))
(message nil)
(if (or (null completions)
@ -1811,7 +1824,6 @@ exit."
(if (memq system-type '(ms-dos windows-nt darwin cygwin))
t nil)
"Non-nil means when reading a file name completion ignores case."
:group 'minibuffer
:type 'boolean
:version "22.1")
@ -1821,22 +1833,15 @@ exit."
;; completions" operation as well.
completion-in-region-functions (start end collection predicate)
(let ((minibuffer-completion-table collection)
(minibuffer-completion-predicate predicate)
(ol (make-overlay start end nil nil t)))
(overlay-put ol 'field 'completion)
(minibuffer-completion-predicate predicate))
;; HACK: if the text we are completing is already in a field, we
;; want the completion field to take priority (e.g. Bug#6830).
(overlay-put ol 'priority 100)
(when completion-in-region-mode-predicate
(completion-in-region-mode 1)
(setq completion-in-region--data
(list (if (markerp start) start (copy-marker start))
(copy-marker end) collection)))
;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
;; than the other way around!
(unwind-protect
(call-interactively 'minibuffer-complete)
(delete-overlay ol)))))
(completion--in-region-1 start end))))
(defvar completion-in-region-mode-map
(let ((map (make-sparse-keymap)))
@ -2001,19 +2006,14 @@ The completion method is determined by `completion-at-point-functions'."
(lambda ()
;; We're still in the same completion field.
(let ((newstart (car-safe (funcall hookfun))))
(and newstart (= newstart start)))))
(ol (make-overlay start end nil nil t)))
(and newstart (= newstart start))))))
;; FIXME: We should somehow (ab)use completion-in-region-function or
;; introduce a corresponding hook (plus another for word-completion,
;; and another for force-completion, maybe?).
(overlay-put ol 'field 'completion)
(overlay-put ol 'priority 100)
(completion-in-region-mode 1)
(setq completion-in-region--data
(list start (copy-marker end) collection))
(unwind-protect
(call-interactively 'minibuffer-completion-help)
(delete-overlay ol))))
(minibuffer-completion-help start end)))
(`(,hookfun . ,_)
;; The hook function already performed completion :-(
;; Not much we can do at this point.
@ -2308,7 +2308,6 @@ the minibuffer empty.
For some commands, exiting with an empty minibuffer has a special meaning,
such as making the current buffer visit no file in the case of
`set-visited-file-name'."
:group 'minibuffer
:type 'boolean)
;; Not always defined, but only called if next-read-file-uses-dialog-p says so.
@ -2701,7 +2700,6 @@ expression (not containing character ranges like `a-z')."
;; Refresh other vars.
(completion-pcm--prepare-delim-re value))
:initialize 'custom-initialize-reset
:group 'minibuffer
:type 'string)
(defcustom completion-pcm-complete-word-inserts-delimiters nil
@ -2734,7 +2732,8 @@ or a symbol, see `completion-pcm--merge-completions'."
(completion-pcm--string->pattern suffix)))
(let* ((pattern nil)
(p 0)
(p0 p))
(p0 p)
(pending nil))
(while (and (setq p (string-match completion-pcm--delim-wild-regex
string p))
@ -2751,18 +2750,49 @@ or a symbol, see `completion-pcm--merge-completions'."
;; This is determined by the presence of a submatch-1 which delimits
;; the prefix.
(if (match-end 1) (setq p (match-end 1)))
(push (substring string p0 p) pattern)
(unless (= p0 p)
(if pending (push pending pattern))
(push (substring string p0 p) pattern))
(setq pending nil)
(if (eq (aref string p) ?*)
(progn
(push 'star pattern)
(setq p0 (1+ p)))
(push 'any pattern)
(setq p0 p))
(cl-incf p))
(if (match-end 1)
(setq p0 p)
(push (substring string p (match-end 0)) pattern)
;; `any-delim' is used so that "a-b" also finds "array->beginning".
(setq pending 'any-delim)
(setq p0 (match-end 0))))
(setq p p0))
(when (> (length string) p0)
(if pending (push pending pattern))
(push (substring string p0) pattern))
;; An empty string might be erroneously added at the beginning.
;; It should be avoided properly, but it's so easy to remove it here.
(delete "" (nreverse (cons (substring string p0) pattern))))))
(delete "" (nreverse pattern)))))
(defun completion-pcm--optimize-pattern (p)
;; Remove empty strings in a separate phase since otherwise a ""
;; might prevent some other optimization, as in '(any "" any).
(setq p (delete "" p))
(let ((n '()))
(while p
(pcase p
(`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest)
(setq p (cons (concat s1 s2) rest)))
(`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_)
(setq p (cdr p)))
(`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest)))
(`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest)))
(`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest)))
(`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest)))
(`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest)))
(`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
(_ (push (pop p) n))))
(nreverse n)))
(defun completion-pcm--pattern->regex (pattern &optional group)
(let ((re
@ -2771,8 +2801,13 @@ or a symbol, see `completion-pcm--merge-completions'."
(lambda (x)
(cond
((stringp x) (regexp-quote x))
((if (consp group) (memq x group) group) "\\(.*?\\)")
(t ".*?")))
(t
(let ((re (if (eq x 'any-delim)
(concat completion-pcm--delim-wild-regex "*?")
".*?")))
(if (if (consp group) (memq x group) group)
(concat "\\(" re "\\)")
re)))))
pattern
""))))
;; Avoid pathological backtracking.
@ -2846,11 +2881,11 @@ filter out additional entries (because TABLE might not obey PRED)."
(setq string (substring string (car bounds) (+ point (cdr bounds))))
(let* ((relpoint (- point (car bounds)))
(pattern (completion-pcm--string->pattern string relpoint))
(all (condition-case err
(all (condition-case-unless-debug err
(funcall filter
(completion-pcm--all-completions
prefix pattern table pred))
(error (unless firsterror (setq firsterror err)) nil))))
(error (setq firsterror err) nil))))
(when (and (null all)
(> (car bounds) 0)
(null (ignore-errors (try-completion prefix table pred))))

17
lisp/net/ange-ftp.el
View file

@ -3733,7 +3733,7 @@ so return the size on the remote host exactly. See RFC 3659."
;; next part of copying routine.
(defun ange-ftp-cf1 (result line
filename newname binary msg
f-parsed f-host f-user f-name f-abbr
f-parsed f-host f-user _f-name f-abbr
t-parsed t-host t-user t-name t-abbr
temp1 temp2 cont nowait)
(if line
@ -3835,7 +3835,7 @@ so return the size on the remote host exactly. See RFC 3659."
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
keep-date preserve-uid-gid
preserve-selinux-context)
_preserve-selinux-context)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
@ -4200,7 +4200,7 @@ directory, so that Emacs will know its current contents."
(while (and tryfiles (not copy))
(catch 'ftp-error
(let ((ange-ftp-waiting-flag t))
(condition-case error
(condition-case _error
(setq copy (ange-ftp-file-local-copy (car tryfiles)))
(ftp-error nil))))
(setq tryfiles (cdr tryfiles)))
@ -4214,7 +4214,7 @@ directory, so that Emacs will know its current contents."
(ange-ftp-real-load file noerror nomessage nosuffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(defun ange-ftp-unhandled-file-name-directory (filename)
(defun ange-ftp-unhandled-file-name-directory (_filename)
nil)
@ -4605,7 +4605,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
(let* ((parsed (ange-ftp-ftp-name default-directory))
(host (nth 0 parsed))
(user (nth 1 parsed))
(name (nth 2 parsed)))
(if (not parsed)
(ange-ftp-real-shell-command command output-buffer error-buffer)
@ -5176,7 +5175,7 @@ Other orders of $ and _ seem to all work just fine.")
;; versions left. If not, then delete the
;; root entry.
(maphash
(lambda (key val)
(lambda (key _val)
(and (string-match regexp key)
(setq versions t)))
files)
@ -5358,7 +5357,7 @@ Other orders of $ and _ seem to all work just fine.")
;; compressed files. Instead, we turn "FILE.TYPE" into
;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
(defun ange-ftp-vms-make-compressed-filename (name &optional _reverse)
(cond
((string-match "-Z;[0-9]+\\'" name)
(list nil (substring name 0 (match-beginning 0))))
@ -5399,7 +5398,7 @@ Other orders of $ and _ seem to all work just fine.")
;; (cons '(vms . ange-ftp-dired-vms-ls-trim)
;; ange-ftp-dired-ls-trim-alist)))
(defun ange-ftp-vms-sans-version (name &rest args)
(defun ange-ftp-vms-sans-version (name &rest _args)
(save-match-data
(if (string-match ";[0-9]+\\'" name)
(substring name 0 (match-beginning 0))
@ -5920,7 +5919,7 @@ Other orders of $ and _ seem to all work just fine.")
;; (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
;; ange-ftp-dired-move-to-end-of-filename-alist)))
(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
(defun ange-ftp-cms-make-compressed-filename (name &optional _reverse)
(if (string-match "-Z\\'" name)
(list nil (substring name 0 -2))
(list t (concat name "-Z"))))

20
lisp/net/browse-url.el
View file

@ -877,7 +877,7 @@ to use."
(defvar dos-windows-version)
(declare-function w32-shell-execute "w32fns.c") ;; Defined in C.
(defun browse-url-default-windows-browser (url &optional new-window)
(defun browse-url-default-windows-browser (url &optional _new-window)
(interactive (browse-url-interactive-arg "URL: "))
(cond ((eq system-type 'ms-dos)
(if dos-windows-version
@ -887,7 +887,7 @@ to use."
(call-process "cygstart" nil nil nil url))
(t (w32-shell-execute "open" url))))
(defun browse-url-default-macosx-browser (url &optional new-window)
(defun browse-url-default-macosx-browser (url &optional _new-window)
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
@ -942,7 +942,7 @@ used instead of `browse-url-new-window-flag'."
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
(t
(lambda (&rest ignore) (error "No usable browser found"))))
(lambda (&rest _ignore) (error "No usable browser found"))))
url args))
(defun browse-url-can-use-xdg-open ()
@ -1172,7 +1172,7 @@ URL in a new window."
(append browse-url-firefox-startup-arguments (list url))))))
;;;###autoload
(defun browse-url-chromium (url &optional new-window)
(defun browse-url-chromium (url &optional _new-window)
"Ask the Chromium WWW browser to load URL.
Default to the URL around or before point. The strings in
variable `browse-url-chromium-arguments' are also passed to
@ -1281,7 +1281,7 @@ used instead of `browse-url-new-window-flag'."
(defvar url-handler-regexp)
;;;###autoload
(defun browse-url-emacs (url &optional new-window)
(defun browse-url-emacs (url &optional _new-window)
"Ask Emacs to load URL into a buffer and show it in another window."
(interactive (browse-url-interactive-arg "URL: "))
(require 'url-handlers)
@ -1422,7 +1422,7 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch url)))
;;;###autoload
(defun browse-url-w3-gnudoit (url &optional new-window)
(defun browse-url-w3-gnudoit (url &optional _new-window)
;; new-window ignored
"Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
@ -1437,7 +1437,7 @@ The `browse-url-gnudoit-program' program is used with options given by
;; --- Lynx in an xterm ---
;;;###autoload
(defun browse-url-text-xterm (url &optional new-window)
(defun browse-url-text-xterm (url &optional _new-window)
;; new-window ignored
"Ask a text browser to load URL.
URL defaults to the URL around or before point.
@ -1501,7 +1501,7 @@ used instead of `browse-url-new-window-flag'."
(get-buffer-process buf)
;; Don't leave around a dead one (especially because of its
;; munged keymap.)
(lambda (process event)
(lambda (process _event)
(if (not (memq (process-status process) '(run stop)))
(let ((buf (process-buffer process)))
(if buf (kill-buffer buf)))))))
@ -1574,7 +1574,7 @@ used instead of `browse-url-new-window-flag'."
;; --- Random browser ---
;;;###autoload
(defun browse-url-generic (url &optional new-window)
(defun browse-url-generic (url &optional _new-window)
;; new-window ignored
"Ask the WWW browser defined by `browse-url-generic-program' to load URL.
Default to the URL around or before point. A fresh copy of the
@ -1589,7 +1589,7 @@ don't offer a form of remote control."
(append browse-url-generic-args (list url))))
;;;###autoload
(defun browse-url-kde (url &optional new-window)
(defun browse-url-kde (url &optional _new-window)
"Ask the KDE WWW browser to load URL.
Default to the URL around or before point."
(interactive (browse-url-interactive-arg "KDE URL: "))

4
lisp/net/dbus.el
View file

@ -1609,7 +1609,6 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
It will be registered for all objects created by `dbus-register-method'."
(let* ((last-input-event last-input-event)
(bus (dbus-event-bus-name last-input-event))
(service (dbus-event-service-name last-input-event))
(path (dbus-event-path-name last-input-event)))
;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
(let (interfaces result)
@ -1625,8 +1624,7 @@ It will be registered for all objects created by `dbus-register-method'."
;; Check all registered object paths.
(maphash
(lambda (key val)
(let ((object (or (nth 2 (car-safe val)) ""))
(interface (nth 2 key)))
(let ((object (or (nth 2 (car-safe val)) "")))
(when (and (equal (butlast key 2) (list :method bus))
(string-prefix-p path object))
(dolist (interface (cons (nth 2 key) interfaces))

10
lisp/net/eudc.el
View file

@ -518,12 +518,12 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
precords))
(insert "\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _ignore)
(eudc-query-form))
"New query")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _ignore)
(kill-this-buffer))
"Quit")
(eudc-mode)
@ -995,17 +995,17 @@ queries the server for the existing fields and displays a corresponding form."
fields)
(widget-insert "\n\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _ignore)
(eudc-process-form))
"Query Server")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _ignore)
(eudc-query-form))
"Reset Form")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
:notify (lambda (&rest _ignore)
(kill-this-buffer))
"Quit")
(goto-char pt)

2
lisp/net/eudcb-ldap.el
View file

@ -136,7 +136,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
result))
final-result))
(defun eudc-ldap-get-field-list (dummy &optional objectclass)
(defun eudc-ldap-get-field-list (_dummy &optional objectclass)
"Return a list of valid attribute names for the current server.
OBJECTCLASS is the LDAP object class for which the valid
attribute names are returned. Default to `person'"

12
lisp/net/eww.el
View file

@ -159,7 +159,7 @@ word(s) will be searched for via `eww-search-prefix'."
((string-match "^image/" (car content-type))
(eww-display-image))
(t
(eww-display-raw charset)))
(eww-display-raw)))
(setq eww-history-position 0)
(cond
(point
@ -296,7 +296,7 @@ word(s) will be searched for via `eww-search-prefix'."
(list :background (car new-colors))
t))))))
(defun eww-display-raw (charset)
(defun eww-display-raw ()
(let ((data (buffer-substring (point) (point-max))))
(eww-setup-buffer)
(let ((inhibit-read-only t))
@ -345,7 +345,7 @@ word(s) will be searched for via `eww-search-prefix'."
(define-key map [(meta p)] 'eww-previous-bookmark)
(easy-menu-define nil map ""
'("eww"
'("Eww"
["Quit" eww-quit t]
["Reload" eww-reload t]
["Back to previous page" eww-back-url
@ -381,7 +381,7 @@ word(s) will be searched for via `eww-search-prefix'."
eww-history))
;;;###autoload
(defun eww-browse-url (url &optional new-window)
(defun eww-browse-url (url &optional _new-window)
(when (and (equal major-mode 'eww-mode)
eww-current-url)
(eww-save-history))
@ -756,7 +756,6 @@ appears in a <link> or <a> tag."
"Change the value of the select drop-down menu under point."
(interactive)
(let* ((input (get-text-property (point) 'eww-form))
(properties (text-properties-at (point)))
(completion-ignore-case t)
(options
(delq nil
@ -930,8 +929,7 @@ The browser to used is specified by the `shr-external-browser' variable."
(setq file "!"))
((string-match "\\`[.]" file)
(setq file (concat "!" file))))
(let ((base file)
(count 1))
(let ((count 1))
(while (file-exists-p (expand-file-name file directory))
(setq file
(if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)

24
lisp/net/imap.el
View file

@ -139,7 +139,7 @@
(eval-when-compile (require 'cl))
(eval-and-compile
;; For Emacs <22.2 and XEmacs.
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'sasl-find-mechanism "sasl")
@ -661,7 +661,7 @@ sure of changing the value of `foo'."
nil)))))
done))
(defun imap-ssl-p (buffer)
(defun imap-ssl-p (_buffer)
nil)
(defun imap-ssl-open (name buffer server port)
@ -711,7 +711,7 @@ sure of changing the value of `foo'."
(message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
(defun imap-tls-p (buffer)
(defun imap-tls-p (_buffer)
nil)
(defun imap-tls-open (name buffer server port)
@ -738,7 +738,7 @@ sure of changing the value of `foo'."
(when (memq (process-status process) '(open run))
process))))
(defun imap-network-p (buffer)
(defun imap-network-p (_buffer)
t)
(defun imap-network-open (name buffer server port)
@ -757,7 +757,7 @@ sure of changing the value of `foo'."
(when (memq (process-status process) '(open run))
process))))
(defun imap-shell-p (buffer)
(defun imap-shell-p (_buffer)
nil)
(defun imap-shell-open (name buffer server port)
@ -881,10 +881,10 @@ t if it successfully authenticates, nil otherwise."
;; passwd nil))))
ret)))
(defun imap-gssapi-auth-p (buffer)
(defun imap-gssapi-auth-p (_buffer)
(eq imap-stream 'gssapi))
(defun imap-gssapi-auth (buffer)
(defun imap-gssapi-auth (_buffer)
(message "imap: Authenticating using GSSAPI...%s"
(if (eq imap-stream 'gssapi) "done" "failed"))
(eq imap-stream 'gssapi))
@ -893,7 +893,7 @@ t if it successfully authenticates, nil otherwise."
(and (imap-capability 'AUTH=KERBEROS_V4 buffer)
(eq imap-stream 'kerberos4)))
(defun imap-kerberos4-auth (buffer)
(defun imap-kerberos4-auth (_buffer)
(message "imap: Authenticating using Kerberos 4...%s"
(if (eq imap-stream 'kerberos4) "done" "failed"))
(eq imap-stream 'kerberos4))
@ -947,7 +947,7 @@ t if it successfully authenticates, nil otherwise."
(imap-quote-specials passwd)
"\""))))))
(defun imap-anonymous-p (buffer)
(defun imap-anonymous-p (_buffer)
t)
(defun imap-anonymous-auth (buffer)
@ -1838,7 +1838,7 @@ See `imap-enable-exchange-bug-workaround'."
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@ -1884,7 +1884,7 @@ first element. The rest of list contains the saved articles' UIDs."
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@ -1893,7 +1893,7 @@ first element. The rest of list contains the saved articles' UIDs."
(with-current-buffer (or buffer (current-buffer))
(imap-message-appenduid-1 (imap-utf7-encode mailbox))))
(defun imap-message-append (mailbox article &optional flags date-time buffer)
(defun imap-message-append (mailbox article &optional _flags _date-time buffer)
"Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
FLAGS and DATE-TIME is currently not used. Return a cons holding
uidvalidity of MAILBOX and UID the newly created article got, or nil

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

@ -137,7 +137,7 @@
(insert-directory . tramp-adb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
;; `make-auto-save-file-name' performed by default handler.
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
@ -407,9 +407,9 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(split-string
(apply 'concat
(mapcar (lambda (s)
(replace-regexp-in-string
(tramp-compat-replace-regexp-in-string
"\\(.\\)" " -\\1"
(replace-regexp-in-string "^-" "" s)))
(tramp-compat-replace-regexp-in-string "^-" "" s)))
;; FIXME: Warning about removed switches (long and non-dash).
(delq nil
(mapcar
@ -874,7 +874,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
(tramp-compat-user-error "Shell command in progress")))
(tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
@ -1153,11 +1153,11 @@ connection if a previous connection has died for some reason."
(read (current-buffer))))))
(when (and (stringp old-getprop)
(not (string-equal old-getprop new-getprop)))
(tramp-cleanup vec)
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
old-getprop new-getprop)
(tramp-cleanup-connection vec t)
(tramp-adb-maybe-open-connection vec)))
;; Change user if indicated.

10
lisp/net/tramp-cache.el
View file

@ -285,6 +285,16 @@ KEY identifies the connection, it is either a process or a vector."
(let (result)
(maphash
(lambda (key value)
;; Remove text properties from KEY.
(when (vectorp key)
(dotimes (i (length key))
(when (stringp (aref key i))
(aset key i
(funcall
;; `substring-no-properties' does not exist in XEmacs.
(if (functionp 'substring-no-properties)
'substring-no-properties 'identity)
(aref key i))))))
(let ((tmp (format
"(%s %s)"
(if (processp key)

18
lisp/net/tramp-cmds.el
View file

@ -55,9 +55,11 @@
(buffer-list))))
;;;###tramp-autoload
(defun tramp-cleanup-connection (vec)
(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
"Flush all connection related objects.
This includes password cache, file cache, connection cache, buffers.
This includes password cache, file cache, connection cache,
buffers. KEEP-DEBUG non-nil preserves the debug buffer.
KEEP-PASSWORD non-nil preserves the password cache.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@ -80,14 +82,15 @@ When called interactively, a Tramp connection has to be selected."
"Enter Tramp connection: " connections nil t
(try-completion "" connections)))
(when (and name (file-remote-p name))
(with-parsed-tramp-file-name name nil v))))))
(with-parsed-tramp-file-name name nil v))))
nil nil))
(if (not vec)
;; Nothing to do.
(message "No Tramp connection found.")
;; Flush password cache.
(tramp-clear-passwd vec)
(unless keep-password (tramp-clear-passwd vec))
;; Flush file cache.
(tramp-flush-directory-property vec "")
@ -101,7 +104,8 @@ When called interactively, a Tramp connection has to be selected."
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
(get-buffer (tramp-debug-buffer-name vec))
(unless keep-debug
(get-buffer (tramp-debug-buffer-name vec)))
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))))
@ -190,7 +194,9 @@ This includes password cache, file cache, connection cache, buffers."
'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
(propertize "\n" 'display "\
(funcall
(if (functionp 'propertize) 'propertize 'progn)
"\n" 'display "\
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
and what the local and remote machines are.

78
lisp/net/tramp-compat.el
View file

@ -186,7 +186,7 @@
;; `with-temp-message' does not exist in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
(defmacro tramp-compat-with-temp-message (message &rest body)
(defmacro tramp-compat-with-temp-message (_message &rest body)
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
@ -313,13 +313,21 @@ Not actually used. Use `(format \"%o\" i)' instead?"
"Like `copy-file' for Tramp files (compat function)."
(cond
(preserve-extended-attributes
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))
(condition-case nil
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(wrong-number-of-arguments
(tramp-compat-copy-file
filename newname ok-if-already-exists keep-date preserve-uid-gid))))
(preserve-uid-gid
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid))
(condition-case nil
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
preserve-uid-gid)
(wrong-number-of-arguments
(tramp-compat-copy-file
filename newname ok-if-already-exists keep-date))))
(t
(copy-file filename newname ok-if-already-exists keep-date))))
@ -518,11 +526,57 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
"`dos', `unix', or `mac'")))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
;; `user-error' has been added to Emacs 24.3.
(defun tramp-compat-user-error (format &rest args)
"Signal a pilot error."
; (tramp-backtrace)
(apply (if (fboundp 'user-error) 'user-error 'error) format args))
;; `replace-regexp-in-string' does not exist in XEmacs.
;; Implementation is taken from Emacs 24.
(if (fboundp 'replace-regexp-in-string)
(defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string)
(defun tramp-compat-replace-regexp-in-string
(regexp rep string &optional fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
Return a new string containing the replacements.
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'. If START
is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function, it is called with the actual text of each
match, and its value is used as the replacement text. When REP is called,
the match data are the result of matching REGEXP against a substring
of STRING.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\""
(let ((l (length string))
(start (or start 0))
matches str mb me)
(save-match-data
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
;; If we matched the empty string, make sure we advance by one char
(when (= me mb) (setq me (min l (1+ mb))))
;; Generate a replacement for the matched substring.
;; Operate only on the substring to minimize string consing.
;; Set up match data for the substring for replacement;
;; presumably this is likely to be faster than munging the
;; match data directly in Lisp.
(string-match regexp (setq str (substring string mb me)))
(setq matches
(cons (replace-match (if (stringp rep)
rep
(funcall rep (match-string 0 str)))
fixedcase literal str subexp)
(cons (substring string start mb) ; unmatched prefix
matches)))
(setq start me))
;; Reconstruct a string from the pieces.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches))))))
(add-hook 'tramp-unload-hook
(lambda ()

106
lisp/net/tramp-gvfs.el
View file

@ -453,7 +453,7 @@ Every entry is a list (NAME ADDRESS).")
(insert-directory . tramp-gvfs-handle-insert-directory)
(insert-file-contents . tramp-gvfs-handle-insert-file-contents)
(load . tramp-handle-load)
;; `make-auto-save-file-name' performed by default handler.
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-symbolic-link . ignore)
@ -490,7 +490,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(unless tramp-gvfs-enabled
(tramp-compat-user-error "Package `tramp-gvfs' not supported"))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(let ((fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
@ -594,15 +594,19 @@ is no information where to trace the message.")
(and (tramp-tramp-file-p newname)
(not (tramp-gvfs-file-name-p newname))))
;; We cannot copy directly.
;; We cannot call `copy-file' directly. Use
;; `tramp-compat-funcall' for backward compatibility (number
;; of arguments).
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(cond
(preserve-extended-attributes
(copy-file
(tramp-compat-funcall
'copy-file
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes))
(preserve-uid-gid
(copy-file filename tmpfile t keep-date preserve-uid-gid))
(tramp-compat-funcall
'copy-file filename tmpfile t keep-date preserve-uid-gid))
(t
(copy-file filename tmpfile t keep-date)))
(rename-file tmpfile newname ok-if-already-exists))
@ -950,7 +954,7 @@ is no information where to trace the message.")
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
string (replace-regexp-in-string
string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
@ -960,7 +964,7 @@ is no information where to trace the message.")
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
(let ((action (intern-soft
(replace-regexp-in-string
(tramp-compat-replace-regexp-in-string
"_" "-" (downcase (match-string 2 string)))))
(file (match-string 1 string)))
(setq string (replace-match "" nil nil string))
@ -1158,7 +1162,8 @@ is no information where to trace the message.")
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
(replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
(tramp-compat-replace-regexp-in-string
"^.*/\\([^/]+\\)$" "\\1" object-path)))
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
@ -1417,47 +1422,38 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(port (tramp-file-name-port vec))
(localname (tramp-file-name-localname vec))
(ssl (if (string-match "^davs" method) "true" "false"))
(mount-spec '(:array))
(mount-pref "/"))
(setq
mount-spec
(append
mount-spec
(cond
((string-equal "smb" method)
(string-match "^/?\\([^/]+\\)" localname)
(list (tramp-gvfs-mount-spec-entry "type" "smb-share")
(tramp-gvfs-mount-spec-entry "server" host)
(tramp-gvfs-mount-spec-entry "share" (match-string 1 localname))))
((string-equal "obex" method)
(list (tramp-gvfs-mount-spec-entry "type" method)
(tramp-gvfs-mount-spec-entry
"host" (concat "[" (tramp-bluez-address host) "]"))))
((string-match "^dav" method)
(list (tramp-gvfs-mount-spec-entry "type" "dav")
(tramp-gvfs-mount-spec-entry "host" host)
(tramp-gvfs-mount-spec-entry "ssl" ssl)))
(t
(list (tramp-gvfs-mount-spec-entry "type" method)
(tramp-gvfs-mount-spec-entry "host" host))))))
(when user
(add-to-list
'mount-spec (tramp-gvfs-mount-spec-entry "user" user) 'append))
(when domain
(add-to-list
'mount-spec (tramp-gvfs-mount-spec-entry "domain" domain) 'append))
(when port
(add-to-list
'mount-spec (tramp-gvfs-mount-spec-entry "port" (number-to-string port))
'append))
(when (and (string-match "^dav" method)
(string-match "^/?[^/]+" localname))
(setq mount-pref (match-string 0 localname)))
(mount-spec
`(:array
,@(cond
((string-equal "smb" method)
(string-match "^/?\\([^/]+\\)" localname)
(list (tramp-gvfs-mount-spec-entry "type" "smb-share")
(tramp-gvfs-mount-spec-entry "server" host)
(tramp-gvfs-mount-spec-entry
"share" (match-string 1 localname))))
((string-equal "obex" method)
(list (tramp-gvfs-mount-spec-entry "type" method)
(tramp-gvfs-mount-spec-entry
"host" (concat "[" (tramp-bluez-address host) "]"))))
((string-match "\\`dav" method)
(list (tramp-gvfs-mount-spec-entry "type" "dav")
(tramp-gvfs-mount-spec-entry "host" host)
(tramp-gvfs-mount-spec-entry "ssl" ssl)))
(t
(list (tramp-gvfs-mount-spec-entry "type" method)
(tramp-gvfs-mount-spec-entry "host" host))))
,@(when user
(list (tramp-gvfs-mount-spec-entry "user" user)))
,@(when domain
(list (tramp-gvfs-mount-spec-entry "domain" domain)))
,@(when port
(list (tramp-gvfs-mount-spec-entry
"port" (number-to-string port))))))
(mount-pref
(if (and (string-match "\\`dav" method)
(string-match "^/?[^/]+" localname))
(match-string 0 localname)
"/")))
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
@ -1718,11 +1714,13 @@ They are retrieved from the hal daemon."
(when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"PropertyExists" "sync.plugin")
(add-to-list
'tramp-synce-devices
(with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"GetPropertyString" "pda.pocketpc.name"))))
(let ((prop
(with-tramp-dbus-call-method
tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"GetPropertyString" "pda.pocketpc.name")))
(unless (member prop tramp-synce-devices)
(push prop tramp-synce-devices)))))
(tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices)
tramp-synce-devices))

2
lisp/net/tramp-gw.el
View file

@ -238,7 +238,7 @@ authentication is requested from proxy server, provide it."
tramp-gw-vector 6 "\n%s"
(format
"%s%s\r\n" command
(replace-regexp-in-string ;; no password in trace!
(tramp-compat-replace-regexp-in-string ;; no password in trace!
"Basic [^\r\n]+" "Basic xxxxx" authentication t)))
(with-current-buffer buffer
;; Trap errors to be traced in the right trace buffer. Often,

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

@ -850,7 +850,7 @@ of command line.")
(insert-file-contents-literally
. tramp-sh-handle-insert-file-contents-literally)
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
@ -2500,8 +2500,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
'file-name-nondirectory (list localname)))
(setq localname (tramp-run-real-handler
'file-name-directory (list localname))))
(unless full-directory-p
(setq switches (add-to-list 'switches "-d" 'append)))
(unless (or full-directory-p (member "-d" switches))
(setq switches (append switches '("-d"))))
(setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
(when wildcard
(setq switches (concat switches " " wildcard)))
@ -2978,48 +2978,6 @@ the result will be a local, non-Tramp, filename."
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
(defun tramp-sh-handle-make-auto-save-file-name ()
"Like `make-auto-save-file-name' for Tramp files.
Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(let ((tramp-auto-save-directory tramp-auto-save-directory)
(buffer-file-name
(tramp-subst-strs-in-string
'(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
(buffer-file-name))))
;; File name must be unique. This is ensured with Emacs 22 (see
;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
;; all other cases we must do it ourselves.
(when (boundp 'auto-save-file-name-transforms)
(mapc
(lambda (x)
(when (and (string-match (car x) buffer-file-name)
(not (car (cddr x))))
(setq tramp-auto-save-directory
(or tramp-auto-save-directory
(tramp-compat-temporary-file-directory)))))
(symbol-value 'auto-save-file-name-transforms)))
;; Create directory.
(when tramp-auto-save-directory
(setq buffer-file-name
(expand-file-name buffer-file-name tramp-auto-save-directory))
(unless (file-exists-p tramp-auto-save-directory)
(make-directory tramp-auto-save-directory t)))
;; Run plain `make-auto-save-file-name'. There might be an advice when
;; it is not a magic file name operation (since Emacs 22).
;; We must deactivate it temporarily.
(if (not (ad-is-active 'make-auto-save-file-name))
(tramp-run-real-handler 'make-auto-save-file-name nil)
;; else
(ad-deactivate 'make-auto-save-file-name)
(prog1
(tramp-run-real-handler 'make-auto-save-file-name nil)
(ad-activate 'make-auto-save-file-name)))))
;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname confirm)
@ -3425,7 +3383,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
string (replace-regexp-in-string
string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
(while (string-match
@ -3439,7 +3397,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(list
proc
(intern-soft
(replace-regexp-in-string
(tramp-compat-replace-regexp-in-string
"_" "-" (downcase (match-string 4 string))))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
@ -3475,7 +3433,8 @@ Fall back to normal file name handler if no Tramp handler exists."
proc
(mapcar
(lambda (x)
(intern-soft (replace-regexp-in-string "_" "-" (downcase x))))
(intern-soft
(tramp-compat-replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(match-string 3 line))))
;; Usually, we would add an Emacs event now. Unfortunately,
@ -3846,11 +3805,12 @@ process to set up. VEC specifies the connection."
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
(tramp-cleanup vec)
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
old-uname new-uname)
;; We want to keep the password.
(tramp-cleanup-connection vec t t)
(throw 'uname-changed (tramp-maybe-open-connection vec))))
;; Check whether the remote host suffers from buggy
@ -4252,7 +4212,7 @@ Gateway hops are already opened."
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
;; Add the hop.
(add-to-list 'target-alist l)
(push l target-alist)
;; Start next search.
(setq choices tramp-default-proxies-alist)))))
@ -4270,11 +4230,11 @@ Gateway hops are already opened."
vec 'file-error
"Connection `%s' is not supported for gateway access." hop))
;; Open the gateway connection.
(add-to-list
'target-alist
(push
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
(tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
(tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil)
target-alist)
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
@ -4328,68 +4288,68 @@ Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
(tramp-check-proper-host vec)
(catch 'uname-changed
(let ((p (tramp-get-connection-process vec))
(process-name (tramp-get-connection-property vec "process-name" nil))
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
(let ((p (tramp-get-connection-process vec))
(process-name (tramp-get-connection-property vec "process-name" nil))
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
;; If Tramp opens the same connection within a short time frame,
;; there is a problem. We shall signal this.
(unless (or (and p (processp p) (memq (process-status p) '(run open)))
(not (equal (butlast (append vec nil) 2)
(car tramp-current-connection)))
(> (tramp-time-diff
(current-time) (cdr tramp-current-connection))
(or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If Tramp opens the same connection within a short time frame,
;; there is a problem. We shall signal this.
(unless (or (and p (processp p) (memq (process-status p) '(run open)))
(not (equal (butlast (append vec nil) 2)
(car tramp-current-connection)))
(> (tramp-time-diff
(current-time) (cdr tramp-current-connection))
(or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
;; using ssh, it can sometimes happen that the remote end has
;; hung up but the local ssh client doesn't recognize this until
;; it tries to send some data to the remote end. So that's why
;; we try to send a command from time to time, then look again
;; whether the process is really alive.
(condition-case nil
(when (and (> (tramp-time-diff
(current-time)
(tramp-get-connection-property
p "last-cmd-time" '(0 0 0)))
60)
p (processp p) (memq (process-status p) '(run open)))
(tramp-send-command vec "echo are you awake" t t)
(unless (and (memq (process-status p) '(run open))
(tramp-wait-for-output p 10))
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
(tramp-cleanup vec)
(setq p nil)))
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
;; using ssh, it can sometimes happen that the remote end has hung
;; up but the local ssh client doesn't recognize this until it
;; tries to send some data to the remote end. So that's why we
;; try to send a command from time to time, then look again
;; whether the process is really alive.
(condition-case nil
(when (and (> (tramp-time-diff
(current-time)
(tramp-get-connection-property
p "last-cmd-time" '(0 0 0)))
60)
p (processp p) (memq (process-status p) '(run open)))
(tramp-send-command vec "echo are you awake" t t)
(unless (and (memq (process-status p) '(run open))
(tramp-wait-for-output p 10))
;; The error will be caught locally.
(tramp-error vec 'file-error "Awake did fail")))
(file-error
(tramp-cleanup-connection vec t)
(setq p nil)))
;; New connection must be opened.
(condition-case err
(unless (and p (processp p) (memq (process-status p) '(run open)))
;; New connection must be opened.
(condition-case err
(unless (and p (processp p) (memq (process-status p) '(run open)))
;; We call `tramp-get-buffer' in order to get a debug
;; buffer for messages from the beginning.
(tramp-get-buffer vec)
;; We call `tramp-get-buffer' in order to get a debug buffer
;; for messages from the beginning.
(tramp-get-buffer vec)
;; If `non-essential' is non-nil, don't reopen a new connection.
(when (and (boundp 'non-essential) (symbol-value 'non-essential))
(throw 'non-essential 'non-essential))
;; If `non-essential' is non-nil, don't reopen a new connection.
(when (and (boundp 'non-essential) (symbol-value 'non-essential))
(throw 'non-essential 'non-essential))
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(format "Opening connection for %s using %s"
(tramp-file-name-host vec)
(tramp-file-name-method vec))
(format "Opening connection for %s@%s using %s"
(tramp-file-name-user vec)
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(format "Opening connection for %s using %s"
(tramp-file-name-host vec)
(tramp-file-name-method vec)))
(tramp-file-name-method vec))
(format "Opening connection for %s@%s using %s"
(tramp-file-name-user vec)
(tramp-file-name-host vec)
(tramp-file-name-method vec)))
(catch 'uname-changed
;; Start new process.
(when (and p (processp p))
(delete-process p))
@ -4544,13 +4504,13 @@ connection if a previous connection has died for some reason."
target-alist (cdr target-alist)))
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec))))
(tramp-open-connection-setup-interactive-shell p vec)))))
;; When the user did interrupt, we must cleanup.
(quit
(tramp-cleanup vec)
;; Propagate the quit signal.
(signal (car err) (cdr err)))))))
;; When the user did interrupt, we must cleanup.
(quit
(tramp-cleanup-connection vec t)
;; Propagate the quit signal.
(signal (car err) (cdr err))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.

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

@ -229,7 +229,7 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
;; `make-auto-save-file-name' performed by default handler.
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
@ -403,7 +403,7 @@ pass to the OPERATION."
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (file-name-as-directory
(replace-regexp-in-string
(tramp-compat-replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
(tmpdir (make-temp-name
(expand-file-name
@ -537,7 +537,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (tramp-smb-send-command
v (format "put \"%s\" \"%s\""
filename (tramp-smb-get-localname v)))
(tramp-error v 'file-error "Cannot copy `%s'" filename))))))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
;; KEEP-DATE handling.
(when keep-date
@ -1151,7 +1152,8 @@ target of the symlink differ."
(tramp-dissect-file-name (if (file-remote-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
(if (and (tramp-equal-remote filename newname)
(if (and (not (file-exists-p newname))
(tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
@ -1364,14 +1366,14 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
(when entry (add-to-list 'res entry))))
(when entry (push entry res))))
;; Cache share entries.
(unless share
(tramp-set-connection-property v "share-cache" res)))
;; Add directory itself.
(add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
(push '("" "drwxrwxrwx" 0 (0 0)) res)
;; There's a very strange error (debugged with XEmacs 21.4.14)
;; If there's no short delay, it returns nil. No idea about.
@ -1719,11 +1721,15 @@ If ARGUMENT is non-nil, use it as argument for
(error
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(if (search-forward-regexp
tramp-smb-wrong-passwd-regexp nil t)
(if (and (boundp 'auth-sources)
(symbol-value 'auth-sources)
(search-forward-regexp
tramp-smb-wrong-passwd-regexp nil t))
;; Disable `auth-source' and `password-cache'.
(tramp-message
vec 3 "Retry connection with new password")
(let (auth-sources)
(tramp-cleanup vec)
(tramp-cleanup-connection vec t)
(tramp-smb-maybe-open-connection vec argument))
;; Propagate the error.
(signal (car err) (cdr err)))))))))))))

261
lisp/net/tramp.el
View file

@ -690,7 +690,7 @@ Useful for \"rsync\" like methods.")
;; Tramp only knows how to deal with `file-name-handler-alist', not
;; the other places.
;; Currently, we have the choice between 'ftp, 'sep, and 'url.
;; Currently, we have the choice between 'ftp and 'sep.
;;;###autoload
(defcustom tramp-syntax
(if (featurep 'xemacs) 'sep 'ftp)
@ -699,20 +699,15 @@ Useful for \"rsync\" like methods.")
It can have the following values:
'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
'url -- URL-like syntax."
'sep -- Syntax as defined for XEmacs."
:group 'tramp
:type (if (featurep 'xemacs)
'(choice (const :tag "EFS" ftp)
(const :tag "XEmacs" sep)
(const :tag "URL" url))
'(choice (const :tag "Ange-FTP" ftp)
(const :tag "URL" url))))
:version "24.4"
:type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp)
(const :tag "XEmacs" sep)))
(defconst tramp-prefix-format
(cond ((equal tramp-syntax 'ftp) "/")
((equal tramp-syntax 'sep) "/[")
((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
"String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
@ -729,7 +724,6 @@ Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-postfix-method-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "/")
((equal tramp-syntax 'url) "://")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between method and user or host names.
Used in `tramp-make-tramp-file-name'.")
@ -776,7 +770,6 @@ Derived from `tramp-postfix-user-format'.")
(defconst tramp-prefix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "[")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "[")
(t (error "Wrong `tramp-syntax' defined")))
"String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
@ -796,7 +789,6 @@ Derived from `tramp-prefix-ipv6-format'.")
(defconst tramp-postfix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "]")
((equal tramp-syntax 'sep) "")
((equal tramp-syntax 'url) "]")
(t (error "Wrong `tramp-syntax' defined")))
"String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
@ -809,7 +801,6 @@ Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format
(cond ((equal tramp-syntax 'ftp) "#")
((equal tramp-syntax 'sep) "#")
((equal tramp-syntax 'url) ":")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and port numbers.")
@ -838,7 +829,6 @@ Derived from `tramp-postfix-hop-format'.")
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
((equal tramp-syntax 'url) "")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
@ -908,16 +898,10 @@ On W32 systems, the volume letter must be ignored.")
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
"Value for `tramp-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
@ -951,17 +935,10 @@ On W32 systems, the volume letter must be ignored.")
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-url
"\\`/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'"
"Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
@ -1120,6 +1097,12 @@ calling HANDLER.")
;;; Internal functions which must come first:
(defsubst tramp-user-error (vec-or-proc format &rest args)
"Signal a pilot error."
(apply
'tramp-error vec-or-proc
(if (fboundp 'user-error) 'user-error 'error) format args))
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
@ -1232,17 +1215,18 @@ their replacement."
(if noninteractive
(warn "Method %s is obsolete, using %s"
result (substring result 0 -1))
(unless (y-or-n-p (format "Method %s is obsolete, use %s? "
(unless (y-or-n-p (format "Method \"%s\" is obsolete, use \"%s\"? "
result (substring result 0 -1)))
(tramp-compat-user-error "Method \"%s\" not supported" result)))
(tramp-user-error nil "Method \"%s\" not supported" result)))
(add-to-list 'tramp-warned-obsolete-methods result))
;; This works with the current set of `tramp-obsolete-methods'.
;; Must be improved, if their are more sophisticated replacements.
(setq result (substring result 0 -1)))
;; We must mark, whether a default value has been used.
(if (or method (null result))
;; We must mark, whether a default value has been used. Not
;; applicable for XEmacs.
(if (or method (null result) (null (functionp 'propertize)))
result
(propertize result 'tramp-default t))))
(tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-user (method user host)
"Return the right user string to use.
@ -1260,10 +1244,11 @@ This is USER, if non-nil. Otherwise, do a lookup in
(setq choices nil)))
luser)
tramp-default-user)))
;; We must mark, whether a default value has been used.
(if (or user (null result))
;; We must mark, whether a default value has been used. Not
;; applicable for XEmacs.
(if (or user (null result) (null (functionp 'propertize)))
result
(propertize result 'tramp-default t))))
(tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-host (method user host)
"Return the right host string to use.
@ -1289,8 +1274,8 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
(or (null method) (get-text-property 0 'tramp-default method))
(or (null user) (get-text-property 0 'tramp-default user))
(member host (mapcar 'car tramp-methods)))
(tramp-compat-user-error
"Host name must not match method `%s'" host))))
(tramp-cleanup-connection vec)
(tramp-user-error vec "Host name must not match method \"%s\"" host))))
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure.
@ -1300,7 +1285,7 @@ non-nil, the file name parts are not expanded to their default
values."
(save-match-data
(let ((match (string-match (nth 0 tramp-file-name-structure) name)))
(unless match (tramp-compat-user-error "Not a Tramp file name: %s" name))
(unless match (tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
@ -1485,7 +1470,8 @@ ARGUMENTS to actually emit the message (if applicable)."
"tramp-debug-message"
"tramp-error"
"tramp-error-with-buffer"
"tramp-message")
"tramp-message"
"tramp-user-error")
t)
"$")
fn)))
@ -1625,18 +1611,19 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit
If VAR is nil, then we bind `v' to the structure and `method', `user',
`host', `localname', `hop' to the components."
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
(,(if var (intern (concat (symbol-name var) "-method")) 'method)
(tramp-file-name-method ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-user")) 'user)
(tramp-file-name-user ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-host")) 'host)
(tramp-file-name-host ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
(tramp-file-name-localname ,(or var 'v)))
(,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
(tramp-file-name-hop ,(or var 'v))))
,@body))
(let ((bindings
(mapcar (lambda (elem)
`(,(if var (intern (format "%s-%s" var elem)) elem)
(,(intern (format "tramp-file-name-%s" elem))
,(or var 'v))))
'(method user host localname hop))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
;; and then add here a dummy use of all those variables, so we don't get
;; flooded by warnings about those vars `body' didn't use.
(ignore ,@(mapcar #'car bindings))
,@body)))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
@ -1654,24 +1641,27 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
`(let ((result "failed")
pr tm)
`(progn
(tramp-message ,vec ,level "%s..." ,message)
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
(when (and tramp-message-show-message
;; Display only when there is a minimum level.
(<= ,level (min tramp-verbose 3)))
(ignore-errors
(setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
tm (when pr
(run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
(unwind-protect
;; Execute the body.
(prog1 (progn ,@body) (setq result "done"))
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message result))))
(let ((cookie "failed")
(tm
;; We start a pulsing progress reporter after 3 seconds. Feature
;; introduced in Emacs 24.1.
(when (and tramp-message-show-message
;; Display only when there is a minimum level.
(<= ,level (min tramp-verbose 3)))
(ignore-errors
(let ((pr (tramp-compat-funcall
#'make-progress-reporter ,message)))
(when pr
(run-at-time 3 0.1
#'tramp-progress-reporter-update pr)))))))
(unwind-protect
;; Execute the body.
(prog1 (progn ,@body) (setq cookie "done"))
;; Stop progress reporter.
(if tm (tramp-compat-funcall 'cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
@ -1722,19 +1712,6 @@ letter into the file name. This function removes it."
(replace-match "/" nil t name)
name)))
(defun tramp-cleanup (vec)
"Cleanup connection VEC, but keep the debug buffer."
(with-current-buffer (tramp-get-debug-buffer vec)
;; Keep the debug buffer.
(rename-buffer
(generate-new-buffer-name tramp-temp-buffer-name) 'unique)
(tramp-cleanup-connection vec)
(if (= (point-min) (point-max))
(kill-buffer nil)
(rename-buffer (tramp-debug-buffer-name vec) 'unique))
;; We call `tramp-get-buffer' in order to keep the debug buffer.
(tramp-get-buffer vec)))
;;; Config Manipulation Functions:
;;;###tramp-autoload
@ -2157,7 +2134,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(tramp-message
v 1 "Suppress received in operation %s"
(append (list operation) args))
(tramp-cleanup v)
(tramp-cleanup-connection v t)
(tramp-run-real-handler operation args)))
(t result)))
@ -2531,64 +2508,40 @@ They are collected by `tramp-completion-dissect-file-name1'."
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
nil 1 2 nil))
;; "/method:user" "/[method/user" "/method://user"
;; "/method:user" "/[method/user"
(tramp-completion-file-name-structure7
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp x-nil "\\)$")
1 2 nil nil))
;; "/method:host" "/[method/host" "/method://host"
;; "/method:host" "/[method/host"
(tramp-completion-file-name-structure8
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 nil 2 nil))
;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
;; "/method:[ipv6" "/[method/ipv6"
(tramp-completion-file-name-structure9
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 nil 2 nil))
;; "/method:user@host" "/[method/user@host" "/method://user@host"
;; "/method:user@host" "/[method/user@host"
(tramp-completion-file-name-structure10
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 2 3 nil))
;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
;; "/method:user@[ipv6" "/[method/user@ipv6"
(tramp-completion-file-name-structure11
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 2 3 nil))
;; "/method: "/method:/"
(tramp-completion-file-name-structure12
(list
(if (equal tramp-syntax 'url)
(concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)"
"\\(" (substring tramp-postfix-method-regexp 0 1)
"\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
"\\(" "\\)$")
;; Should not match if not URL syntax.
(concat tramp-prefix-regexp "/$"))
1 3 nil nil))
;; "/method: "/method:/"
(tramp-completion-file-name-structure13
(list
(if (equal tramp-syntax 'url)
(concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)"
"\\(" (substring tramp-postfix-method-regexp 0 1)
"\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
"\\(" "\\)$")
;; Should not match if not URL syntax.
(concat tramp-prefix-regexp "/$"))
1 nil 3 nil)))
1 2 3 nil)))
(mapc (lambda (structure)
(add-to-list 'result
@ -2605,8 +2558,6 @@ They are collected by `tramp-completion-dissect-file-name1'."
tramp-completion-file-name-structure9
tramp-completion-file-name-structure10
tramp-completion-file-name-structure11
tramp-completion-file-name-structure12
tramp-completion-file-name-structure13
tramp-file-name-structure))
(delq nil result)))
@ -3233,7 +3184,7 @@ User is always nil."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
(tramp-compat-user-error "Shell command in progress")))
(tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
@ -3278,35 +3229,19 @@ User is always nil."
(defun tramp-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
\"//\" and \"/~\" substitute only in the local filename part.
If the URL Tramp syntax is chosen, \"//\" as method delimiter and \"/~\" at
beginning of local filename are not substituted."
\"//\" and \"/~\" substitute only in the local filename part."
;; First, we must replace environment variables.
(setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
(if (equal tramp-syntax 'url)
;; We need to check localname only. The other parts cannot contain
;; "//" or "/~".
(if (and (> (length localname) 1)
(or (string-match "//" localname)
(string-match "/~" localname 1)))
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(tramp-make-tramp-file-name
(when method (substitute-in-file-name method))
(when user (substitute-in-file-name user))
(when host (substitute-in-file-name host))
(when localname
(tramp-run-real-handler
'substitute-in-file-name (list localname)))))
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))
;; "/m:h:~" does not work for completion. We use "/m:h:~/".
(when (string-match "~$" filename)
(setq filename (concat filename "/"))))
(tramp-run-real-handler 'substitute-in-file-name (list filename)))))
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))
;; "/m:h:~" does not work for completion. We use "/m:h:~/".
(when (string-match "~$" filename)
(setq filename (concat filename "/"))))
(tramp-run-real-handler 'substitute-in-file-name (list filename))))
(defun tramp-handle-unhandled-file-name-directory (_filename)
"Like `unhandled-file-name-directory' for Tramp files."
@ -3974,6 +3909,48 @@ Return the local name of the temporary file."
;;; Auto saving to a special directory:
(defun tramp-handle-make-auto-save-file-name ()
"Like `make-auto-save-file-name' for Tramp files.
Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(let ((tramp-auto-save-directory tramp-auto-save-directory)
(buffer-file-name
(tramp-subst-strs-in-string
'(("_" . "|")
("/" . "_a")
(":" . "_b")
("|" . "__")
("[" . "_l")
("]" . "_r"))
(buffer-file-name))))
;; File name must be unique. This is ensured with Emacs 22 (see
;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
;; all other cases we must do it ourselves.
(when (boundp 'auto-save-file-name-transforms)
(mapc
(lambda (x)
(when (and (string-match (car x) buffer-file-name)
(not (car (cddr x))))
(setq tramp-auto-save-directory
(or tramp-auto-save-directory
(tramp-compat-temporary-file-directory)))))
(symbol-value 'auto-save-file-name-transforms)))
;; Create directory.
(when tramp-auto-save-directory
(setq buffer-file-name
(expand-file-name buffer-file-name tramp-auto-save-directory))
(unless (file-exists-p tramp-auto-save-directory)
(make-directory tramp-auto-save-directory t)))
;; Run plain `make-auto-save-file-name'. There might be an advice when
;; it is not a magic file name operation (since Emacs 22).
;; We must deactivate it temporarily.
(if (not (ad-is-active 'make-auto-save-file-name))
(tramp-run-real-handler 'make-auto-save-file-name nil)
;; else
(ad-deactivate 'make-auto-save-file-name)
(prog1
(tramp-run-real-handler 'make-auto-save-file-name nil)
(ad-activate 'make-auto-save-file-name)))))
(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
(defadvice make-auto-save-file-name
(around tramp-advice-make-auto-save-file-name () activate)

Some files were not shown because too many files have changed in this diff Show more