[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] xwidget_mvp 77dbd0e: Merge branch 'master' into xwidget_mv
|
From: |
Joakim Verona |
|
Subject: |
[Emacs-diffs] xwidget_mvp 77dbd0e: Merge branch 'master' into xwidget_mvp |
|
Date: |
Thu, 02 Apr 2015 06:04:35 +0000 |
branch: xwidget_mvp
commit 77dbd0efca6b42304c3f79114c321a15fe3faf57
Merge: 8a5b2d3 23bb07e
Author: Joakim Verona <address@hidden>
Commit: Joakim Verona <address@hidden>
Merge branch 'master' into xwidget_mvp
---
CONTRIBUTE | 36 +-
ChangeLog | 30 +-
admin/CPP-DEFINES | 1 -
admin/ChangeLog | 6 +-
admin/authors.el | 2 +
admin/update_autogen | 2 +-
build-aux/dir_top | 1 +
build-aux/git-hooks/commit-msg | 16 +-
configure.ac | 35 +-
doc/emacs/ChangeLog | 4 +
doc/emacs/display.texi | 2 +-
doc/emacs/files.texi | 2 +-
doc/emacs/programs.texi | 4 +-
doc/lispintro/ChangeLog | 4 +
doc/lispintro/emacs-lisp-intro.texi | 44 +-
doc/lispref/ChangeLog | 25 +
doc/lispref/commands.texi | 15 +-
doc/lispref/numbers.texi | 12 +-
doc/lispref/objects.texi | 4 +-
doc/lispref/positions.texi | 21 +-
doc/lispref/processes.texi | 55 ++
doc/misc/ChangeLog | 11 +-
doc/misc/efaq-w32.texi | 8 +-
doc/misc/idlwave.texi | 23 +-
doc/misc/newsticker.texi | 3 +-
doc/misc/remember.texi | 2 +-
etc/ChangeLog | 17 +
etc/NEWS | 40 +-
etc/PROBLEMS | 26 +-
etc/TODO | 38 -
lib-src/ChangeLog | 11 +
lib-src/etags.c | 17 +-
lisp/ChangeLog | 374 +++++++-
lisp/bookmark.el | 2 +-
lisp/comint.el | 21 +-
lisp/elec-pair.el | 16 +-
lisp/emacs-lisp/byte-run.el | 4 +-
lisp/emacs-lisp/checkdoc.el | 5 +-
lisp/emacs-lisp/cl-lib.el | 1 -
lisp/emacs-lisp/cl-macs.el | 73 ++-
lisp/emacs-lisp/debug.el | 6 +-
lisp/emacs-lisp/eieio-base.el | 12 +-
lisp/emacs-lisp/eieio.el | 40 +-
lisp/emacs-lisp/lisp-mode.el | 73 ++-
lisp/emacs-lisp/package.el | 1772 +++++++++++++++++++---------------
lisp/emacs-lisp/pcase.el | 53 +-
lisp/emacs-lisp/seq.el | 4 +-
lisp/emacs-lisp/smie.el | 4 +-
lisp/epg.el | 8 +-
lisp/erc/ChangeLog | 4 +
lisp/erc/erc.el | 3 +-
lisp/ffap.el | 14 +-
lisp/font-lock.el | 79 +-
lisp/gnus/ChangeLog | 43 +
lisp/gnus/gnus-art.el | 2 +
lisp/gnus/gnus-registry.el | 2 +-
lisp/gnus/gnus-sum.el | 1 +
lisp/gnus/nnimap.el | 15 +-
lisp/gnus/nnmh.el | 4 +-
lisp/gnus/plstore.el | 13 +-
lisp/gnus/registry.el | 19 +-
lisp/international/mule-cmds.el | 12 +-
lisp/jit-lock.el | 116 ++-
lisp/json.el | 47 +-
lisp/ldefs-boot.el | 450 +++++----
lisp/mail/sendmail.el | 8 +-
lisp/menu-bar.el | 22 +-
lisp/mouse.el | 3 +-
lisp/net/browse-url.el | 154 +--
lisp/net/tramp-sh.el | 51 +-
lisp/progmodes/cc-langs.el | 6 +-
lisp/progmodes/cc-mode.el | 116 ++-
lisp/progmodes/python.el | 11 +-
lisp/progmodes/ruby-mode.el | 7 +-
lisp/simple.el | 27 +-
lisp/subr.el | 24 +
lisp/term.el | 33 +-
lisp/textmodes/css-mode.el | 3 +-
lisp/textmodes/sgml-mode.el | 23 +-
lisp/window.el | 157 +++-
lisp/x-dnd.el | 8 +-
lisp/xt-mouse.el | 185 +++--
nt/ChangeLog | 5 +
nt/inc/ms-w32.h | 4 -
src/ChangeLog | 138 +++
src/editfns.c | 59 +-
src/emacs.c | 7 +
src/floatfns.c | 10 +-
src/fontset.c | 2 +-
src/gtkutil.c | 4 +
src/keyboard.c | 12 +
src/lread.c | 6 +-
src/process.c | 261 ++++--
src/w32.c | 103 ++-
src/w32.h | 9 +-
src/w32proc.c | 209 ++++-
src/xsmfns.c | 25 +-
src/xterm.c | 9 +
test/ChangeLog | 26 +
test/automated/data/epg/pubkey.asc | 20 +
test/automated/data/epg/seckey.asc | 33 +
test/automated/epg-tests.el | 172 ++++
test/automated/json-tests.el | 46 +
test/automated/package-test.el | 4 +-
test/automated/textprop-tests.el | 57 ++
test/automated/tramp-tests.el | 85 ++-
test/indent/sgml-mode-attribute.html | 14 +
107 files changed, 4120 insertions(+), 1847 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 5cf015f..005ca17 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -37,16 +37,17 @@ specify the actual author; the committer defaults to you.
When using git, commit messages should use ChangeLog format, with the
following modifications:
-- Add a single short line explaining the change, then an empty line,
- then unindented ChangeLog entries.
+- Start with a single unindented summary line explaining the change,
+ then an empty line, then unindented ChangeLog entries.
You can use various Emacs functions to ease this process; see (info
"(emacs)Change Log Commands") or
http://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html.
-- The summary line is limited to 72 characters (enforced by a commit
- hook). If you have trouble making that a good summary, add a
- paragraph below it, before the individual file descriptions.
+- Limit lines in commit messages to 78 characters, unless they consist
+ of a single word of at most 140 characters. If you have trouble
+ fitting the summary into 78 characters, add a summarizing paragraph
+ below the empty line and before the individual file descriptions.
- If only a single file is changed, the summary line can be the normal
file first line (starting with the asterisk). Then there is no
@@ -57,6 +58,11 @@ following modifications:
the rationale for a change; that can be done in the commit message
between the summary line and the file entries.
+- Commit messages should contain only printable UTF-8 characters.
+
+- Commit messages should not contain the "Signed-off-by:" lines that
+ are used in some other projects.
+
** ChangeLog notes
- Emacs generally follows the GNU coding standards when it comes to
@@ -187,6 +193,26 @@ know it does not, mark the NEWS entry with "---". If you
know
that *all* the necessary documentation updates have been made, mark
the entry with "+++". Otherwise do not mark it.
+Please see (info "(elisp)Documentation Tips") or
+https://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html
+for more specific tips on Emacs's doc style. Use `checkdoc' to check
+for documentation errors before submitting a patch.
+
+** Test your changes.
+
+Please test your changes before committing them or sending them to the
+list.
+
+Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info
+"(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/
+for more information on writing and running tests.
+
+To run tests on the entire Emacs tree, run "make check" from the
+top-level directory. Most tests are in the directory
+"test/automated". From the "test/automated" directory, run "make
+<filename>" to run the tests for <filename>.el(c). See
+"test/automated/Makefile" for more information.
+
** Understanding Emacs Internals.
The best way to understand Emacs Internals is to read the code,
diff --git a/ChangeLog b/ChangeLog
index d268ba0..6df5a5a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,37 @@
+2015-03-27 Pete Williamson <address@hidden> (tiny change)
+
+ Add NaCl target
+ * configure.ac: Add a target for Chromium Native Client (NaCl).
+
+2015-03-29 Eli Zaretskii <address@hidden>
+
+ * build-aux/dir_top (File): Fix the description of selecting a
+ menu item by its number. (Bug#20213)
+
+2015-03-29 Paul Eggert <address@hidden>
+
+ Fix 'commit-msg' to cite 'CONTRIBUTE'
+ As suggested in:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00947.html
+ Also, have the two files match better.
+ * CONTRIBUTE: Match what's in build-aux/git-hooks/commit-msg.
+ * build-aux/git-hooks/commit-msg: Mention 'CONTRIBUTE'.
+
+2015-03-23 Andreas Schwab <address@hidden>
+
+ * configure.ac: Fix jpeg version check to work with gcc >= 5.
+
+2015-03-21 Samer Masterson <address@hidden>
+
+ * CONTRIBUTE (Test your changes.): New section.
+ (Document your changes.): Add doc tips.
+
2015-03-19 Paul Eggert <address@hidden>
Better port of pthread usage to FreeBSD
* configure.ac (ac_func_list): Omit pthread_sigmask, since
we check for that ourselves rather than relying on gnulib.
- (HAVE_PTHREAD, LIB_PTHREAD, _THREAD_SAFE): Port better to FreeBSD,
+ (HAVE_PTHREAD, LIB_PTHREAD): Port better to FreeBSD,
by also checking for pthread_create, pthread_self, pthread_sigmask.
Tighten the test for pthread_atfork while we're at it.
Fixes: bug#20136
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 18423c2..796b57d 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -85,7 +85,6 @@ AMPERSAND_FULL_NAME
BROKEN_DATAGRAM_SOCKETS
BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
-BROKEN_NON_BLOCKING_CONNECT
BROKEN_PTY_READ_AFTER_EAGAIN
DEFAULT_SOUND_DEVICE
DEVICE_SEP
diff --git a/admin/ChangeLog b/admin/ChangeLog
index 092bfa9..d3fabd4 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,6 +1,10 @@
+2015-03-31 Glenn Morris <address@hidden>
+
+ * update_autogen (commit): Switch prefix from "# " to "; ".
+
2015-03-03 Kelvin White <address@hidden>
- * MAINTAINERS: Add myself to section 2
+ * MAINTAINERS: Add myself to section 2.
2015-03-03 Glenn Morris <address@hidden>
diff --git a/admin/authors.el b/admin/authors.el
index d214ff2..1e4af9b 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -86,6 +86,7 @@ files.")
("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
("Johan Bockgård" "Johan Bockgard")
+ ("John F. Carr" "John F Carr")
("John J Foerch" "John Foerch")
("John W. Eaton" "John Eaton")
("Jonathan I. Kamens" "Jonathan Kamens")
@@ -243,6 +244,7 @@ If REALNAME is nil, ignore that author.")
'(".*loaddefs.el$" ; not obsolete, but auto-generated
"\\.\\(bzr\\|cvs\\|git\\)ignore$" ; obsolete or uninteresting
"\\.arch-inventory$"
+ "ChangeLog\\(\\.[0-9]+\\)?\\'"
"automated/data/" ; not interesting
;; TODO lib/? Matches other things?
"build-aux/" "m4/" "Emacs.xcodeproj" "mapfiles" "\\.map\\'"
diff --git a/admin/update_autogen b/admin/update_autogen
index 73e8aeb..1bd8296 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -228,7 +228,7 @@ commit ()
echo "Committing..."
- $vcs commit -m "# Auto-commit of $type files." "$@" || return $?
+ $vcs commit -m "; Auto-commit of $type files." "$@" || return $?
[ "$vcs" = "git" ] && {
$vcs push || return $?
diff --git a/build-aux/dir_top b/build-aux/dir_top
index 321a39d..928da04 100644
--- a/build-aux/dir_top
+++ b/build-aux/dir_top
@@ -15,6 +15,7 @@ The Info Directory
In Emacs Info, you can click mouse button 2 on a menu item
or cross reference to follow it to its target.
Each menu line that starts with a * is a topic you can select with "m".
+ You can also select a topic by typing its ordinal number.
Every third topic has a red * to help pick the right number to type.
* Menu:
diff --git a/build-aux/git-hooks/commit-msg b/build-aux/git-hooks/commit-msg
index 31df5ce..13a0535 100755
--- a/build-aux/git-hooks/commit-msg
+++ b/build-aux/git-hooks/commit-msg
@@ -63,7 +63,7 @@ exec $awk '
/^#/ { next }
!/^.*$/ {
- print "Invalid character (not UTF-8) in commit message"
+ print "Invalid character (not UTF-8) in commit message; see 'CONTRIBUTE'"
status = 1
}
@@ -77,13 +77,13 @@ exec $awk '
sub(/^squash! /, "")
if ($0 ~ "^" space) {
- print "White space at start of commit message'\''s first line"
+ print "White space at start of commit message'\''s first line; see
'CONTRIBUTE'"
status = 1
}
}
nlines == 2 && $0 ~ non_space {
- print "Nonempty second line in commit message"
+ print "Nonempty second line in commit message; see 'CONTRIBUTE'"
status = 1
}
@@ -97,28 +97,28 @@ exec $awk '
}
78 < length && $0 ~ space {
- print "Line longer than 78 characters in commit message"
+ print "Line longer than 78 characters in commit message; see 'CONTRIBUTE'"
status = 1
}
140 < length {
- print "Word longer than 140 characters in commit message"
+ print "Word longer than 140 characters in commit message; see 'CONTRIBUTE'"
status = 1
}
/^Signed-off-by: / {
- print "'\''Signed-off-by:'\'' in commit message"
+ print "'\''Signed-off-by:'\'' in commit message; see 'CONTRIBUTE'"
status = 1
}
$0 ~ non_print {
- print "Unprintable character in commit message"
+ print "Unprintable character in commit message; see 'CONTRIBUTE'"
status = 1
}
END {
if (nlines == 0) {
- print "Empty commit message"
+ print "Empty commit message; see 'CONTRIBUTE'"
status = 1
}
exit status
diff --git a/configure.ac b/configure.ac
index 649ba2c..8245d3f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -615,6 +615,11 @@ case "${canonical}" in
## fi
;;
+ ## Chromium Native Client
+ *-nacl )
+ opsys=nacl
+ ;;
+
## Cygwin ports
*-*-cygwin )
opsys=cygwin
@@ -1266,7 +1271,7 @@ dnl The function dump-emacs will not be defined and
temacs will do
dnl (load "loadup") automatically unless told otherwise.
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
case "$opsys" in
- your-opsys-here) CANNOT_DUMP=yes ;;
+ nacl) CANNOT_DUMP=yes ;;
esac
if test "$CANNOT_DUMP" = "yes"; then
@@ -2107,7 +2112,7 @@ hybrid_malloc=
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
- darwin|mingw32|sol2-10) system_malloc=yes ;;
+ darwin | mingw32 | nacl | sol2-10) system_malloc=yes ;;
cygwin) hybrid_malloc=yes;;
esac
@@ -2237,7 +2242,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" !=
"mingw32"; then
hpux* | sol*)
AC_DEFINE([_REENTRANT], 1,
[Define to 1 if your system requires this in multithreaded code.]);;
- aix4-2 | darwin | freebsd)
+ aix4-2)
AC_DEFINE([_THREAD_SAFE], 1,
[Define to 1 if your system requires this in multithreaded code.]);;
esac
@@ -3236,10 +3241,12 @@ if test "${opsys}" = "mingw32"; then
AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library
(-ljpeg).])dnl
if test "${HAVE_JPEG}" = "yes"; then
AC_DEFINE(HAVE_JPEG)
- AC_EGREP_CPP([version= *(6[2-9]|[7-9][0-9])],
- [#include <jpeglib.h>
- version=JPEG_LIB_VERSION
-],
+ AC_EGREP_CPP([version 6b or later],
+ [#include <jpeglib.h>
+ #if JPEG_LIB_VERSION >= 62
+ version 6b or later
+ #endif
+ ],
[AC_DEFINE(HAVE_JPEG)],
[AC_MSG_WARN([libjpeg found, but not version 6b or later])
HAVE_JPEG=no])
@@ -3255,10 +3262,12 @@ elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" =
"yes"; then
AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library
(-ljpeg).])dnl
if test "${HAVE_JPEG}" = "yes"; then
AC_DEFINE(HAVE_JPEG)
- AC_EGREP_CPP([version= *(6[2-9]|[7-9][0-9])],
+ AC_EGREP_CPP([version 6b or later],
[#include <jpeglib.h>
- version=JPEG_LIB_VERSION
-],
+ #if JPEG_LIB_VERSION >= 62
+ version 6b or later
+ #endif
+ ],
[AC_DEFINE(HAVE_JPEG)],
[AC_MSG_WARN([libjpeg found, but not version 6b or later])
HAVE_JPEG=no])
@@ -4221,7 +4230,7 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
dnl See eg <http://article.gmane.org/gmane.os.openbsd.ports/46831>.
- hpux* | irix6-5 | openbsd | sol2* | unixware )
+ hpux* | irix6-5 | nacl | openbsd | sol2* | unixware )
emacs_broken_SIGIO=yes
;;
@@ -4383,7 +4392,7 @@ case $opsys in
AC_DEFINE(FIRST_PTY_LETTER, ['p'])
;;
- gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd )
+ gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd | nacl )
dnl if HAVE_GRANTPT
if test "x$ac_cv_func_grantpt" = xyes; then
AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.])
@@ -4682,7 +4691,7 @@ esac
AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD],
[case $opsys in
- aix4-2)
+ aix4-2 | nacl)
dnl BUILD 9008 - FIONREAD problem still exists in X-Windows.
emacs_cv_usable_FIONREAD=no
;;
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 644281c..469fdc3 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-29 Dani Moncayo <address@hidden>
+
+ * files.texi (Diff Mode): Doc fix.
+
2015-03-18 Eli Zaretskii <address@hidden>
* misc.texi (Term Mode):
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 083bb2e..53bea52 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1201,7 +1201,7 @@ Highlight space and non-breaking space characters.
@item lines
@vindex whitespace-line-column
-Highlight lines longer than 80 lines. To change the column limit,
+Highlight lines longer than 80 columns. To change the column limit,
customize the variable @code{whitespace-line-column}.
@item newline
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index b12b28f..21957d0 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1368,7 +1368,7 @@ remains ``correct''. To disable automatic line number
correction,
change the variable @code{diff-update-on-the-fly} to @code{nil}.
Diff mode treats each hunk as an ``error message'', similar to
-Compilation mode. Thus, you can use commands such as @kbd{C-x '} to
+Compilation mode. Thus, you can use commands such as @kbd{C-x `} to
visit the corresponding source locations. @xref{Compilation Mode}.
In addition, Diff mode provides the following commands to navigate,
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index b161a0c..1fffa23 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -870,7 +870,9 @@ mode to skip whitespace forward before deciding whether to
skip over
the closing delimiter.
@end itemize
-To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}.
+To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}. To
+toggle the mode in a single buffer, use @kbd{M-x
+electric-pair-local-mode}.
@node Comments
@section Manipulating Comments
diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog
index 57ab03b..c54c165 100644
--- a/doc/lispintro/ChangeLog
+++ b/doc/lispintro/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * emacs-lisp-intro.texi: `save-excursion' doesn't save&restore the mark.
+
2014-12-31 Paul Eggert <address@hidden>
Less 'make' chatter for Emacs doc
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index c67623d..ed125bb 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -352,7 +352,7 @@ How To Write Function Definitions
* if:: What if?
* else:: If--then--else expressions.
* Truth & Falsehood:: What Lisp considers false and true.
-* save-excursion:: Keeping track of point, mark, and buffer.
+* save-excursion:: Keeping track of point and buffer.
* Review::
* defun Exercises::
@@ -2966,7 +2966,7 @@ symbol refers to it.)
* if:: What if?
* else:: If--then--else expressions.
* Truth & Falsehood:: What Lisp considers false and true.
-* save-excursion:: Keeping track of point, mark, and buffer.
+* save-excursion:: Keeping track of point and buffer.
* Review::
* defun Exercises::
@end menu
@@ -4159,11 +4159,11 @@ The @code{save-excursion} function is the third and
final special form
that we will discuss in this chapter.
In Emacs Lisp programs used for editing, the @code{save-excursion}
-function is very common. It saves the location of point and mark,
-executes the body of the function, and then restores point and mark to
-their previous positions if their locations were changed. Its primary
+function is very common. It saves the location of point,
+executes the body of the function, and then restores point to
+its previous position if its location was changed. Its primary
purpose is to keep the user from being surprised and disturbed by
-unexpected movement of point or mark.
+unexpected movement of point.
@menu
* Point and mark:: A review of various locations.
@@ -4201,7 +4201,7 @@ region}. Numerous commands work on the region, including
@code{print-region}.
The @code{save-excursion} special form saves the locations of point and
-mark and restores those positions after the code within the body of the
+restores this position after the code within the body of the
special form is evaluated by the Lisp interpreter. Thus, if point were
in the beginning of a piece of text and some code moved point to the end
of the buffer, the @code{save-excursion} would put point back to where
@@ -4212,16 +4212,16 @@ In Emacs, a function frequently moves point as part of
its internal
workings even though a user would not expect this. For example,
@code{count-lines-region} moves point. To prevent the user from being
bothered by jumps that are both unexpected and (from the user's point of
-view) unnecessary, @code{save-excursion} is often used to keep point and
-mark in the location expected by the user. The use of
+view) unnecessary, @code{save-excursion} is often used to keep point in
+the location expected by the user. The use of
@code{save-excursion} is good housekeeping.
To make sure the house stays clean, @code{save-excursion} restores the
-values of point and mark even if something goes wrong in the code inside
+value of point even if something goes wrong in the code inside
of it (or, to be more precise and to use the proper jargon, ``in case of
abnormal exit''). This feature is very helpful.
-In addition to recording the values of point and mark,
+In addition to recording the value of point,
@code{save-excursion} keeps track of the current buffer, and restores
it, too. This means you can write code that will change the buffer and
have @code{save-excursion} switch you back to the original buffer.
@@ -4386,9 +4386,9 @@ For example,
@end smallexample
@item save-excursion
-Record the values of point and mark and the current buffer before
-evaluating the body of this special form. Restore the values of point
-and mark and buffer afterward.
+Record the values of point and the current buffer before
+evaluating the body of this special form. Restore the value of point and
+buffer afterward.
@need 1250
For example,
@@ -5201,8 +5201,8 @@ of the two-element list, @code{(oldbuf (current-buffer))}.
The body of the @code{let} expression in @code{append-to-buffer}
consists of a @code{save-excursion} expression.
-The @code{save-excursion} function saves the locations of point and
-mark, and restores them to those positions after the expressions in the
+The @code{save-excursion} function saves the location of point, and restores it
+to that position after the expressions in the
body of the @code{save-excursion} complete execution. In addition,
@code{save-excursion} keeps track of the original buffer, and
restores it. This is how @code{save-excursion} is used in
@@ -5390,7 +5390,7 @@ Conventionally bound to @kbd{M-.} (that's a period
following the
@key{META} key).
@item save-excursion
-Save the location of point and mark and restore their values after the
+Save the location of point and restore its value after the
arguments to @code{save-excursion} have been evaluated. Also, remember
the current buffer and return to it.
@@ -5896,7 +5896,7 @@ the value of point, which will be at the end of the
inserted text, is
recorded in the variable @code{newmark}.
After the body of the outer @code{save-excursion} is evaluated, point
-and mark are relocated to their original places.
+is relocated to its original place.
However, it is convenient to locate a mark at the end of the newly
inserted text and locate point at its beginning. The @code{newmark}
@@ -6685,8 +6685,8 @@ restored just before the completion of the function by the
@code{save-restriction} special form.
The call to @code{widen} is followed by @code{save-excursion}, which
-saves the location of the cursor (i.e., of point) and of the mark, and
-restores them after the code in the body of the @code{save-excursion}
+saves the location of the cursor (i.e., of point), and
+restores it after the code in the body of the @code{save-excursion}
uses the @code{beginning-of-line} function to move point.
(Note that the @code{(widen)} expression comes between the
@@ -6757,8 +6757,8 @@ it, and @code{count-lines} counts only the lines
@emph{before} the
current line.
After @code{count-lines} has done its job, and the message has been
-printed in the echo area, the @code{save-excursion} restores point and
-mark to their original positions; and @code{save-restriction} restores
+printed in the echo area, the @code{save-excursion} restores point to
+its original position; and @code{save-restriction} restores
the original narrowing, if any.
@node narrow Exercise
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 3644d40..c24bb64 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,28 @@
+2015-03-29 Glenn Morris <address@hidden>
+
+ * objects.texi (Equality Predicates): Fix typo in example.
+
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * positions.texi (Excursions, Narrowing): `save-excursion' does not
+ save&restore the mark any more.
+
+2015-03-24 Paul Eggert <address@hidden>
+
+ * numbers.texi (Float Basics): Improve ldexp documentation.
+
+2015-03-23 Eli Zaretskii <address@hidden>
+
+ * commands.texi (Event Input Misc): Fix incorrect usage of @code.
+ (Bug#20174)
+ (Accessing Mouse): Expand documentation of 'posn-actual-col-row'.
+ (Bug#20169)
+ More accurate description of 'posn-object-x-y'. (Bug#20168)
+
+2015-03-23 Daiki Ueno <address@hidden>
+
+ * processes.texi (Asynchronous Processes): Mention `make-process'.
+
2015-03-18 Eli Zaretskii <address@hidden>
* minibuf.texi (Basic Completion): Fix a typo. (Bug#20108)
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index b81d0f8..5e986de 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2085,7 +2085,13 @@ Return the actual row and column in @var{position}, as a
cons cell
@code{(@var{col} . @var{row})}. The values are the actual row and
column numbers in the window given by @var{position}. @xref{Click
Events}, for details. The function returns @code{nil} if
address@hidden does not include actual position values.
address@hidden does not include actual position values; in that case
address@hidden can be used to get approximate values.
+
+Note that this function doesn't account for the visual width of
+characters on display, like the number of visual columns taken by a
+tab character or an image. If you need the coordinates in canonical
+character units, use @code{posn-col-row} instead.
@end defun
@defun posn-string position
@@ -2107,8 +2113,9 @@ Return the image or string object in @var{position},
either
@defun posn-object-x-y position
Return the pixel-based x and y coordinates relative to the upper left
corner of the object in @var{position} as a cons cell @code{(@var{dx}
-. @var{dy})}. If the @var{position} is a buffer position, return the
-relative position in the character at that position.
+. @var{dy})}. If the @var{position} is on buffer text, return the
+relative position of the buffer-text character closest to that
+position.
@end defun
@defun posn-object-width-height position
@@ -2811,7 +2818,7 @@ most recently unread will be reread first.
Events read from this list are not normally added to the current
command's key sequence (as returned by, e.g., @code{this-command-keys}),
as the events will already have been added once as they were read for
-the first time. An element of the form @code{(@code{t} . @var{event})}
+the first time. An element of the form @address@hidden(t . @var{event})}}
forces @var{event} to be added to the current command's key sequence.
@end defvar
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 8d1d3a7..7b4a0a6 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -265,9 +265,15 @@ If @var{x} is a NaN, then @var{s} is also a address@hidden
If @var{x} is zero, then @var{e} is 0.
@end defun
address@hidden ldexp sig &optional exp
-This function returns a floating-point number corresponding to the
-significand @var{sig} and exponent @var{exp}.
address@hidden ldexp s e
+Given a numeric significand @var{s} and an integer exponent @var{e},
+this function returns the floating point number
address@hidden
address@hidden * address@hidden
address@hidden ifnottex
address@hidden
address@hidden 2^e}.
address@hidden tex
@end defun
@defun copysign x1 x2
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index b28b3b0..f4beca8 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2135,12 +2135,12 @@ that for two strings to be equal, they have the same
text properties.
@example
@group
-(equal "asdf" (propertize "asdf" '(asdf t)))
+(equal "asdf" (propertize "asdf" 'asdf t))
@result{} t
@end group
@group
(equal-including-properties "asdf"
- (propertize "asdf" '(asdf t)))
+ (propertize "asdf" 'asdf t))
@result{} nil
@end group
@end example
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index b74116e..103161c 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -825,8 +825,8 @@ is zero or less.
It is often useful to move point ``temporarily'' within a localized
portion of the program. This is called an @dfn{excursion}, and it is
done with the @code{save-excursion} special form. This construct
-remembers the initial identity of the current buffer, and its values
-of point and the mark, and restores them after the excursion
+remembers the initial identity of the current buffer, and its value
+of point, and restores them after the excursion
completes. It is the standard way to move point within one part of a
program and avoid affecting the rest of the program, and is used
thousands of times in the Lisp sources of Emacs.
@@ -841,18 +841,18 @@ Configurations} and in @ref{Frame Configurations}. @c
frameset?
@cindex mark excursion
@cindex point excursion
This special form saves the identity of the current buffer and the
-values of point and the mark in it, evaluates @var{body}, and finally
-restores the buffer and its saved values of point and the mark. All
-three saved values are restored even in case of an abnormal exit via
+value of point in it, evaluates @var{body}, and finally
+restores the buffer and its saved value of point. both saved values are
+restored even in case of an abnormal exit via
@code{throw} or error (@pxref{Nonlocal Exits}).
The value returned by @code{save-excursion} is the result of the last
form in @var{body}, or @code{nil} if no body forms were given.
@end defspec
- Because @code{save-excursion} only saves point and mark for the
+ Because @code{save-excursion} only saves point for the
buffer that was current at the start of the excursion, any changes
-made to point and/or mark in other buffers, during the excursion, will
+made to point in other buffers, during the excursion, will
remain in effect afterward. This frequently leads to unintended
consequences, so the byte compiler warns if you call @code{set-buffer}
during an excursion:
@@ -888,11 +888,6 @@ type @code{nil}. @xref{Marker Insertion Types}.
Therefore, when the
saved point value is restored, it normally comes before the inserted
text.
- Although @code{save-excursion} saves the location of the mark, it does
-not prevent functions which modify the buffer from setting
address@hidden, and thus causing the deactivation of the mark
-after the command finishes. @xref{The Mark}.
-
@node Narrowing
@section Narrowing
@cindex narrowing
@@ -980,7 +975,7 @@ restores the restrictions on the original buffer (the
buffer whose
restrictions it saved from), but it does not restore the identity of the
current buffer.
address@hidden does @emph{not} restore point and the mark; use
address@hidden does @emph{not} restore point; use
@code{save-excursion} for that. If you use both @code{save-restriction}
and @code{save-excursion} together, @code{save-excursion} should come
first (on the outside). Otherwise, the old point value would be
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 177cd68..3e9cc50 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -692,6 +692,61 @@ use the function @code{process-tty-name} (@pxref{Process
Information}).
@end defvar
address@hidden make-process &rest args
+This function is like @code{start-process}, but takes keyword arguments.
+
+The arguments @var{args} are a list of keyword/argument pairs.
+Omitting a keyword is always equivalent to specifying it with value
address@hidden Here are the meaningful keywords:
+
address@hidden @asis
address@hidden :name @var{name}
+Use the string @var{name} as the process name. It is modified if
+necessary to make it unique.
+
address@hidden :buffer @var{buffer}
+Use @var{buffer} as the process buffer.
+
address@hidden :command @var{command}
+Use @var{command} as the command line of the process. @var{command}
+is a list starting with the program's executable file name, followed
+by strings to give to program as arguments.
+
address@hidden :coding @var{coding}
+If @var{coding} is a symbol, it specifies the coding system to be
+used for both reading and writing of data from and to the
+connection. If @var{coding} is a cons cell
address@hidden@code{(@var{decoding} . @var{encoding})}}, then @var{decoding}
+will be used for reading and @var{encoding} for writing.
+
+If @var{coding} is @code{nil}, the default rules for finding the
+coding system will apply. @xref{Default Coding Systems}.
+
address@hidden :connection-type @var{TYPE}
+Initialize the type of device used to communicate with the subprocess.
+Possible values are @code{pty} to use a pty, @code{pipe} to use a
+pipe, or @code{nil} to use the default derived from the value of
+the @code{process-connection-type} variable.
+
address@hidden :noquery @var{query-flag}
+Initialize the process query flag to @var{query-flag}.
address@hidden Before Exit}.
+
address@hidden :stop @var{stopped}
+If @var{stopped} is address@hidden, start the process in the
+``stopped'' state.
+
address@hidden :filter @var{filter}
+Initialize the process filter to @var{filter}.
+
address@hidden :sentinel @var{sentinel}
+Initialize the process sentinel to @var{sentinel}.
address@hidden table
+
+The original argument list, modified with the actual connection
+information, is available via the @code{process-contact} function.
address@hidden defun
+
@node Deleting Processes
@section Deleting Processes
@cindex deleting processes
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 62f5651..2fd0d2c 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,10 +1,19 @@
+2015-03-25 Glenn Morris <address@hidden>
+
+ * newsticker.texi (Supported Formats): Remove dead url.
+
+ * remember.texi (Function Reference): Copyedit.
+
+ * idlwave.texi (HTML Help Browser Tips): Remove obsolete info.
+
2015-03-18 Eli Zaretskii <address@hidden>
* efaq-w32.texi: Remove outdated information and update.
2015-03-18 Martin Rudalics <address@hidden>
- * efaq.texi (Fullscreen mode on MS-Windows): Fix description
(Bug#20110).
+ * efaq.texi (Fullscreen mode on MS-Windows):
+ Fix description (Bug#20110).
2015-03-04 Michael Albinus <address@hidden>
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index d95fa7e..ab5eb06 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -1091,9 +1091,7 @@ Normally Emacs should initialize
@code{locale-coding-system} appropriately
based on your locale, which will let Emacs use font names in your local
language successfully.
address@hidden This feature disappeared in Emacs 23, but I'm keeping its
address@hidden description here, since I think it was a mistake to remove it,
and
address@hidden resurrecting it doesn't sound too problematic.
address@hidden This feature disappeared in Emacs 23, and was resurrected in
25.1.
@node Font menu
@section How can I have Emacs use a font menu like on X?
@cindex fonts, displaying a menu
@@ -1111,8 +1109,8 @@ Place the following in your init file:
* Add fonts to menu::
@end menu
address@hidden This variable still exists, but will have no effect until
address@hidden w32-use-w32-font-dialog support is resurrected, see above.
address@hidden This variable had no effect between v23 and v25.1, where
address@hidden w32-use-w32-font-dialog support was resurrected, see above.
@node Add fonts to menu
@subsection How can I add my font to the font menu?
@cindex font menu, adding fonts
diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi
index 7cf9673..496674c 100644
--- a/doc/misc/idlwave.texi
+++ b/doc/misc/idlwave.texi
@@ -3800,31 +3800,25 @@ available, it is the preferred choice, and the default.
The variable
whether this help browser is used. If you use the IDL Assistant, the
tips here are not relevant.
-Since IDLWAVE runs on a many different system types, a single browser
-configuration is not possible, but choices abound. On many systems,
-the default browser configured in @code{browse-url-browser-function},
-and hence inherited by default by
address@hidden, is Netscape. Unfortunately, the
-HTML manuals decompiled from the original source contain formatting
-structures which Netscape 4.x does not handle well, though they are
-still readable. A much better choice is Mozilla, or one of the
-Mozilla-derived browsers such as
address@hidden://galeon.sourceforge.net/,Galeon} (GNU/Linux),
address@hidden://www.mozilla.org/projects/camino/,Camino} (MacOSX), or
address@hidden://www.mozilla.org/projects/firebird/,Firebird} (all
-platforms). Newer versions of Emacs provide a browser-function choice
address@hidden which uses the Gnome-configured browser.
+Since IDLWAVE runs on many different system types, a single browser
+configuration is not possible, but choices abound. The default
address@hidden inherits the browser configured
+in @code{browse-url-browser-function}.
Note that the HTML files decompiled from the help sources contain
specific references to the @samp{Symbol} font, which by default is not
permitted in normal encodings (it's invalid, technically). Though it
only impacts a few symbols, you can trick Mozilla-based browsers into
recognizing @samp{Symbol} by following the directions
address@hidden This page is 11 years old. Is it still relevant?
@uref{http://hutchinson.belmont.ma.us/tth/Xfonts.html, here}. With
this fix in place, HTML help pages look almost identical to their PDF
equivalents (yet can be bookmarked, browsed as history, searched,
etc.).
address@hidden Not updated in over a decade.
address@hidden Maybe you want to recommend eww these days.
address@hidden
@noindent Individual platform recommendations:
@itemize @bullet
@@ -3861,6 +3855,7 @@ following, to get consistent behavior with the @kbd{q}
key:
Note that you can open the file in an external browser from within
@code{w3m} using @kbd{M}.
@end itemize
address@hidden ignore
@node Configuration Examples
@appendix Configuration Examples
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index aa1ad72..0520a4e 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -590,8 +590,7 @@ Newsticker works with the standard RSS and Atom formats
listed below
@subheading RSS formats
@itemize
address@hidden RSS 0.91 (see @uref{http://backend.userland.com/rss091} or
address@hidden://my.netscape.com/publish/formats/rss-spec-0.91.html})
address@hidden RSS 0.91 (see @uref{http://backend.userland.com/rss091})
@item RSS 0.92 (see @uref{http://backend.userland.com/rss092})
@item RSS 1.0 (see @uref{http://purl.org/rss/1.0/spec})
@item RSS 2.0 (see @uref{http://blogs.law.harvard.edu/tech/rss})
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index ff481b7..c0d2ba3 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -270,7 +270,7 @@ that region, will be remembered.
@defun remember-clipboard
Remember the contents of the current clipboard. This is most useful
-for remembering things from Netscape or other X Windows applications.
+for remembering things from a web browser or other X Windows applications.
@end defun
@defun remember-finalize
diff --git a/etc/ChangeLog b/etc/ChangeLog
index cd5c540..f0da3a5 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,20 @@
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * TODO: Remove obsolete entries.
+
+2015-03-24 Daniel Colascione <address@hidden>
+
+ * NEWS: Mention change to `process-running-child-p`.
+
+2015-03-23 Daiki Ueno <address@hidden>
+
+ * NEWS: Mention `make-process'.
+
+2015-03-21 Titus von der Malsburg <address@hidden>
+
+ * NEWS: Mention `default-font-width', `window-font-height',
+ `window-font-width', and `window-max-chars-per-line'.
+
2015-03-03 Kelvin White <address@hidden>
* NEWS.24: Add section to include ERC changes.
diff --git a/etc/NEWS b/etc/NEWS
index cabd008..6de8f03 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -173,6 +173,24 @@ possible inaccuracies in the end position.
In particular, it now returns the average width of the font's
characters, which can be used for geometry-related calculations.
+** A new function `default-font-width' returns the average width of a
+character in the current buffer's default font. If the default face
+is remapped (see `face-remapping-alist'), the value for the remapped
+face is returned. This function complements the existing function
+`default-font-height'.
+
+** New functions `window-font-height' and `window-font-width' return
+the height and average width of characters in a specified face and
+window. If FACE is remapped (see `face-remapping-alist'), the
+function returns the information for the remapped face.
+
+** A new function `window-max-chars-per-line' returns the maximal
+number of characters that can be displayed on one line. If a face
+and/or window are provided, these values are used for the
+calculation. This function is different from `window-body-width' in
+that it accounts for (i) continuation glyphs, (ii) the size of the
+font, and (iii) the specified window.
+
* Editing Changes in Emacs 25.1
@@ -197,8 +215,13 @@ Unicode standards.
** You can access `mouse-buffer-menu' (C-down-mouse-1) using C-f10.
++++
+** New buffer-local `electric-pair-local-mode'.
+
* Changes in Specialized Modes and Packages in Emacs 25.1
+** xterm-mouse-mode now supports mouse-tracking (if your xterm supports it).
+
** package.el
*** `package-install-from-buffer' and `package-install-file' work on
directories.
This follows the same rules as installing from a .tar file, except the
@@ -328,7 +351,7 @@ invalid certificates are marked in red.
transformed into multipart/related messages before sending.
** pcase
-*** New UPatterns `quote' and `app'.
+*** New UPatterns `quote', `app', `cl-struct', and `eieio'.
*** New UPatterns can be defined with `pcase-defmacro'.
+++
*** New vector QPattern.
@@ -562,7 +585,10 @@ command line's password prompt.
** Browse-url
-*** browse-url now supports the Conkeror Web Browser.
+*** Support for the Conkeror web browser.
+
+---
+*** Support for several ancient browsers is now officially obsolete.
+++
** tar-mode: new `tar-new-entry' command, allowing for new members to
@@ -594,6 +620,8 @@ a typographically-correct documents.
* Incompatible Lisp Changes in Emacs 25.1
+** `save-excursion' does not save&restore the mark any more.
+
** read-buffer-function can now be called with a 4th argument (`predicate').
** completion-table-dynamic stays in the minibuffer.
@@ -610,6 +638,9 @@ active region handling.
** `cl-the' now asserts that its argument is of the given type.
+** `process-running-child-p` may now return a numeric process
+group ID instead of `t'.
+
+++
** Mouse click events on mode line or header line no longer include
any reference to a buffer position. The 6th member of the mouse
@@ -633,6 +664,11 @@ word syntax, use `\sw' instead.
* Lisp Changes in Emacs 25.1
+** New function `make-process' provides an alternative interface to
+`start-process'. It allows programs to set process parameters such as
+process filter, sentinel, etc., through keyword arguments (similar to
+`make-network-process').
+
** `read-buffer' takes a new `predicate' argument.
** Emacs Lisp now supports generators.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 2ab85b3..87d3ec8 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1,7 +1,6 @@
Known Problems with GNU Emacs
-Copyright (C) 1987-1989, 1993-1999, 2001-2015 Free Software Foundation,
-Inc.
+Copyright (C) 1987-1989, 1993-1999, 2001-2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
@@ -458,6 +457,29 @@ problem by adding this to your .cshrc file:
endif
endif
+*** Emacs startup on GNU/Linux systems (and possibly other systems) is slow.
+
+This can happen if the system is misconfigured and Emacs can't get the
+full qualified domain name, FQDN. You should have your FQDN in the
+/etc/hosts file, something like this:
+
+127.0.0.1 localhost
+129.187.137.82 nuc04.t30.physik.tu-muenchen.de nuc04
+
+The way to set this up may vary on non-GNU systems.
+
+*** Visiting files in some auto-mounted directories causes Emacs to print
+`Error reading dir-locals: (file-error "Read error" "is a directory" ...'
+
+This can happen if the auto-mounter mistakenly reports that
+.dir-locals.el exists and is a directory. There is nothing Emacs can
+do about this, but you can avoid the issue by adding a suitable entry
+to the variable `locate-dominating-stop-dir-regexp'. For example, if
+the problem relates to "/smb/.dir-locals.el", set that variable
+to a new value where you replace "net\\|afs" with "net\\|afs\\|smb".
+(The default value already matches common auto-mount prefixes.)
+See http://lists.gnu.org/archive/html/help-gnu-emacs/2015-02/msg00461.html .
+
*** Attempting to visit remote files via ange-ftp fails.
If the error message is "ange-ftp-file-modtime: Specified time is not
diff --git a/etc/TODO b/etc/TODO
index 79996e2..2235431 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -416,9 +416,6 @@
http://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00034.html
** Allow frames(terminals) created by emacsclient to inherit their environment
from the emacsclient process.
-** Remove the default toggling behavior of minor modes when called from elisp
-rather than interactively. This a trivial one-liner in easy-mode.el.
-
** Give Tar mode all the features of Archive mode.
** Create a category of errors called `process-error'
@@ -427,9 +424,6 @@ rather than interactively. This a trivial one-liner in
easy-mode.el.
** Maybe reinterpret `parse-error' as a category of errors
and put some other errors under it.
-** A function to tell you the argument pattern of functions.
- See `function-arity' in http://www.loveshack.ukfsn.org/emacs/fx-misc.el.
-
** Make byte-compile warn when a doc string is too wide.
** Make byte-optimization warnings issue accurate line numbers.
@@ -495,9 +489,6 @@ rather than interactively. This a trivial one-liner in
easy-mode.el.
** Give start-process the ability to direct standard-error
output to a different filter.
-** Make desktop.el save the "frame configuration" of Emacs (in some
- useful sense).
-
** Give desktop.el a feature to switch between different named desktops.
** Add a cpio mode, more or less like tar mode.
@@ -523,23 +514,10 @@ rather than interactively. This a trivial one-liner in
easy-mode.el.
Check the assignments file for other packages which might go in and
have been missed.
-** Make keymaps a first-class Lisp object (this means a rewrite of
- keymap.c). What should it do apart from being opaque ?
- multiple inheritance ? faster where-is ? no more fix_submap_inheritance ?
- what else ?
-
-** Implement popular parts of the rest of the CL functions as compiler
- macros in cl-macs. [Is this still relevant now that cl-lib exists?]
-
** Make compiler warnings about functions that might be undefined at run time
smarter, so that they know which files are required by the file being
compiled and don't warn about functions defined in them.
-** Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
- but it's a valuable feature worth making more general.
- [Basic support added 2013/10:
- http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00904.html ]
-
** Split out parts of lisp.h.
** Update the FAQ.
@@ -547,11 +525,6 @@ rather than interactively. This a trivial one-liner in
easy-mode.el.
** Allow auto-compression-mode to use zlib calls if zlib is available.
[It's required for PNG, so may be linked anyhow.]
-** Add a --pristine startup flag which does -q --no-site-file plus
- ignoring X resources (Doze equivalents?) and most of the
- environment. What should not be ignored needs consideration.
- [Do the existing -Q and -D cover this, or is more needed?]
-
** Improve the GC (generational, incremental). (We may be able to use
the Boehm collector.) [See the Boehm-GC branch in CVS for work on this.]
@@ -578,20 +551,9 @@ rather than interactively. This a trivial one-liner in
easy-mode.el.
(Requires recursing through display properties). Provide some way
to simulate mouse-clicks on marginal text without a mouse.
-** Implement Lisp functions to determine properly whether a character
- is displayable (particularly needed in XFree 4, sigh). Use it to
- define useful glyphs that may be displayed as images or unicodes
- (with ASCIIfied fallback via latin1-disp). Examples include
- box-drawing graphics in Custom buffers, W3 rules and tables, and
- tree displays generally, mode-line mail indicator. [See work done
- already for Emacs 23 and consult fx.]
-
** Extend ps-print to deal with multiple font sizes, images, and extra
encodings.
-** Make byte-compile avoid binding an expanded defsubst's args
- when the body only calls primitives.
-
** Use the XIE X extension, if available, for image display.
** Make monochrome images display using the foreground and background
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index 9786809..0bb24c3 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,14 @@
+2015-03-27 Paul Eggert <address@hidden>
+
+ Port etags to -DDEBUG
+ * etags.c (xnew, xrnew) [DEBUG]: Don't include chkmalloc.h, which
+ is not part of Emacs and is typically not installed.
+ Instead, just invoke xmalloc and xrealloc as usual.
+ Problem reported by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ (xrnew): Avoid no-longer-needed cast to 'char *'.
+ (xrealloc): First arg is now void *, not char *.
+
2015-03-06 Paul Eggert <address@hidden>
Random minor fixes for movemail
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 7f18755..b1361db 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -176,17 +176,8 @@ char pot_etags_version[] = "@(#) pot revision number is
17.38.1.4";
* SYNOPSIS: Type *xnew (int n, Type);
* void xrnew (OldPointer, int n, Type);
*/
-#if DEBUG
-# include "chkmalloc.h"
-# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \
- (n) * sizeof (Type)))
-# define xrnew(op,n,Type) ((op) = (Type *) trace_realloc (__FILE__, __LINE__, \
- (char *) (op), (n) * sizeof (Type)))
-#else
-# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type)))
-# define xrnew(op,n,Type) ((op) = (Type *) xrealloc ( \
- (char *) (op), (n) * sizeof (Type)))
-#endif
+#define xnew(n, Type) ((Type *) xmalloc ((n) * sizeof (Type)))
+#define xrnew(op, n, Type) ((op) = (Type *) xrealloc (op, (n) * sizeof (Type)))
typedef void Lang_function (FILE *);
@@ -348,7 +339,7 @@ static void canonicalize_filename (char *);
static void linebuffer_init (linebuffer *);
static void linebuffer_setlen (linebuffer *, int);
static void *xmalloc (size_t);
-static void *xrealloc (char *, size_t);
+static void *xrealloc (void *, size_t);
static char searchar = '/'; /* use /.../ searches */
@@ -6533,7 +6524,7 @@ xmalloc (size_t size)
}
static void *
-xrealloc (char *ptr, size_t size)
+xrealloc (void *ptr, size_t size)
{
void *result = realloc (ptr, size);
if (result == NULL)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index df2211b..2092447 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,362 @@
+2015-04-01 Alan Mackenzie <address@hidden>
+
+ Fix the CC Mode fixes from 2015-03-30. Fixes debbugs#20240.
+
+ * progmodes/cc-mode.el (c-extend-after-change-region): Widen
+ before applying text properties.
+ * progmodes/cc-langs.el (c-before-font-lock-functions): Update an
+ entry to a new function name.
+
+2015-04-01 Paul Eggert <address@hidden>
+
+ * emacs-lisp/package.el: Spelling fixes and use active voice.
+
+2015-04-01 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/package.el: Implement asynchronous refreshing.
+ (package--with-work-buffer-async)
+ (package--check-signature-content)
+ (package--update-downloads-in-progress): New functions.
+ (package--check-signature, package--download-one-archive)
+ (package--download-and-read-archives, package-refresh-contents):
+ Optional arguments for async usage.
+ (package--post-download-archives-hook): New variable. Hook run
+ after every refresh.
+
+ * emacs-lisp/package.el: Make package-menu asynchronous.
+ (package-menu-async): New variable. Controls whether
+ `list-packages' is asynchronous.
+ (list-packages): Now asynchronous by default.
+ (package-menu--new-package-list): Always buffer-local.
+ (package-menu--post-refresh)
+ (package-menu--find-and-notify-upgrades)
+ (package-menu--populate-new-package-list): New functions.
+
+2015-03-31 Simen Heggestøyl <address@hidden>
+
+ * textmodes/css-mode.el (css-mode): Derive from `prog-mode'.
+
+2015-03-31 Stefan Monnier <address@hidden>
+
+ * jit-lock.el (jit-lock--run-functions): Fix min/max copy&paste error.
+
+ Let jit-lock know the result of font-lock-extend-region-functions.
+ * jit-lock.el (jit-lock--run-functions): New function.
+ (jit-lock-fontify-now): Use it. Handle fontification bounds more
+ precisely in case the backend functions fontify more than requested.
+ Don't round up to whole lines since that shouldn't be needed
+ any more.
+ * font-lock.el (font-lock-fontify-region-function): Adjust docstring.
+ (font-lock-inhibit-thing-lock): Make obsolete.
+ (font-lock-default-fontify-region): Return the bounds actually used.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
+ Fix compilation error.
+
+2015-03-30 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/package.el: Reorganize package.el and divide it with
+ page-breaks and comments.
+
+2015-03-30 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/eieio-base.el (make-instance) <eieio-named>: New instance
+ which stores the old-style object name argument into the
+ object-name field.
+
+2015-03-30 Alan Mackenzie <address@hidden>
+
+ Correct calculation of CC Mode's font-lock region.
+
+ * progmodes/cc-mode.el (c-fl-decl-start): Rename from
+ c-set-fl-decl-start. Change signature such that nil is returned
+ when no declaration is found.
+ (c-change-expand-fl-region): Rename from
+ c-change-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-context-expand-fl-region): Rename from
+ c-context-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-font-lock-fontify-region): When a change font lock region is
+ spuriously enlarged to the beginning-of-line by jit-lock, fontify
+ the extra bit separately from the region calculated by CC Mode.
+ (c-extend-after-change-region): Explicitly apply 'fontified
+ properties to the extended bits of the font lock region.
+
+ * progmodes/cc-langs.el (c-before-font-lock-functions)
+ (c-before-context-fontification-functions): Use new names for
+ existing functions (see above).
+
+2015-03-30 Richard Ryniker <address@hidden> (tiny change)
+
+ * mail/sendmail.el (sendmail-send-it): Do not attempt to switch
+ to non-existent buffer (errbuf is not created when customization
+ variable mail-interactive is nil). (Bug#20211)
+
+2015-03-29 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/smie.el (smie-backward-sexp-command)
+ (smie-forward-sexp-command): Don't pretend the arg is optional
+ (bug#20205).
+
+2015-03-29 Dmitry Gutov <address@hidden>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Detect regexps after `!'. (Bug#19285)
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Use `font-lock-constant-face' for nil, true and false.
+ Highlight `self' as a keyword. (Bug#17733)
+
+2015-03-29 Nobuyoshi Nakada <address@hidden>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Expect beginning of regexp also after open brace or vertical bar.
+ (Bug#20026)
+
+2015-03-28 Jan Djärv <address@hidden>
+
+ * emacs-lisp/package.el (package-refresh-contents): Fix spelling
+ error in previous change.
+
+2015-03-28 Tom Willemse <address@hidden> (tiny change)
+
+ * elec-pair.el (electric-pair-local-mode): New command.
+ (electric-pair-mode): Mention `electric-pair-local-mode' in the
+ docstring.
+
+2015-03-28 Jan Djärv <address@hidden>
+
+ * emacs-lisp/package.el (package-refresh-contents): Add a message at
+ the end so it does not appear to have hanged (Bug#17879).
+
+2015-03-27 Wolfgang Jenkner <address@hidden>
+
+ * font-lock.el (font-lock--remove-face-from-text-property):
+ New function. Adapted from the previously commented out
+ remove-single-text-property.
+ Remove previously unused and commented out auxiliary function
+ remove-text-property and obsolete comment.
+ * comint.el (comint-output-filter): Use it to remove
+ comint-highlight-prompt.
+ (comint-snapshot-last-prompt, comint-output-filter):
+ Use font-lock-prepend-text-property for comint-highlight-prompt.
+ (Bug#20084)
+
+2015-03-26 Daniel Colascione <address@hidden>
+ * progmodes/python.el
+ (python-indent-guess-indent-offset-verbose): New defcustom.
+ (python-indent-guess-indent-offset): Use it.
+
+2015-03-26 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/eieio.el (defclass): Change internal name so as to make
+ sure only EIEIO files should have "eieio--" prefixes in their .elc.
+
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Silence byte-compiler.
+
+2015-03-26 Boruch Baum <address@hidden> (tiny change)
+
+ * bookmark.el (bookmark-show-all-annotations): Sort them (bug#20177).
+
+2015-03-25 Dmitry Gutov <address@hidden>
+
+ * json.el (json-special-chars): Don't treat `/' specially, there's
+ no need to.
+ (json-encode-string): Only escape quotation mark, backslash and
+ the control characters U+0000 to U+001F.
+
+2015-03-25 Artur Malabarba <address@hidden>
+
+ * emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
+ Don't complain about args starting with _.
+
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * international/mule-cmds.el (mule--ucs-names-annotation): New func.
+ (read-char-by-name): Use it.
+
+ * xt-mouse.el (xterm-mouse--read-number-from-terminal): Fix last commit.
+
+2015-03-25 Nicolas Petton <address@hidden>
+
+ * emacs-lisp/seq.el: Documentation improvements.
+
+2015-03-25 Glenn Morris <address@hidden>
+
+ * net/browse-url.el (browse-url-browser-function)
+ (browse-url-default-browser):
+ Remove obsolete items from the explicit listing.
+ (browse-url-new-window-flag, browse-url-of-file-hook): Doc fixes.
+ (browse-url-netscape-program, browse-url-netscape-arguments)
+ (browse-url-netscape-startup-arguments)
+ (browse-url-galeon-program, browse-url-galeon-arguments)
+ (browse-url-galeon-startup-arguments)
+ (browse-url-gnome-moz-program, browse-url-gnome-moz-arguments)
+ (browse-url-galeon-new-window-is-tab)
+ (browse-url-netscape-new-window-is-tab)
+ (browse-url-mosaic-program, browse-url-mosaic-arguments)
+ (browse-url-mosaic-pidfile, browse-url-CCI-port)
+ (browse-url-CCI-host, browse-url-netscape-version)
+ (browse-url-netscape, browse-url-netscape-sentinel)
+ (browse-url-netscape-reload, browse-url-netscape-send)
+ (browse-url-galeon, browse-url-galeon-sentinel)
+ (browse-url-gnome-moz, browse-url-mosaic, browse-url-cci)
+ (browse-url-w3-gnudoit): Make obsolete.
+ * ffap.el (ffap-url-fetcher): Simplify default and doc.
+
+2015-03-25 Olaf Rogalsky <address@hidden>
+
+ * xt-mouse.el: Add mouse-tracking support (bug#19416).
+ (xterm-mouse-translate-1): Handle mouse-movement events.
+ (xterm-mouse--read-event-sequence-1000)
+ (xterm-mouse--read-event-sequence-1006): Delete functions.
+ (xterm-mouse--read-event-sequence): New function that handles both at
+ the same time. Handle mouse-movements.
+ (xterm-mouse--read-utf8-char, xterm-mouse--read-number-from-terminal):
+ New functions.
+ (xterm-mouse-event): Simplify.
+ (xterm-mouse-tracking-enable-sequence)
+ (xterm-mouse-tracking-disable-sequence): Enable mouse tracking.
+
+ * mouse.el (mouse-drag-line): Also ignore `vertical-line' prefix events.
+
+2015-03-24 Michael Albinus <address@hidden>
+
+ * net/tramp-sh.el (tramp-do-file-attributes-with-ls)
+ (tramp-do-file-attributes-with-stat): Quote file names in output.
+ (tramp-do-directory-files-and-attributes-with-stat): Use "//" as marker.
+
+2015-03-24 Daiki Ueno <address@hidden>
+
+ * epg.el (epg-start-generate-key): Fix typo in "gpg --gen-key"
+ invocation; make the PARAMETERS documentation clearer.
+
+2015-03-24 Stefan Monnier <address@hidden>
+
+ Add cl-struct specific optimizations to pcase.
+ * emacs-lisp/cl-macs.el (cl--struct-all-parents)
+ (cl--pcase-mutually-exclusive-p): New functions.
+ (pcase--mutually-exclusive-p): Advise to optimize cl-struct patterns.
+
+ * emacs-lisp/pcase.el (pcase--split-pred): Handle quoted string.
+
+2015-03-23 Stefan Monnier <address@hidden>
+
+ Add new `cl-struct' and `eieio' pcase patterns.
+ * emacs-lisp/cl-macs.el (cl-struct): New pcase pattern.
+ * emacs-lisp/eieio.el (eieio-pcase-slot-index-table)
+ (eieio-pcase-slot-index-from-index-table): New functions.
+ (eieio): New pcase pattern.
+ * emacs-lisp/pcase.el (pcase--make-docstring): New function.
+ (pcase): Use it to build the docstring.
+ (pcase-defmacro): Make sure the macro is lazy-loaded.
+ (\`): Move its docstring from `pcase'.
+
+2015-03-23 Glenn Morris <address@hidden>
+
+ * emacs-lisp/authors.el (authors-aliases)
+ (authors-obsolete-files-regexps): Additions.
+
+2015-03-23 Jan Djärv <address@hidden>
+
+ * simple.el (deactivate-mark): Only modify PRIMARY if we own
+ PRIMARY (Bug#18939).
+
+2015-03-23 Martin Rudalics <address@hidden>
+
+ * emacs-lisp/debug.el (debug): Don't try using "previous" window
+ when its not live or on an invisible frame (Bug#17170).
+
+2015-03-23 Dmitry Gutov <address@hidden>
+
+ * json.el (json-decode-char0): Delete this alias as well.
+ (json-read-escaped-char): Don't call it (bug#20154).
+
+2015-03-23 Daniel Colascione <address@hidden>
+
+ * emacs-lisp/lisp-mode.el (lisp--el-non-funcall-position-p): New
function.
+ (lisp--el-match-keyword): Use it.
+
+2015-03-23 Daiki Ueno <address@hidden>
+
+ * subr.el (start-process): New function, ported from the C
+ implementation.
+
+2015-03-23 Daniel Colascione <address@hidden>
+
+ Automatically adjust process window sizes.
+
+ * window.el (window-adjust-process-window-size-function):
+ New customizable variable.
+ (window-adjust-process-window-size)
+ (window-adjust-process-window-size-smallest)
+ (window-adjust-process-window-size-largest)
+ (window--process-window-list, window--adjust-process-windows):
+ New functions.
+ (window-configuration-change-hook):
+ Add `window--adjust-process-windows'.
+ * term.el (term-mode): Observe result of
+ `window-adjust-process-window-size-function'.
+ (term-check-size): Delete.
+
+2015-03-22 Jackson Ray Hamilton <address@hidden>
+
+ * textmodes/sgml-mode.el (sgml-attribute-offset): New defcustom.
+ (sgml-calculate-indent): Use `sgml-attribute-offset' for attribute
+ indentation (bug#20161).
+
+2015-03-22 Dmitry Gutov <address@hidden>
+
+ * json.el (json-encode-char0): Delete this alias.
+ (json-encode-string): Rewrite to improve performance (bug#20154).
+ (json-encode-char): Fold into `json-encode-string'.
+
+2015-03-22 Artur Malabarba <address@hidden>
+
+ * menu-bar.el (menu-bar-update-buffers): Count displayed buffers
+ for `buffers-menu-max-size', not total buffers.
+
+2015-03-21 Titus von der Malsburg <address@hidden>
+
+ * window.el (window-font-width, window-font-height)
+ (window-max-chars-per-line): New functions.
+
+ * simple.el (default-font-height): Doc fix.
+ (default-font-width): New function.
+
+2015-03-21 Tassilo Horn <address@hidden>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Also recognize (cl-)defmethod with (setf method) name.
+
+2015-03-20 Tassilo Horn <address@hidden>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Fix false positive in function name font-locking.
+ (lisp-cl-font-lock-keywords-1): Ditto.
+
+2015-03-20 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/cl-macs.el (cl-defsubst): Ignore false-positive
+ occurrences of args via &cl-defs (bug#20149).
+
+2015-03-20 Alan Mackenzie <address@hidden>
+
+ Fix debbugs#20146
+
+ * font-lock.el (font-lock-extend-jit-lock-region-after-change):
+ Return the calculated values, as per spec.
+
+2015-03-20 Dmitry Gutov <address@hidden>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `at_exit'
+ and `callcc' to the "methods with required arguments" section,
+ they need a block argument. Remove a `throw' duplicate.
+
2015-03-19 Vibhav Pant <address@hidden>
- * lisp/progmodes/cperl-mode.el (cperl-electric-backspace):
+ * progmodes/cperl-mode.el (cperl-electric-backspace):
Call delete-backward-space interactively instead of delete-char.
2015-03-19 Stefan Monnier <address@hidden>
@@ -67,9 +423,9 @@
2015-03-19 Vibhav Pant <address@hidden>
- * lisp/leim/quail/hangul.el (hangul-delete-backward-char)
+ * leim/quail/hangul.el (hangul-delete-backward-char)
(hangul-to-hanja-conversion):
- * lisp/progmodes/cperl-mode.el (cperl-electric-keyword)
+ * progmodes/cperl-mode.el (cperl-electric-keyword)
(cperl-electric-backspace): Use delete-char instead of
delete-backward-char, fixes compilation warnings.
@@ -109,7 +465,7 @@
2015-03-18 Dima Kogan <address@hidden>
Have gud-display-line not display source buffer in gud window.
- * lisp/progmodes/gud.el (gud-display-line): Make display-buffer
+ * progmodes/gud.el (gud-display-line): Make display-buffer
not reuse selected window. (Bug#17675, Bug#19901, Bug#20034)
2015-03-17 Tassilo Horn <address@hidden>
@@ -1761,7 +2117,7 @@
2015-01-30 Oleh Krehel <address@hidden>
- * lisp/custom.el (defface): Set `indent' to 1.
+ * custom.el (defface): Set `indent' to 1.
2015-01-30 Oleh Krehel <address@hidden>
@@ -1769,21 +2125,21 @@
2015-01-30 Michal Nazarewicz <address@hidden>
- * lisp/files.el (save-buffers-kill-emacs): If `confirm-kill-emacs'
+ * files.el (save-buffers-kill-emacs): If `confirm-kill-emacs'
is set, but user has just been asked whether they really want to
kill Emacs (for example with a ‘Modified buffers exist; exit
anyway?’ prompt), do not ask them for another confirmation.
2015-01-29 Jay Belanger <address@hidden>
- * lisp/calc/calc-units.el (calc-convert-exact-units): New function.
+ * calc/calc-units.el (calc-convert-exact-units): New function.
(calc-convert-units): Check for missing units.
(math-consistent-units-p): Strengthen the test for consistent units.
- * lisp/calc/calc-ext.el (calc-init-extensions): Autoload
+ * calc/calc-ext.el (calc-init-extensions): Autoload
`calc-convert-exact-units' and assign it a keybinding.
- * lisp/calc/calc-help (calc-u-prefix-help): Add help for the
+ * calc/calc-help (calc-u-prefix-help): Add help for the
"un" keybinding.
2015-01-28 Stefan Monnier <address@hidden>
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index a49ee7e..dc8057e 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1756,7 +1756,7 @@ if an annotation exists."
(save-selected-window
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
- (dolist (full-record bookmark-alist)
+ (dolist (full-record (bookmark-maybe-sort-alist))
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation full-record)))
(insert (concat name ":\n"))
diff --git a/lisp/comint.el b/lisp/comint.el
index b6944da..31649ff 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1930,10 +1930,10 @@ the start, the cdr to the end of the last prompt
recognized.")
Freezes the `font-lock-face' text property in place."
(when comint-last-prompt
(with-silent-modifications
- (add-text-properties
+ (font-lock-prepend-text-property
(car comint-last-prompt)
(cdr comint-last-prompt)
- '(font-lock-face comint-highlight-prompt)))
+ 'font-lock-face 'comint-highlight-prompt))
;; Reset comint-last-prompt so later on comint-output-filter does
;; not remove the font-lock-face text property of the previous
;; (this) prompt.
@@ -2084,14 +2084,19 @@ Make backspaces delete the previous character."
(add-text-properties prompt-start (point)
'(read-only t front-sticky
(read-only)))))
(when comint-last-prompt
- (remove-text-properties (car comint-last-prompt)
- (cdr comint-last-prompt)
- '(font-lock-face)))
+ (with-silent-modifications
+ (font-lock--remove-face-from-text-property
+ (car comint-last-prompt)
+ (cdr comint-last-prompt)
+ 'font-lock-face
+ 'comint-highlight-prompt)))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (add-text-properties prompt-start (point)
- '(rear-nonsticky t
- font-lock-face comint-highlight-prompt)))
+ (with-silent-modifications
+ (font-lock-prepend-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
+ (add-text-properties prompt-start (point) '(rear-nonsticky t))))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 2cede62..562b294 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -557,7 +557,8 @@ the mode if ARG is omitted or nil.
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. (Likewise for brackets, etc.)."
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'."
:global t :group 'electricity
(if electric-pair-mode
(progn
@@ -571,6 +572,19 @@ closing parenthesis. (Likewise for brackets, etc.)."
(remove-hook 'self-insert-uses-region-functions
#'electric-pair-will-use-region)))
+;;;###autoload
+(define-minor-mode electric-pair-local-mode
+ "Toggle `electric-pair-mode' only in this buffer."
+ :variable (buffer-local-value 'electric-pair-mode (current-buffer))
+ (cond
+ ((eq electric-pair-mode (default-value 'electric-pair-mode))
+ (kill-local-variable 'electric-pair-mode))
+ ((not (default-value 'electric-pair-mode))
+ ;; Locally enabled, but globally disabled.
+ (electric-pair-mode 1) ; Setup the hooks.
+ (setq-default electric-pair-mode nil) ; But keep it globally disabled.
+ )))
+
(provide 'elec-pair)
;;; elec-pair.el ends here
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index e0d6c3e..081ea31 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -393,7 +393,7 @@ ACCESS-TYPE if non-nil should specify the kind of access
that will trigger
This uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
-If CURRENT-NAME is a defcustom (more generally, any variable
+If CURRENT-NAME is a defcustom or a defvar (more generally, any variable
where OBSOLETE-NAME may be set, e.g. in an init file, before the
alias is defined), then the define-obsolete-variable-alias
statement should be evaluated before the defcustom, if user
@@ -407,7 +407,7 @@ variable (this is due to the way `defvaralias' works).
For the benefit of `custom-set-variables', if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
-'saved-value, 'saved-variable-comment."
+`saved-value', `saved-variable-comment'."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 288e25e..777fed0 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1663,14 +1663,15 @@ function,command,variable,option or symbol." ms1))))))
;; Addendum: Make sure they appear in the doc in the same
;; order that they are found in the arg list.
- (let ((args (cdr (cdr (cdr (cdr fp)))))
+ (let ((args (nthcdr 4 fp))
(last-pos 0)
(found 1)
(order (and (nth 3 fp) (car (nth 3 fp))))
(nocheck (append '("&optional" "&rest") (nth 3 fp)))
(inopts nil))
(while (and args found (> found last-pos))
- (if (member (car args) nocheck)
+ (if (or (member (car args) nocheck)
+ (string-match "\\`_" (car args)))
(setq args (cdr args)
inopts t)
(setq last-pos found
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 4b12495..10651cc 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -629,7 +629,6 @@ the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
-
;;; Generalized variables.
;; These used to be in cl-macs.el since all macros that use them (like setf)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d386678..f8ddc00 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1752,7 +1752,7 @@ An implicit nil block is established around the loop.
(declare (debug ((symbolp form &optional form) cl-declarations body))
(indent 1))
(let ((loop `(dolist ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dolist)
loop `(cl-block nil ,loop))))
;;;###autoload
@@ -1765,7 +1765,7 @@ nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist) (indent 1))
(let ((loop `(dotimes ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dotimes)
loop `(cl-block nil ,loop))))
(defvar cl--tagbody-alist nil)
@@ -2446,10 +2446,11 @@ 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))
+ (real-args (if (eq '&cl-defs (car args)) (cddr args) args))
(p argns)
;; (pbody (cons 'progn body))
)
- (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
+ (while (and p (eq (cl--expr-contains real-args (car p)) 1)) (pop p))
`(progn
,(if p nil ; give up if defaults refer to earlier args
`(cl-define-compiler-macro ,name
@@ -2767,6 +2768,72 @@ non-nil value, that slot cannot be set via `setf'.
',print-auto))
',name)))
+;;; Add cl-struct support to pcase
+
+(defun cl--struct-all-parents (class)
+ (when (cl--struct-class-p class)
+ (let ((res ())
+ (classes (list class)))
+ ;; BFS precedence.
+ (while (let ((class (pop classes)))
+ (push class res)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse res))))
+
+;;;###autoload
+(pcase-defmacro cl-struct (type &rest fields)
+ "Pcase patterns to match cl-structs.
+Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
+field NAME is matched against UPAT, or they can be of the form NAME which
+is a shorthand for (NAME NAME)."
+ `(and (pred (pcase--flip cl-typep ',type))
+ ,@(mapcar
+ (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field)))
+ `(app ,(if (eq (cl-struct-sequence-type type) 'list)
+ `(nth ,(cl-struct-slot-offset type name))
+ `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+ ,pat)))
+ fields)))
+
+(defun cl--pcase-mutually-exclusive-p (orig pred1 pred2)
+ "Extra special cases for `cl-typep' predicates."
+ (let* ((x1 pred1) (x2 pred2)
+ (t1
+ (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
+ (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (null (cdr-safe x1)) (setq x1 (car x1))
+ (eq 'quote (car-safe x1)) (cadr x1)))
+ (t2
+ (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
+ (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (null (cdr-safe x2)) (setq x2 (car x2))
+ (eq 'quote (car-safe x2)) (cadr x2))))
+ (or
+ (and (symbolp t1) (symbolp t2)
+ (let ((c1 (cl--find-class t1))
+ (c2 (cl--find-class t2)))
+ (and c1 c2
+ (not (or (memq c1 (cl--struct-all-parents c2))
+ (memq c2 (cl--struct-all-parents c1)))))))
+ (let ((c1 (and (symbolp t1) (cl--find-class t1))))
+ (and c1 (cl--struct-class-p c1)
+ (funcall orig (if (eq 'list (cl-struct-sequence-type t1))
+ 'consp 'vectorp)
+ pred2)))
+ (let ((c2 (and (symbolp t2) (cl--find-class t2))))
+ (and c2 (cl--struct-class-p c2)
+ (funcall orig pred1
+ (if (eq 'list (cl-struct-sequence-type t2))
+ 'consp 'vectorp))))
+ (funcall orig pred1 pred2))))
+(advice-add 'pcase--mutually-exclusive-p
+ :around #'cl--pcase-mutually-exclusive-p)
+
+
(defun cl-struct-sequence-type (struct-type)
"Return the sequence used to build STRUCT-TYPE.
STRUCT-TYPE is a symbol naming a struct type. Return 'vector or
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 8321328..ce5c786 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -192,8 +192,10 @@ first will be printed into the backtrace buffer."
debugger-buffer
`((display-buffer-reuse-window
display-buffer-in-previous-window)
- . (,(when debugger-previous-window
- `(previous-window . ,debugger-previous-window)))))
+ . (,(when (and (window-live-p debugger-previous-window)
+ (frame-visible-p
+ (window-frame debugger-previous-window)))
+ `(previous-window . ,debugger-previous-window)))))
(setq debugger-window (selected-window))
(if (eq debugger-previous-window debugger-window)
(when debugger-jumping-flag
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 5b3d902..2e28036 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -294,7 +294,8 @@ Second, any text properties will be stripped from strings."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
(let* ((slot-idx (- (eieio--slot-name-index class slot)
- (eval-when-compile eieio--object-num-slots)))
+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))))
(type (cl--slot-descriptor-type (aref (eieio--class-slots
class)
slot-idx)))
(classtype (eieio-persistent-slot-type-is-class-p type)))
@@ -498,6 +499,15 @@ All slots are unbound, except those initialized with
PARAMS."
(concat nm "-1")))))
nobj))
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
+
(provide 'eieio-base)
;;; eieio-base.el ends here
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 8d76df8..bca53c0 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -130,7 +130,7 @@ and reference them using the function `class-option'."
(error "Method invocation order %s is not allowed" io)))
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
- (testsym2 (intern (format "eieio--childp--%s" name)))
+ (testsym2 (intern (format "%s--eieio-childp" name)))
(accessors ()))
;; Collect the accessors we need to define.
@@ -328,6 +328,44 @@ variable name of the same name as the slot."
(list var `(slot-value ,object ',slot))))
spec-list)
,@body)))
+
+;; Keep it as a non-inlined function, so the internals of object don't get
+;; hard-coded in random .elc files.
+(defun eieio-pcase-slot-index-table (obj)
+ "Return some data structure from which can be extracted the slot offset."
+ (eieio--class-index-table
+ (symbol-value (eieio--object-class-tag obj))))
+
+(defun eieio-pcase-slot-index-from-index-table (index-table slot)
+ "Find the index to pass to `aref' to access SLOT."
+ (let ((index (gethash slot index-table)))
+ (if index (+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))
+ index))))
+
+(pcase-defmacro eieio (&rest fields)
+ "Pcase patterns to match EIEIO objects.
+Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
+field NAME is matched against UPAT, or they can be of the form NAME which
+is a shorthand for (NAME NAME)."
+ (let ((is (make-symbol "table")))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ (app eieio-pcase-slot-index-table ,is)
+ ,@(mapcar (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field))
+ (i (make-symbol "index")))
+ `(and (let (and ,i (pred natnump))
+ (eieio-pcase-slot-index-from-index-table
+ ,is ',name))
+ (app (pcase--flip aref ,i) ,pat))))
+ fields))))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 6b30773..4c9a39f 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -181,13 +181,50 @@
nil)))
res))
+(defun lisp--el-non-funcall-position-p (&optional pos)
+ "Heuristically determine whether POS is an evaluated position."
+ (setf pos (or pos (point)))
+ (save-match-data
+ (save-excursion
+ (ignore-errors
+ (goto-char pos)
+ (or (eql (char-before) ?\')
+ (let ((parent
+ (progn
+ (up-list -1)
+ (cond
+ ((ignore-errors
+ (and (eql (char-after) ?\()
+ (progn
+ (up-list -1)
+ (looking-at "(\\_<let\\*?\\_>"))))
+ (goto-char (match-end 0))
+ 'let)
+ ((looking-at
+ (rx "("
+ (group-n 1 (+ (or (syntax w) (syntax _))))
+ symbol-end))
+ (prog1 (intern-soft (match-string-no-properties 1))
+ (goto-char (match-end 1))))))))
+ (or (eq parent 'declare)
+ (and (eq parent 'let)
+ (progn
+ (forward-sexp 1)
+ (< pos (point))))
+ (and (eq parent 'condition-case)
+ (progn
+ (forward-sexp 2)
+ (< (point) pos))))))))))
+
(defun lisp--el-match-keyword (limit)
(catch 'found
(while (re-search-forward "(\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>" limit t)
(let ((sym (intern-soft (match-string 1))))
(when (or (special-form-p sym)
(and (macrop sym)
- (not (get sym 'no-font-lock-keyword))))
+ (not (get sym 'no-font-lock-keyword))
+ (not (lisp--el-non-funcall-position-p
+ (match-beginning 0)))))
(throw 'found t))))))
(defun lisp--el-font-lock-flush-elisp-buffers (&optional file)
@@ -249,7 +286,7 @@
(eieio-tdefs '("defclass"))
(eieio-kw '("with-slots"))
;; Common-Lisp constructs supported by cl-lib.
- (cl-lib-fdefs '("defmacro" "defsubst" "defun"))
+ (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
(cl-lib-tdefs '("defstruct" "deftype"))
(cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
"etypecase" "ccase" "ctypecase" "loop" "do" "do*"
@@ -320,14 +357,21 @@
`( ;; Definitions.
(,(concat "(" el-defs-re "\\_>"
;; Any whitespace and defined object.
- "[ \t'\(]*"
- "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[
\t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
(1 font-lock-keyword-face)
- (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
- (cond ((eq type 'var) font-lock-variable-name-face)
- ((eq type 'type) font-lock-type-face)
- (t font-lock-function-name-face)))
- nil t))
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (cond ((eq type 'var) font-lock-variable-name-face)
+ ((eq type 'type) font-lock-type-face)
+ ;; If match-string 2 is non-nil, we encountered a
+ ;; form like (defalias (intern (concat s "-p"))),
+ ;; unless match-string 4 is also there. Then its a
+ ;; defmethod with (setf foo) as name.
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf method.
+ (match-string 4))) font-lock-function-name-face)))
+ nil t))
;; Emacs Lisp autoload cookies. Supports the slightly different
;; forms used by mh-e, calendar, etc.
("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
@@ -337,13 +381,16 @@
`( ;; Definitions.
(,(concat "(" cl-defs-re "\\_>"
;; Any whitespace and defined object.
- "[ \t'\(]*"
- "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[
\t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
(1 font-lock-keyword-face)
- (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
(cond ((eq type 'var) font-lock-variable-name-face)
((eq type 'type) font-lock-type-face)
- (t font-lock-function-name-face)))
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf function.
+ (match-string 4))) font-lock-function-name-face)))
nil t)))
"Subdued level highlighting for Lisp modes.")
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 0d001bf..583598e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -173,6 +173,8 @@
:group 'applications
:version "24.1")
+
+;;; Customization options
;;;###autoload
(defcustom package-enable-at-startup t
"Whether to activate installed packages when Emacs starts.
@@ -204,12 +206,6 @@ If VERSION is nil, the package is not loaded (it is
\"disabled\")."
:group 'package
:version "24.1")
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-(declare-function url-http-file-exists-p "url-http" (url))
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/";))
"An alist of archives from which to fetch.
The default value points to the GNU Emacs package repository.
@@ -270,17 +266,6 @@ the package will be unavailable."
:group 'package
:version "24.4")
-(defconst package-archive-version 1
- "Version number of the package archive understood by this file.
-Lower version numbers than this will probably be understood as well.")
-
-;; We don't prime the cache since it tends to get out of date.
-(defvar package-archive-contents nil
- "Cache of the contents of the Emacs Lisp Package Archive.
-This is an alist mapping package names (symbols) to
-non-empty lists of `package-desc' structures.")
-(put 'package-archive-contents 'risky-local-variable t)
-
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
@@ -348,6 +333,14 @@ a sane initial value."
:group 'package
:type '(repeat symbol))
+
+;;; `package-desc' object definition
+;; This is the struct used internally to represent packages.
+;; Functions that deal with packages should generally take this object
+;; as an argument. In some situations (e.g. commands that query the
+;; user) it makes sense to take the package name as a symbol instead,
+;; but keep in mind there could be multiple `package-desc's with the
+;; same name.
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
@@ -419,7 +412,43 @@ Slots:
extras
signed)
+(defun package--from-builtin (bi-desc)
+ (package-desc-create :name (pop bi-desc)
+ :version (package--bi-desc-version bi-desc)
+ :summary (package--bi-desc-summary bi-desc)
+ :dir 'builtin))
+
;; Pseudo fields.
+(defun package-version-join (vlist)
+ "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+ (if (null vlist)
+ ""
+ (let ((str-list (list "." (int-to-string (car vlist)))))
+ (dolist (num (cdr vlist))
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -4)
+ (error "Invalid version list `%s'" vlist))
+ (t
+ ;; pre, or beta, or alpha
+ (cond ((equal "." (car str-list))
+ (pop str-list))
+ ((not (string-match "[0-9]+" (car str-list)))
+ (error "Invalid version list `%s'" vlist)))
+ (push (cond ((= num -1) "pre")
+ ((= num -2) "beta")
+ ((= num -3) "alpha")
+ ((= num -4) "snapshot"))
+ str-list))))
+ (if (equal "." (car str-list))
+ (pop str-list))
+ (apply 'concat (nreverse str-list)))))
+
(defun package-desc-full-name (pkg-desc)
(format "%s-%s"
(package-desc-name pkg-desc)
@@ -446,6 +475,13 @@ Slots:
reqs
summary)
+
+;;; Installed packages
+;; The following variables store information about packages present in
+;; the system. The most important of these is `package-alist'. The
+;; command `package-initialize' is also closely related to this
+;; section, but it is left for a later section because it also affects
+;; other stuff.
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
@@ -467,53 +503,33 @@ called via `package-initialize'. To change which
packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
-(defvar package--compatibility-table nil
- "Hash table connecting package names to their compatibility.
-Each key is a symbol, the name of a package.
-
-The value is either nil, representing an incompatible package, or
-a version list, representing the highest compatible version of
-that package which is available.
-
-A package is considered incompatible if it requires an Emacs
-version higher than the one being used. To check for package
-\(in)compatibility, don't read this table directly, use
-`package--incompatible-p' which also checks dependencies.")
-
(defvar package-activated-list nil
;; FIXME: This should implicitly include all builtin packages.
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
-(defun package-version-join (vlist)
- "Return the version string corresponding to the list VLIST.
-This is, approximately, the inverse of `version-to-list'.
-\(Actually, it returns only one of the possible inverses, since
-`version-to-list' is a many-to-one operation.)"
- (if (null vlist)
- ""
- (let ((str-list (list "." (int-to-string (car vlist)))))
- (dolist (num (cdr vlist))
- (cond
- ((>= num 0)
- (push (int-to-string num) str-list)
- (push "." str-list))
- ((< num -4)
- (error "Invalid version list `%s'" vlist))
- (t
- ;; pre, or beta, or alpha
- (cond ((equal "." (car str-list))
- (pop str-list))
- ((not (string-match "[0-9]+" (car str-list)))
- (error "Invalid version list `%s'" vlist)))
- (push (cond ((= num -1) "pre")
- ((= num -2) "beta")
- ((= num -3) "alpha")
- ((= num -4) "snapshot"))
- str-list))))
- (if (equal "." (car str-list))
- (pop str-list))
- (apply 'concat (nreverse str-list)))))
+;;;; Populating `package-alist'.
+;; The following functions are called on each installed package by
+;; `package-load-all-descriptors', which ultimately populates the
+;; `package-alist' variable.
+(defun package-process-define-package (exp)
+ (when (eq (car-safe exp) 'define-package)
+ (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
+ (name (package-desc-name new-pkg-desc))
+ (version (package-desc-version new-pkg-desc))
+ (old-pkgs (assq name package-alist)))
+ (if (null old-pkgs)
+ ;; If there's no old package, just add this to `package-alist'.
+ (push (list name new-pkg-desc) package-alist)
+ ;; If there is, insert the new package at the right place in the list.
+ (while
+ (if (and (cdr old-pkgs)
+ (version-list-< version
+ (package-desc-version (cadr old-pkgs))))
+ (setq old-pkgs (cdr old-pkgs))
+ (push new-pkg-desc (cdr old-pkgs))
+ nil)))
+ new-pkg-desc)))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
@@ -524,8 +540,9 @@ This is, approximately, the inverse of `version-to-list'.
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
- (let ((pkg-desc (package-process-define-package
- (read (current-buffer)) pkg-file)))
+ (let ((pkg-desc (or (package-process-define-package
+ (read (current-buffer)))
+ (error "Can't find define-package in %s"
pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
(if (file-exists-p signed-file)
(setf (package-desc-signed pkg-desc) t))
@@ -547,6 +564,24 @@ updates `package-alist'."
(when (file-directory-p pkg-dir)
(package-load-descriptor pkg-dir)))))))
+(defun define-package (_name-string _version-string
+ &optional _docstring _requirements
+ &rest _extra-properties)
+ "Define a new package.
+NAME-STRING is the name of the package, as a string.
+VERSION-STRING is the version of the package, as a string.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+ ;; FIXME: Placeholder! Should we keep it?
+ (error "Don't call me!"))
+
+
+;;; Package activation
+;; Section for functions used by `package-activate', which see.
(defun package-disabled-p (pkg-name version)
"Return whether PKG-NAME at VERSION can be activated.
The decision is made according to `package-load-list'.
@@ -562,6 +597,23 @@ Return the max version (as a string) if the package is
held at a lower version."
force))
(t (error "Invalid element in `package-load-list'")))))
+(defun package-built-in-p (package &optional min-version)
+ "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+ (if (package-desc-p package) ;; was built-in and then was converted
+ (eq 'builtin (package-desc-dir package))
+ (let ((bi (assq package package--builtin-versions)))
+ (cond
+ (bi (version-list-<= min-version (cdr bi)))
+ ((remove 0 min-version) nil)
+ (t
+ (require 'finder-inf nil t) ; For `package--builtins'.
+ (assq package package--builtins))))))
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+
(defun package-activate-1 (pkg-desc &optional reload)
"Activate package given by PKG-DESC, even if it was already active.
If RELOAD is non-nil, also `load' any files inside the package which
@@ -606,6 +658,7 @@ correspond to previously loaded files (those returned by
t))
(declare-function find-library-name "find-func" (library))
+
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
Returns the `file-name-sans-extension' of each file, relative to
@@ -640,33 +693,14 @@ DIR, sorted by most recently loaded last."
;; Sort the files by ascending HISTORY-POSITION.
(lambda (x y) (< (cdr x) (cdr y))))))))
-(defun package-built-in-p (package &optional min-version)
- "Return true if PACKAGE is built-in to Emacs.
-Optional arg MIN-VERSION, if non-nil, should be a version list
-specifying the minimum acceptable version."
- (if (package-desc-p package) ;; was built-in and then was converted
- (eq 'builtin (package-desc-dir package))
- (let ((bi (assq package package--builtin-versions)))
- (cond
- (bi (version-list-<= min-version (cdr bi)))
- ((remove 0 min-version) nil)
- (t
- (require 'finder-inf nil t) ; For `package--builtins'.
- (assq package package--builtins))))))
-
-(defun package--from-builtin (bi-desc)
- (package-desc-create :name (pop bi-desc)
- :version (package--bi-desc-version bi-desc)
- :summary (package--bi-desc-summary bi-desc)
- :dir 'builtin))
-
-;; This function goes ahead and activates a newer version of a package
-;; if an older one was already activated. This is not ideal; we'd at
-;; least need to check to see if the package has actually been loaded,
-;; and not merely activated.
+;;;; `package-activate'
+;; This function activates a newer version of a package if an older
+;; one was already activated. It also loads a features of this
+;; package which were already loaded.
(defun package-activate (package &optional force)
"Activate package PACKAGE.
-If FORCE is true, (re-)activate it if it's already activated."
+If FORCE is true, (re-)activate it if it's already activated.
+Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
@@ -698,76 +732,14 @@ Required package `%s-%s' is unavailable"
;; If all goes well, activate the package itself.
(package-activate-1 pkg-vec force)))))))
-(defun define-package (_name-string _version-string
- &optional _docstring _requirements
- &rest _extra-properties)
- "Define a new package.
-NAME-STRING is the name of the package, as a string.
-VERSION-STRING is the version of the package, as a string.
-DOCSTRING is a short description of the package, a string.
-REQUIREMENTS is a list of dependencies on other packages.
- Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
- where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
- ;; FIXME: Placeholder! Should we keep it?
- (error "Don't call me!"))
-
-(defun package-process-define-package (exp origin)
- (unless (eq (car-safe exp) 'define-package)
- (error "Can't find define-package in %s" origin))
- (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
- (name (package-desc-name new-pkg-desc))
- (version (package-desc-version new-pkg-desc))
- (old-pkgs (assq name package-alist)))
- (if (null old-pkgs)
- ;; If there's no old package, just add this to `package-alist'.
- (push (list name new-pkg-desc) package-alist)
- ;; If there is, insert the new package at the right place in the list.
- (while
- (if (and (cdr old-pkgs)
- (version-list-< version
- (package-desc-version (cadr old-pkgs))))
- (setq old-pkgs (cdr old-pkgs))
- (push new-pkg-desc (cdr old-pkgs))
- nil)))
- new-pkg-desc))
-
-;; From Emacs 22, but changed so it adds to load-path.
-(defun package-autoload-ensure-default-file (file)
- "Make sure that the autoload file FILE exists and if not create it."
- (unless (file-exists-p file)
- (write-region
- (concat ";;; " (file-name-nondirectory file)
- " --- automatically extracted autoloads\n"
- ";;\n"
- ";;; Code:\n"
- "(add-to-list 'load-path (or (file-name-directory #$) (car
load-path)))\n"
- " \n;; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n"
- ";; no-update-autoloads: t\n"
- ";; End:\n"
- ";;; " (file-name-nondirectory file)
- " ends here\n")
- nil file nil 'silent))
- file)
-
-(defvar generated-autoload-file)
-(defvar version-control)
-
-(defun package-generate-autoloads (name pkg-dir)
- (let* ((auto-name (format "%s-autoloads.el" name))
- ;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
- (backup-inhibited t)
- (version-control 'never))
- (package-autoload-ensure-default-file generated-autoload-file)
- (update-directory-autoloads pkg-dir)
- (let ((buf (find-buffer-visiting generated-autoload-file)))
- (when buf (kill-buffer buf)))
- auto-name))
+
+;;; Installation -- Local operations
+;; This section contains a variety of features regarding installing a
+;; package to/from disk. This includes autoload generation,
+;; unpacking, compiling, as well as defining a package from the
+;; current buffer.
+;;;; Unpacking
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
(declare-function tar-header-name "tar-mode" (tar-header) t)
@@ -792,34 +764,6 @@ untar into a directory named DIR; otherwise, signal an
error."
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
-(defun package-generate-description-file (pkg-desc pkg-file)
- "Create the foo-pkg.el file for single-file packages."
- (let* ((name (package-desc-name pkg-desc)))
- (let ((print-level nil)
- (print-quoted t)
- (print-length nil))
- (write-region
- (concat
- ";;; -*- no-byte-compile: t -*-\n"
- (prin1-to-string
- (nconc
- (list 'define-package
- (symbol-name name)
- (package-version-join (package-desc-version pkg-desc))
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires))))
- (package--alist-to-plist-args
- (package-desc-extras pkg-desc))))
- "\n")
- nil pkg-file nil 'silent))))
-
(defun package--alist-to-plist-args (alist)
(mapcar 'macroexp-quote
(apply #'nconc
@@ -866,43 +810,227 @@ untar into a directory named DIR; otherwise, signal an
error."
(package-activate name 'force)
pkg-dir))
-(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
- "Generate autoloads, description file, etc.. for PKG-DESC installed at
PKG-DIR."
- (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
- (let ((desc-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
- (unless (file-exists-p desc-file)
- (package-generate-description-file pkg-desc desc-file)))
- ;; FIXME: Create foo.info and dir file from foo.texi?
- )
-
-(defun package--compile (pkg-desc)
- "Byte-compile installed package PKG-DESC."
- (package-activate-1 pkg-desc)
- (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
-
-(defun package--write-file-no-coding (file-name)
- (let ((buffer-file-coding-system 'no-conversion))
- (write-region (point-min) (point-max) file-name nil 'silent)))
-
-(defmacro package--with-work-buffer (location file &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-LOCATION is the base location of a package archive, and should be
-one of the URLs (or file names) specified in `package-archives'.
-FILE is the name of a file relative to that base location.
-
-This macro retrieves FILE from LOCATION into a temporary buffer,
-and evaluates BODY while that buffer is current. This work
-buffer is killed afterwards. Return the last value in BODY."
- (declare (indent 2) (debug t))
- `(with-temp-buffer
- (if (string-match-p "\\`https?:" ,location)
- (url-insert-file-contents (concat ,location ,file))
- (unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
- (insert-file-contents (expand-file-name ,file ,location)))
- ,@body))
+(defun package-generate-description-file (pkg-desc pkg-file)
+ "Create the foo-pkg.el file for single-file packages."
+ (let* ((name (package-desc-name pkg-desc)))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (package-version-join (package-desc-version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+;;;; Autoload
+;; From Emacs 22, but changed so it adds to load-path.
+(defun package-autoload-ensure-default-file (file)
+ "Make sure that the autoload file FILE exists and if not create it."
+ (unless (file-exists-p file)
+ (write-region
+ (concat ";;; " (file-name-nondirectory file)
+ " --- automatically extracted autoloads\n"
+ ";;\n"
+ ";;; Code:\n"
+ "(add-to-list 'load-path (or (file-name-directory #$) (car
load-path)))\n"
+ " \n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
+ ";; End:\n"
+ ";;; " (file-name-nondirectory file)
+ " ends here\n")
+ nil file nil 'silent))
+ file)
+
+(defvar generated-autoload-file)
+(defvar version-control)
+
+(defun package-generate-autoloads (name pkg-dir)
+ (let* ((auto-name (format "%s-autoloads.el" name))
+ ;;(ignore-name (concat name "-pkg.el"))
+ (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (backup-inhibited t)
+ (version-control 'never))
+ (package-autoload-ensure-default-file generated-autoload-file)
+ (update-directory-autoloads pkg-dir)
+ (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (when buf (kill-buffer buf)))
+ auto-name))
+
+(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
+ "Generate autoloads, description file, etc.. for PKG-DESC installed at
PKG-DIR."
+ (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
+ (let ((desc-file (expand-file-name (package--description-file pkg-dir)
+ pkg-dir)))
+ (unless (file-exists-p desc-file)
+ (package-generate-description-file pkg-desc desc-file)))
+ ;; FIXME: Create foo.info and dir file from foo.texi?
+ )
+
+;;;; Compilation
+(defun package--compile (pkg-desc)
+ "Byte-compile installed package PKG-DESC."
+ (package-activate-1 pkg-desc)
+ (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
+
+;;;; Inferring package from current buffer
+(defun package-read-from-string (str)
+ "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+ (let* ((read-data (read-from-string str))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
+ (if more-left
+ (error "Can't read whole string")
+ (car read-data))))
+
+(defun package--prepare-dependencies (deps)
+ "Turn DEPS into an acceptable list of dependencies.
+
+Any parts missing a version string get a default version string
+of \"0\" (meaning any version) and an appropriate level of lists
+is wrapped around any parts requiring it."
+ (cond
+ ((not (listp deps))
+ (error "Invalid requirement specifier: %S" deps))
+ (t (mapcar (lambda (dep)
+ (cond
+ ((symbolp dep) `(,dep "0"))
+ ((stringp dep)
+ (error "Invalid requirement specifier: %S" dep))
+ ((and (listp dep) (null (cdr dep)))
+ (list (car dep) "0"))
+ (t dep)))
+ deps))))
+
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-homepage "lisp-mnt" ())
+
+(defun package-buffer-info ()
+ "Return a `package-desc' describing the package in the current buffer.
+
+If the buffer does not contain a conforming package, signal an
+error. If there is a package, narrow the buffer to the file's
+boundaries."
+ (goto-char (point-min))
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[
\t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
+ (error "Package lacks a file header"))
+ (let ((file-name (match-string-no-properties 1))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
+ (unless (search-forward (concat ";;; " file-name ".el ends here"))
+ (error "Package lacks a terminating comment"))
+ ;; Try to include a trailing newline.
+ (forward-line)
+ (narrow-to-region start (point))
+ (require 'lisp-mnt)
+ ;; Use some headers we've invented to drive the process.
+ (let* ((requires-str (lm-header "package-requires"))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
+ (homepage (lm-homepage)))
+ (unless pkg-version
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (package-desc-from-define
+ file-name pkg-version desc
+ (if requires-str
+ (package--prepare-dependencies
+ (package-read-from-string requires-str)))
+ :kind 'single
+ :url homepage))))
+
+(defun package--read-pkg-desc (kind)
+ "Read a `define-package' form in current buffer.
+Return the pkg-desc, with desc-kind set to KIND."
+ (goto-char (point-min))
+ (unwind-protect
+ (let* ((pkg-def-parsed (read (current-buffer)))
+ (pkg-desc
+ (when (eq (car pkg-def-parsed) 'define-package)
+ (apply #'package-desc-from-define
+ (append (cdr pkg-def-parsed))))))
+ (when pkg-desc
+ (setf (package-desc-kind pkg-desc) kind)
+ pkg-desc))))
+
+(declare-function tar-get-file-descriptor "tar-mode" (file))
+(declare-function tar--extract "tar-mode" (descriptor))
+
+(defun package-tar-file-info ()
+ "Find package information for a tar file.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'tar-mode))
+ (let* ((dir-name (file-name-directory
+ (tar-header-name (car tar-parse-info))))
+ (desc-file (package--description-file dir-name))
+ (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
+ (unless tar-desc
+ (error "No package descriptor file found"))
+ (with-current-buffer (tar--extract tar-desc)
+ (unwind-protect
+ (or (package--read-pkg-desc 'tar)
+ (error "Can't find define-package in %s"
+ (tar-header-name tar-desc)))
+ (kill-buffer (current-buffer))))))
+
+(defun package-dir-info ()
+ "Find package information for a directory.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'dired-mode))
+ (let* ((desc-file (package--description-file default-directory)))
+ (if (file-readable-p desc-file)
+ (with-temp-buffer
+ (insert-file-contents desc-file)
+ (package--read-pkg-desc 'dir))
+ (let ((files (directory-files default-directory t "\\.el\\'" t))
+ info)
+ (while files
+ (with-temp-buffer
+ (insert-file-contents (pop files))
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))
+ ;; and return the info.
+ info))))
+
+
+;;; Communicating with Archives
+;; Set of low-level functions for communicating with archives and
+;; signature checking.
+(defun package--write-file-no-coding (file-name)
+ (let ((buffer-file-coding-system 'no-conversion))
+ (write-region (point-min) (point-max) file-name nil 'silent)))
+
+(declare-function url-http-file-exists-p "url-http" (url))
(defun package--archive-file-exists-p (location file)
(let ((http (string-match "\\`https?:" location)))
@@ -935,20 +1063,62 @@ buffer is killed afterwards. Return the last value in
BODY."
(insert (format "Error while verifying signature %s:\n" sig-file)))
(insert "\nCommand output:\n" (epg-context-error-output context))))))
-(defun package--check-signature (location file)
- "Check signature of the current buffer.
-GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
+(defmacro package--with-work-buffer (location file &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+LOCATION is the base location of a package archive, and should be
+one of the URLs (or file names) specified in `package-archives'.
+FILE is the name of a file relative to that base location.
+
+This macro retrieves FILE from LOCATION into a temporary buffer,
+and evaluates BODY while that buffer is current. This work
+buffer is killed afterwards. Return the last value in BODY."
+ (declare (indent 2) (debug t))
+ `(with-temp-buffer
+ (if (string-match-p "\\`https?:" ,location)
+ (url-insert-file-contents (concat ,location ,file))
+ (unless (file-name-absolute-p ,location)
+ (error "Archive location %s is not an absolute file name"
+ ,location))
+ (insert-file-contents (expand-file-name ,file ,location)))
+ ,@body))
+
+(defmacro package--with-work-buffer-async (location file async &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+If ASYNC is non-nil, and if it is possible, run BODY
+asynchronously. If an error is encountered and ASYNC is a
+function, call it with no arguments (instead of executing BODY),
+otherwise propagate the error. For description of the other
+arguments see `package--with-work-buffer'."
+ (declare (indent 3) (debug t))
+ `(if (or (not ,async)
+ (not (string-match-p "\\`https?:" ,location)))
+ (package--with-work-buffer ,location ,file ,@body)
+ (url-retrieve (concat ,location ,file)
+ (lambda (status)
+ (if (eq (car status) :error)
+ (if (functionp ,async)
+ (funcall ,async)
+ (signal (cdar status) (cddr status)))
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil 'noerror)
+ (error "Invalid url response"))
+ (delete-region (point-min) (point))
+ ,@body)
+ (kill-buffer (current-buffer)))
+ nil
+ 'silent)))
+
+(defun package--check-signature-content (content string &optional sig-file)
+ "Check signature CONTENT against STRING.
+SIG-FILE is the name of the signature file, used when signaling
+errors."
(let* ((context (epg-make-context 'OpenPGP))
- (homedir (expand-file-name "gnupg" package-user-dir))
- (sig-file (concat file ".sig"))
- (sig-content (package--with-work-buffer location sig-file
- (buffer-string))))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
(setf (epg-context-home-directory context) homedir)
(condition-case error
- (epg-verify-string context sig-content (buffer-string))
- (error
- (package--display-verify-error context sig-file)
- (signal (car error) (cdr error))))
+ (epg-verify-string context content string)
+ (error (package--display-verify-error context sig-file)
+ (signal (car error) (cdr error))))
(let (good-signatures had-fatal-error)
;; The .sig file may contain multiple signatures. Success if one
;; of the signatures is good.
@@ -967,65 +1137,314 @@ GnuPG keyring is located under \"gnupg\" in
`package-user-dir'."
(error "Failed to verify signature %s" sig-file))
good-signatures)))
-(defun package-install-from-archive (pkg-desc)
- "Download and install a tar package."
- ;; This won't happen, unless the archive is doing something wrong.
- (when (eq (package-desc-kind pkg-desc) 'dir)
- (error "Can't install directory package from archive"))
- (let* ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc)))
- (sig-file (concat file ".sig"))
- good-signatures pkg-descs)
- (package--with-work-buffer location file
- (if (and package-check-signature
- (not (member (package-desc-archive pkg-desc)
- package-unsigned-archives)))
- (if (package--archive-file-exists-p location sig-file)
- (setq good-signatures (package--check-signature location file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned package: `%s'"
- (package-desc-name pkg-desc)))))
- (package-unpack pkg-desc))
- ;; Here the package has been installed successfully, mark it as
- ;; signed if appropriate.
- (when good-signatures
- ;; Write out good signatures into NAME-VERSION.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name
- (concat (package-desc-full-name pkg-desc)
- ".signed")
- package-user-dir)
- nil 'silent)
- ;; Update the old pkg-desc which will be shown on the description buffer.
- (setf (package-desc-signed pkg-desc) t)
- ;; Update the new (activated) pkg-desc as well.
- (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
- (if pkg-descs
- (setf (package-desc-signed (car pkg-descs)) t)))))
+(defun package--check-signature (location file &optional string async callback)
+ "Check signature of the current buffer.
+Download the signature file from LOCATION by appending \".sig\"
+to FILE.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'.
+STRING is the string to verify, it defaults to `buffer-string'.
+If ASYNC is non-nil, the download of the signature file is
+done asynchronously.
+
+If the signature is verified and CALLBACK was provided, CALLBACK
+is `funcall'ed with the list of good signatures as argument (the
+list can be empty). If the signatures file is not found,
+CALLBACK is called with no arguments."
+ (let ((sig-file (concat file ".sig"))
+ (string (or string (buffer-string))))
+ (condition-case nil
+ (package--with-work-buffer-async
+ location sig-file (when async (or callback t))
+ (let ((sig (package--check-signature-content
+ (buffer-string) string sig-file)))
+ (when callback (funcall callback sig))
+ sig))
+ (file-error (funcall callback)))))
+
+
+;;; Packages on Archives
+;; The following variables store information about packages available
+;; from archives. The most important of these is
+;; `package-archive-contents' which is initially populated by the
+;; function `package-read-all-archive-contents' from a cache on disk.
+;; The `package-initialize' command is also closely related to this
+;; section, but it has its own section.
+(defconst package-archive-version 1
+ "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+ "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to
+non-empty lists of `package-desc' structures.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defvar package--compatibility-table nil
+ "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used. To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
+(defun package--build-compatibility-table ()
+ "Build `package--compatibility-table' with `package--mapc'."
+ ;; Build compat table.
+ (setq package--compatibility-table (make-hash-table :test 'eq))
+ (package--mapc #'package--add-to-compatibility-table))
+
+(defun package--add-to-compatibility-table (pkg)
+ "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+ (unless (package--incompatible-p pkg 'shallow)
+ (let* ((name (package-desc-name pkg))
+ (version (or (package-desc-version pkg) '(0)))
+ (table-version (gethash name package--compatibility-table)))
+ (when (or (not table-version)
+ (version-list-< table-version version))
+ (puthash name version package--compatibility-table)))))
+
+;; Package descriptor objects used inside the "archive-contents" file.
+;; Changing this defstruct implies changing the format of the
+;; "archive-contents" files.
+(cl-defstruct (package--ac-desc
+ (:constructor package-make-ac-desc (version reqs summary kind
extras))
+ (:copier nil)
+ (:type vector))
+ version reqs summary kind extras)
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
+
+(defun package--add-to-archive-contents (package archive)
+ "Add the PACKAGE from the given ARCHIVE if necessary.
+PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
+Also, add the originating archive to the `package-desc' structure."
+ (let* ((name (car package))
+ (version (package--ac-desc-version (cdr package)))
+ (pkg-desc
+ (package-desc-create
+ :name name
+ :version version
+ :reqs (package--ac-desc-reqs (cdr package))
+ :summary (package--ac-desc-summary (cdr package))
+ :kind (package--ac-desc-kind (cdr package))
+ :archive archive
+ :extras (and (> (length (cdr package)) 4)
+ ;; Older archive-contents files have only 4
+ ;; elements here.
+ (package--ac-desc-extras (cdr package)))))
+ (pinned-to-archive (assoc name package-pinned-packages)))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--read-archive-file (file)
+ "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+ (let ((filename (expand-file-name file package-user-dir)))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
+
+(defun package-read-archive-contents (archive)
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((contents-file (format "archives/%s/archive-contents" archive))
+ (contents (package--read-archive-file contents-file)))
+ (when contents
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
+
+(defun package-read-all-archive-contents ()
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+ (setq package-archive-contents nil)
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive))))
+;;;; Package Initialize
+;; A bit of a milestone. This brings together some of the above
+;; sections and populates all relevant lists of packages from contents
+;; available on disk.
(defvar package--initialized nil)
-(defun package-installed-p (package &optional min-version)
- "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
-If PACKAGE is a symbol, it is the package name and MIN-VERSION
-should be a version list.
+;;;###autoload
+(defun package-initialize (&optional no-activate)
+ "Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+ (interactive)
+ (setq package-alist nil)
+ (package-load-all-descriptors)
+ (package-read-all-archive-contents)
+ (unless no-activate
+ (dolist (elt package-alist)
+ (package-activate (car elt))))
+ (setq package--initialized t)
+ ;; This uses `package--mapc' so it must be called after
+ ;; `package--initialized' is t.
+ (package--build-compatibility-table))
-If PACKAGE is a package-desc object, MIN-VERSION is ignored."
- (unless package--initialized (error "package.el is not yet initialized!"))
- (if (package-desc-p package)
- (let ((dir (package-desc-dir package)))
- (and (stringp dir)
- (file-exists-p dir)))
- (or
- (let ((pkg-descs (cdr (assq package package-alist))))
- (and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
- ;; Also check built-in packages.
- (package-built-in-p package min-version))))
+
+;;;; Populating `package-archive-contents' from archives
+;; This subsection populates the variables listed above from the
+;; actual archives, instead of from a local cache.
+(defvar package--downloads-in-progress nil
+ "List of in-progress asynchronous downloads.")
+
+(declare-function epg-check-configuration "epg-config"
+ (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+;;;###autoload
+(defun package-import-keyring (&optional file)
+ "Import keys from FILE."
+ (interactive "fFile: ")
+ (setq file (expand-file-name file))
+ (let ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (with-file-modes 448
+ (make-directory homedir t))
+ (setf (epg-context-home-directory context) homedir)
+ (message "Importing %s..." (file-name-nondirectory file))
+ (epg-import-keys-from-file context file)
+ (message "Importing %s...done" (file-name-nondirectory file))))
+
+(defvar package--post-download-archives-hook nil
+ "Hook run after the archive contents are downloaded.
+Don't run this hook directly. It is meant to be run as part of
+`package--update-downloads-in-progress'.")
+(put 'package--post-download-archives-hook 'risky-local-variable t)
+
+(defun package--update-downloads-in-progress (entry)
+ "Remove ENTRY from `package--downloads-in-progress'.
+Once it's empty, run `package--post-download-archives-hook'."
+ ;; Keep track of the downloading progress.
+ (setq package--downloads-in-progress
+ (remove entry package--downloads-in-progress))
+ ;; If this was the last download, run the hook.
+ (unless package--downloads-in-progress
+ (package--build-compatibility-table)
+ (package-read-all-archive-contents)
+ ;; We message before running the hook, so the hook can give
+ ;; messages as well.
+ (message "Package refresh done")
+ (run-hooks 'package--post-download-archives-hook)))
+
+(defun package--download-one-archive (archive file &optional async)
+ "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'. Save the cached copy to
+\"archives/NAME/FILE\" in `package-user-dir'."
+ (package--with-work-buffer-async (cdr archive) file async
+ (let* ((location (cdr archive))
+ (name (car archive))
+ (content (buffer-string))
+ (dir (expand-file-name (format "archives/%s" name)
package-user-dir))
+ (local-file (expand-file-name file dir)))
+ (when (listp (read-from-string content))
+ (make-directory dir t)
+ (if (or (not package-check-signature)
+ (member archive package-unsigned-archives))
+ ;; If we don't care about the signature, save the file and
+ ;; we're done.
+ (progn (write-region content nil local-file nil 'silent)
+ (package--update-downloads-in-progress archive))
+ ;; If we care, check it (perhaps async) and *then* write the file.
+ (package--check-signature
+ location file content async
+ (lambda (&optional good-sigs)
+ (unless (or good-sigs (eq package-check-signature
'allow-unsigned))
+ (error "Unsigned archive `%s'" name))
+ ;; Write out the archives file.
+ (write-region content nil local-file nil 'silent)
+ ;; Write out good signatures into archive-contents.signed file.
+ (when good-sigs
+ (write-region (mapconcat #'epg-signature-to-string good-sigs
"\n")
+ nil (concat local-file ".signed") nil 'silent))
+ (package--update-downloads-in-progress archive))))))))
+
+(defun package--download-and-read-archives (&optional async)
+ "Download descriptions of all `package-archives' and read them.
+This populates `package-archive-contents'. If ASYNC is non-nil,
+perform the downloads asynchronously."
+ ;; The downloaded archive contents will be read as part of
+ ;; `package--update-downloads-in-progress'.
+ (setq package--downloads-in-progress package-archives)
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive archive "archive-contents" async)
+ (error (message "Failed to download `%s' archive."
+ (car archive))))))
+
+;;;###autoload
+(defun package-refresh-contents (&optional async)
+ "Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument ASYNC specifies whether to perform the
+downloads in the background."
+ (interactive)
+ ;; FIXME: Do it asynchronously.
+ (unless (file-exists-p package-user-dir)
+ (make-directory package-user-dir t))
+ (let ((default-keyring (expand-file-name "package-keyring.gpg"
+ data-directory)))
+ (when (and package-check-signature (file-exists-p default-keyring))
+ (condition-case-unless-debug error
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package-import-keyring default-keyring))
+ (error (message "Cannot import default keyring: %S" (cdr error))))))
+ (package--download-and-read-archives async))
+
+;;; Dependency Management
+;; Calculating the full transaction necessary for an installation,
+;; keeping track of which packages were installed strictly as
+;; dependencies, and determining which packages cannot be removed
+;; because they are dependencies.
(defun package-compute-transaction (packages requirements &optional seen)
"Return a list of packages to be installed, including PACKAGES.
PACKAGES should be a list of `package-desc'.
@@ -1109,120 +1528,178 @@ but version %s required"
(cons found seen))))))))
packages)
-(defun package-read-from-string (str)
- "Read a Lisp expression from STR.
-Signal an error if the entire string was not used."
- (let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
- (if more-left
- (error "Can't read whole string")
- (car read-data))))
+(defun package--find-non-dependencies ()
+ "Return a list of installed packages which are not dependencies.
+Finds all packages in `package-alist' which are not dependencies
+of any other packages.
+Used to populate `package-selected-packages'."
+ (let ((dep-list
+ (delete-dups
+ (apply #'append
+ (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p))))
+ package-alist)))))
+ (cl-loop for p in package-alist
+ for name = (car p)
+ unless (memq name dep-list)
+ collect name)))
-(defun package--read-archive-file (file)
- "Re-read archive file FILE, if it exists.
-Will return the data from the file, or nil if the file does not exist.
-Will throw an error if the archive version is too new."
- (let ((filename (expand-file-name file package-user-dir)))
- (when (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents-literally filename)
- (let ((contents (read (current-buffer))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is higher than %d"
- (car contents) package-archive-version))
- (cdr contents))))))
+(defun package--user-selected-p (pkg)
+ "Return non-nil if PKG is a package was installed by the user.
+PKG is a package name.
+This looks into `package-selected-packages', populating it first
+if it is still empty."
+ (unless (consp package-selected-packages)
+ (customize-save-variable
+ 'package-selected-packages
+ (setq package-selected-packages (package--find-non-dependencies))))
+ (memq pkg package-selected-packages))
-(defun package-read-all-archive-contents ()
- "Re-read `archive-contents', if it exists.
-If successful, set `package-archive-contents'."
- (setq package-archive-contents nil)
- (dolist (archive package-archives)
- (package-read-archive-contents (car archive))))
+(defun package--get-deps (pkg &optional only)
+ (let* ((pkg-desc (cadr (assq pkg package-alist)))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (assq name package-alist)
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps
+ append (package--get-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (delete-dups (append direct-deps indirect-deps))))))
-(defun package-read-archive-contents (archive)
- "Re-read archive contents for ARCHIVE.
-If successful, set the variable `package-archive-contents'.
-If the archive version is too new, signal an error."
- ;; Version 1 of 'archive-contents' is identical to our internal
- ;; representation.
- (let* ((contents-file (format "archives/%s/archive-contents" archive))
- (contents (package--read-archive-file contents-file)))
- (when contents
- (dolist (package contents)
- (package--add-to-archive-contents package archive)))))
+(defun package--removable-packages ()
+ "Return a list of names of packages no longer needed.
+These are packages which are neither contained in
+`package-selected-packages' nor a dependency of one that is."
+ (let ((needed (cl-loop for p in package-selected-packages
+ if (assq p package-alist)
+ ;; `p' and its dependencies are needed.
+ append (cons p (package--get-deps p)))))
+ (cl-loop for p in (mapcar #'car package-alist)
+ unless (memq p needed)
+ collect p)))
-;; Package descriptor objects used inside the "archive-contents" file.
-;; Changing this defstruct implies changing the format of the
-;; "archive-contents" files.
-(cl-defstruct (package--ac-desc
- (:constructor package-make-ac-desc (version reqs summary kind
extras))
- (:copier nil)
- (:type vector))
- version reqs summary kind extras)
+(defun package--used-elsewhere-p (pkg-desc &optional pkg-list)
+ "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
+Return the first package found in PKG-LIST of which PKG is a
+dependency.
+
+When not specified, PKG-LIST defaults to `package-alist'
+with PKG-DESC entry removed."
+ (unless (string= (package-desc-status pkg-desc) "obsolete")
+ (let ((pkg (package-desc-name pkg-desc)))
+ (cl-loop with alist = (or pkg-list
+ (remove (assq pkg package-alist)
+ package-alist))
+ for p in alist thereis
+ (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
+ (car p))))))
+
+(defun package--sort-deps-in-alist (package only)
+ "Return a list of dependencies for PACKAGE sorted by dependency.
+PACKAGE is included as the first element of the returned list.
+ONLY is an alist associating package names to package objects.
+Only these packages will be in the return value an their cdrs are
+destructively set to nil in ONLY."
+ (let ((out))
+ (dolist (dep (package-desc-reqs package))
+ (when-let ((cell (assq (car dep) only))
+ (dep-package (cdr-safe cell)))
+ (setcdr cell nil)
+ (setq out (append (package--sort-deps-in-alist dep-package only)
+ out))))
+ (cons package out)))
+
+(defun package--sort-by-dependence (package-list)
+ "Return PACKAGE-LIST sorted by dependence.
+That is, any element of the returned list is guaranteed to not
+directly depend on any elements that come before it.
+
+PACKAGE-LIST is a list of package-desc objects.
+Indirect dependencies are guaranteed to be returned in order only
+if all the in-between dependencies are also in PACKAGE-LIST."
+ (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p))
package-list))
+ out-list)
+ (dolist (cell alist out-list)
+ ;; `package--sort-deps-in-alist' destructively changes alist, so
+ ;; some cells might already be empty. We check this here.
+ (when-let ((pkg-desc (cdr cell)))
+ (setcdr cell nil)
+ (setq out-list
+ (append (package--sort-deps-in-alist pkg-desc alist)
+ out-list))))))
-(defun package--add-to-archive-contents (package archive)
- "Add the PACKAGE from the given ARCHIVE if necessary.
-PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
-Also, add the originating archive to the `package-desc' structure."
- (let* ((name (car package))
- (version (package--ac-desc-version (cdr package)))
- (pkg-desc
- (package-desc-create
- :name name
- :version version
- :reqs (package--ac-desc-reqs (cdr package))
- :summary (package--ac-desc-summary (cdr package))
- :kind (package--ac-desc-kind (cdr package))
- :archive archive
- :extras (and (> (length (cdr package)) 4)
- ;; Older archive-contents files have only 4
- ;; elements here.
- (package--ac-desc-extras (cdr package)))))
- (pinned-to-archive (assoc name package-pinned-packages)))
- ;; Skip entirely if pinned to another archive.
- (when (not (and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive))))
- (setq package-archive-contents
- (package--append-to-alist pkg-desc package-archive-contents)))))
+
+;;; Installation Functions
+;; As opposed to the previous section (which listed some underlying
+;; functions necessary for installation), this one contains the actual
+;; functions that install packages. The package itself can be
+;; installed in a variety of ways (archives, buffer, file), but
+;; requirements (dependencies) are always satisfied by looking in
+;; `package-archive-contents'.
+(defun package-archive-base (desc)
+ "Return the archive containing the package NAME."
+ (cdr (assoc (package-desc-archive desc) package-archives)))
-(defun package--append-to-alist (pkg-desc alist)
- "Append an entry for PKG-DESC to the start of ALIST and return it.
-This entry takes the form (`package-desc-name' PKG-DESC).
+(defun package-install-from-archive (pkg-desc)
+ "Download and install a tar package."
+ ;; This won't happen, unless the archive is doing something wrong.
+ (when (eq (package-desc-kind pkg-desc) 'dir)
+ (error "Can't install directory package from archive"))
+ (let* ((location (package-archive-base pkg-desc))
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)))
+ (sig-file (concat file ".sig"))
+ good-signatures pkg-descs)
+ (package--with-work-buffer location file
+ (if (and package-check-signature
+ (not (member (package-desc-archive pkg-desc)
+ package-unsigned-archives)))
+ (if (package--archive-file-exists-p location sig-file)
+ (setq good-signatures (package--check-signature location file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))))
+ (package-unpack pkg-desc))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when good-signatures
+ ;; Write out good signatures into NAME-VERSION.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc)
+ ".signed")
+ package-user-dir)
+ nil 'silent)
+ ;; Update the old pkg-desc which will be shown on the description buffer.
+ (setf (package-desc-signed pkg-desc) t)
+ ;; Update the new (activated) pkg-desc as well.
+ (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
+ (if pkg-descs
+ (setf (package-desc-signed (car pkg-descs)) t)))))
-If ALIST already has an entry with this name, destructively add
-PKG-DESC to the cdr of this entry instead, sorted by version
-number."
- (let* ((name (package-desc-name pkg-desc))
- (priority-version (package-desc-priority-version pkg-desc))
- (existing-packages (assq name alist)))
- (if (not existing-packages)
- (cons (list name pkg-desc)
- alist)
- (while (if (and (cdr existing-packages)
- (version-list-< priority-version
- (package-desc-priority-version
- (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))
- alist)))
+(defun package-installed-p (package &optional min-version)
+ "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+If PACKAGE is a symbol, it is the package name and MIN-VERSION
+should be a version list.
-(defun package--user-selected-p (pkg)
- "Return non-nil if PKG is a package was installed by the user.
-PKG is a package name.
-This looks into `package-selected-packages', populating it first
-if it is still empty."
- (unless (consp package-selected-packages)
- (customize-save-variable
- 'package-selected-packages
- (setq package-selected-packages (package--find-non-dependencies))))
- (memq pkg package-selected-packages))
+If PACKAGE is a package-desc object, MIN-VERSION is ignored."
+ (unless package--initialized (error "package.el is not yet initialized!"))
+ (if (package-desc-p package)
+ (let ((dir (package-desc-dir package)))
+ (and (stringp dir)
+ (file-exists-p dir)))
+ (or
+ (let ((pkg-descs (cdr (assq package package-alist))))
+ (and pkg-descs
+ (version-list-<= min-version
+ (package-desc-version (car pkg-descs)))))
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version))))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
@@ -1276,147 +1753,19 @@ to install it but still mark it as selected."
(package-compute-transaction ()
(list (list pkg))))))
-;;;###autoload
-(defun package-reinstall (pkg)
- "Reinstall package PKG.
-PKG should be either a symbol, the package name, or a package-desc
-object."
- (interactive (list (intern (completing-read
- "Reinstall package: "
- (mapcar #'symbol-name
- (mapcar #'car package-alist))))))
- (package-delete
- (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
- 'force 'nosave)
- (package-install pkg 'dont-select))
-
-(defun package-strip-rcs-id (str)
- "Strip RCS version ID from the version string STR.
-If the result looks like a dotted numeric version, return it.
-Otherwise return nil."
- (when str
- (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
- (setq str (substring str (match-end 0))))
- (condition-case nil
- (if (version-to-list str)
- str)
- (error nil))))
-
-(declare-function lm-homepage "lisp-mnt" (&optional file))
-
-(defun package--prepare-dependencies (deps)
- "Turn DEPS into an acceptable list of dependencies.
-
-Any parts missing a version string get a default version string
-of \"0\" (meaning any version) and an appropriate level of lists
-is wrapped around any parts requiring it."
- (cond
- ((not (listp deps))
- (error "Invalid requirement specifier: %S" deps))
- (t (mapcar (lambda (dep)
- (cond
- ((symbolp dep) `(,dep "0"))
- ((stringp dep)
- (error "Invalid requirement specifier: %S" dep))
- ((and (listp dep) (null (cdr dep)))
- (list (car dep) "0"))
- (t dep)))
- deps))))
-
-(defun package-buffer-info ()
- "Return a `package-desc' describing the package in the current buffer.
-
-If the buffer does not contain a conforming package, signal an
-error. If there is a package, narrow the buffer to the file's
-boundaries."
- (goto-char (point-min))
- (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[
\t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
- (error "Package lacks a file header"))
- (let ((file-name (match-string-no-properties 1))
- (desc (match-string-no-properties 2))
- (start (line-beginning-position)))
- (unless (search-forward (concat ";;; " file-name ".el ends here"))
- (error "Package lacks a terminating comment"))
- ;; Try to include a trailing newline.
- (forward-line)
- (narrow-to-region start (point))
- (require 'lisp-mnt)
- ;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
- ;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
- (homepage (lm-homepage)))
- (unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
- (package-desc-from-define
- file-name pkg-version desc
- (if requires-str
- (package--prepare-dependencies
- (package-read-from-string requires-str)))
- :kind 'single
- :url homepage))))
-
-(declare-function tar-get-file-descriptor "tar-mode" (file))
-(declare-function tar--extract "tar-mode" (descriptor))
-
-(defun package-tar-file-info ()
- "Find package information for a tar file.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (file-name-directory
- (tar-header-name (car tar-parse-info))))
- (desc-file (package--description-file dir-name))
- (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
- (unless tar-desc
- (error "No package descriptor file found"))
- (with-current-buffer (tar--extract tar-desc)
- (unwind-protect
- (or (package--read-pkg-desc 'tar)
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc)))
- (kill-buffer (current-buffer))))))
-
-(defun package-dir-info ()
- "Find package information for a directory.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'dired-mode))
- (let* ((desc-file (package--description-file default-directory)))
- (if (file-readable-p desc-file)
- (with-temp-buffer
- (insert-file-contents desc-file)
- (package--read-pkg-desc 'dir))
- (let ((files (directory-files default-directory t "\\.el\\'" t))
- info)
- (while files
- (with-temp-buffer
- (insert-file-contents (pop files))
- ;; When we find the file with the data,
- (when (setq info (ignore-errors (package-buffer-info)))
- ;; stop looping,
- (setq files nil)
- ;; set the 'dir kind,
- (setf (package-desc-kind info) 'dir))))
- ;; and return the info.
- info))))
-
-(defun package--read-pkg-desc (kind)
- "Read a `define-package' form in current buffer.
-Return the pkg-desc, with desc-kind set to KIND."
- (goto-char (point-min))
- (unwind-protect
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (when (eq (car pkg-def-parsed) 'define-package)
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (when pkg-desc
- (setf (package-desc-kind pkg-desc) kind)
- pkg-desc))))
-
+(defun package-strip-rcs-id (str)
+ "Strip RCS version ID from the version string STR.
+If the result looks like a dotted numeric version, return it.
+Otherwise return nil."
+ (when str
+ (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ (condition-case nil
+ (if (version-to-list str)
+ str)
+ (error nil))))
+
+(declare-function lm-homepage "lisp-mnt" (&optional file))
;;;###autoload
(defun package-install-from-buffer ()
@@ -1469,22 +1818,6 @@ The file can either be a tar file or an Emacs Lisp file."
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
-(defun package--get-deps (pkg &optional only)
- (let* ((pkg-desc (cadr (assq pkg package-alist)))
- (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
- for name = (car p)
- when (assq name package-alist)
- collect name))
- (indirect-deps (unless (eq only 'direct)
- (delete-dups
- (cl-loop for p in direct-deps
- append (package--get-deps p))))))
- (cl-case only
- (direct direct-deps)
- (separate (list direct-deps indirect-deps))
- (indirect indirect-deps)
- (t (delete-dups (append direct-deps indirect-deps))))))
-
;;;###autoload
(defun package-install-user-selected-packages ()
"Ensure packages in `package-selected-packages' are installed.
@@ -1507,22 +1840,8 @@ If some packages are not installed propose to install
them."
(mapc #'package-install lst))
(message "All your packages are already installed")))))
-(defun package--used-elsewhere-p (pkg-desc &optional pkg-list)
- "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
-Return the first package found in PKG-LIST of which PKG is a
-dependency.
-
-When not specified, PKG-LIST defaults to `package-alist'
-with PKG-DESC entry removed."
- (unless (string= (package-desc-status pkg-desc) "obsolete")
- (let ((pkg (package-desc-name pkg-desc)))
- (cl-loop with alist = (or pkg-list
- (remove (assq pkg package-alist)
- package-alist))
- for p in alist thereis
- (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
- (car p))))))
-
+
+;;; Package Deletion
(defun package--newest-p (pkg)
"Return t if PKG is the newest package with its name."
(equal (cadr (assq (package-desc-name pkg) package-alist))
@@ -1577,17 +1896,19 @@ If NOSAVE is non-nil, the package is not removed from
(setq package-alist (delq pkgs package-alist))))
(message "Package `%s' deleted." (package-desc-full-name
pkg-desc))))))
-(defun package--removable-packages ()
- "Return a list of names of packages no longer needed.
-These are packages which are neither contained in
-`package-selected-packages' nor a dependency of one that is."
- (let ((needed (cl-loop for p in package-selected-packages
- if (assq p package-alist)
- ;; `p' and its dependencies are needed.
- append (cons p (package--get-deps p)))))
- (cl-loop for p in (mapcar #'car package-alist)
- unless (memq p needed)
- collect p)))
+;;;###autoload
+(defun package-reinstall (pkg)
+ "Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object."
+ (interactive (list (intern (completing-read
+ "Reinstall package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist))))))
+ (package-delete
+ (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
+ 'force 'nosave)
+ (package-install pkg 'dont-select))
;;;###autoload
(defun package-autoremove ()
@@ -1614,156 +1935,6 @@ will be deleted."
removable))
(message "Nothing to autoremove")))))
-(defun package-archive-base (desc)
- "Return the archive containing the package NAME."
- (cdr (assoc (package-desc-archive desc) package-archives)))
-
-(defun package-archive-priority (archive)
- "Return the priority of ARCHIVE.
-
-The archive priorities are specified in
-`package-archive-priorities'. If not given there, the priority
-defaults to 0."
- (or (cdr (assoc archive package-archive-priorities))
- 0))
-
-(defun package-desc-priority-version (pkg-desc)
- "Return the version PKG-DESC with the archive priority prepended.
-
-This allows for easy comparison of package versions from
-different archives if archive priorities are meant to be taken in
-consideration."
- (cons (package-archive-priority
- (package-desc-archive pkg-desc))
- (package-desc-version pkg-desc)))
-
-(defun package--download-one-archive (archive file)
- "Retrieve an archive file FILE from ARCHIVE, and cache it.
-ARCHIVE should be a cons cell of the form (NAME . LOCATION),
-similar to an entry in `package-alist'. Save the cached copy to
-\"archives/NAME/archive-contents\" in `package-user-dir'."
- (let ((dir (expand-file-name (format "archives/%s" (car archive))
- package-user-dir))
- (sig-file (concat file ".sig"))
- good-signatures)
- (package--with-work-buffer (cdr archive) file
- ;; Check signature of archive-contents, if desired.
- (if (and package-check-signature
- (not (member archive package-unsigned-archives)))
- (if (package--archive-file-exists-p (cdr archive) sig-file)
- (setq good-signatures (package--check-signature (cdr archive)
- file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned archive `%s'"
- (car archive)))))
- ;; Read the retrieved buffer to make sure it is valid (e.g. it
- ;; may fetch a URL redirect page).
- (when (listp (read (current-buffer)))
- (make-directory dir t)
- (write-region nil nil (expand-file-name file dir) nil 'silent)))
- (when good-signatures
- ;; Write out good signatures into archive-contents.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name (concat file ".signed") dir)
- nil 'silent))))
-
-(declare-function epg-check-configuration "epg-config"
- (config &optional minimum-version))
-(declare-function epg-configuration "epg-config" ())
-(declare-function epg-import-keys-from-file "epg" (context keys))
-
-;;;###autoload
-(defun package-import-keyring (&optional file)
- "Import keys from FILE."
- (interactive "fFile: ")
- (setq file (expand-file-name file))
- (let ((context (epg-make-context 'OpenPGP))
- (homedir (expand-file-name "gnupg" package-user-dir)))
- (with-file-modes 448
- (make-directory homedir t))
- (setf (epg-context-home-directory context) homedir)
- (message "Importing %s..." (file-name-nondirectory file))
- (epg-import-keys-from-file context file)
- (message "Importing %s...done" (file-name-nondirectory file))))
-
-(defun package--build-compatibility-table ()
- "Build `package--compatibility-table' with `package--mapc'."
- ;; Build compat table.
- (setq package--compatibility-table (make-hash-table :test 'eq))
- (package--mapc #'package--add-to-compatibility-table))
-
-;;;###autoload
-(defun package-refresh-contents ()
- "Download descriptions of all configured ELPA packages.
-For each archive configured in the variable `package-archives',
-inform Emacs about the latest versions of all packages it offers,
-and make them available for download."
- (interactive)
- ;; FIXME: Do it asynchronously.
- (unless (file-exists-p package-user-dir)
- (make-directory package-user-dir t))
- (let ((default-keyring (expand-file-name "package-keyring.gpg"
- data-directory)))
- (when (and package-check-signature (file-exists-p default-keyring))
- (condition-case-unless-debug error
- (progn
- (epg-check-configuration (epg-configuration))
- (package-import-keyring default-keyring))
- (error (message "Cannot import default keyring: %S" (cdr error))))))
- (dolist (archive package-archives)
- (condition-case-unless-debug nil
- (package--download-one-archive archive "archive-contents")
- (error (message "Failed to download `%s' archive."
- (car archive)))))
- (package-read-all-archive-contents)
- (package--build-compatibility-table))
-
-(defun package--find-non-dependencies ()
- "Return a list of installed packages which are not dependencies.
-Finds all packages in `package-alist' which are not dependencies
-of any other packages.
-Used to populate `package-selected-packages'."
- (let ((dep-list
- (delete-dups
- (apply #'append
- (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr
p))))
- package-alist)))))
- (cl-loop for p in package-alist
- for name = (car p)
- unless (memq name dep-list)
- collect name)))
-
-;;;###autoload
-(defun package-initialize (&optional no-activate)
- "Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages."
- (interactive)
- (setq package-alist nil)
- (package-load-all-descriptors)
- (package-read-all-archive-contents)
- (unless no-activate
- (dolist (elt package-alist)
- (package-activate (car elt))))
- (setq package--initialized t)
- ;; This uses `package--mapc' so it must be called after
- ;; `package--initialized' is t.
- (package--build-compatibility-table))
-
-(defun package--add-to-compatibility-table (pkg)
- "If PKG is compatible (without dependencies), add to the compatibility table.
-PKG is a package-desc object.
-Only adds if its version is higher than what's already stored in
-the table."
- (unless (package--incompatible-p pkg 'shallow)
- (let* ((name (package-desc-name pkg))
- (version (or (package-desc-version pkg) '(0)))
- (table-version (gethash name package--compatibility-table)))
- (when (or (not table-version)
- (version-list-< table-version version))
- (puthash name version package--compatibility-table)))))
-
;;;; Package description buffer.
@@ -1797,6 +1968,8 @@ the table."
(with-current-buffer standard-output
(describe-package-1 package)))))
+(declare-function lm-commentary "lisp-mnt" (&optional file))
+
(defun describe-package-1 (pkg)
(require 'lisp-mnt)
(let* ((desc (or
@@ -2068,7 +2241,7 @@ the table."
map)
"Local keymap for `package-menu-mode' buffers.")
-(defvar package-menu--new-package-list nil
+(defvar-local package-menu--new-package-list nil
"List of newly-available packages since `list-packages' was last called.")
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
@@ -2391,6 +2564,25 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(aref (cadr entry) 2)
"")))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+ (or (cdr (assoc archive package-archive-priorities))
+ 0))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-archive-priority
+ (package-desc-archive pkg-desc))
+ (package-desc-version pkg-desc)))
+
(defun package-menu--find-upgrades ()
(let (installed available upgrades)
;; Build list of installed/available packages in this buffer.
@@ -2440,40 +2632,6 @@ call will upgrade the package."
(length upgrades)
(if (= (length upgrades) 1) "" "s")))))
-(defun package--sort-deps-in-alist (package only)
- "Return a list of dependencies for PACKAGE sorted by dependency.
-PACKAGE is included as the first element of the returned list.
-ONLY is an alist associating package names to package objects.
-Only these packages will be in the return value an their cdrs are
-destructively set to nil in ONLY."
- (let ((out))
- (dolist (dep (package-desc-reqs package))
- (when-let ((cell (assq (car dep) only))
- (dep-package (cdr-safe cell)))
- (setcdr cell nil)
- (setq out (append (package--sort-deps-in-alist dep-package only)
- out))))
- (cons package out)))
-
-(defun package--sort-by-dependence (package-list)
- "Return PACKAGE-LIST sorted by dependence.
-That is, any element of the returned list is guaranteed to not
-directly depend on any elements that come before it.
-
-PACKAGE-LIST is a list of package-desc objects.
-Indirect dependencies are guaranteed to be returned in order only
-if all the in-between dependencies are also in PACKAGE-LIST."
- (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p))
package-list))
- out-list)
- (dolist (cell alist out-list)
- ;; `package--sort-deps-in-alist' destructively changes alist, so
- ;; some cells might already be empty. We check this here.
- (when-let ((pkg-desc (cdr cell)))
- (setcdr cell nil)
- (setq out-list
- (append (package--sort-deps-in-alist pkg-desc alist)
- out-list))))))
-
(defun package-menu-execute (&optional noquery)
"Perform marked Package Menu actions.
Packages marked for installation are downloaded and installed;
@@ -2591,6 +2749,48 @@ Optional argument NOQUERY non-nil means do not ask the
user to confirm."
(string< (or (package-desc-archive (car A)) "")
(or (package-desc-archive (car B)) "")))
+(defvar-local package-menu--old-archive-contents nil
+ "`package-archive-contents' before the latest refresh.")
+
+(defun package-menu--populate-new-package-list ()
+ "Decide which packages are new in `package-archives-contents'.
+Store this list in `package-menu--new-package-list'."
+ ;; Find which packages are new.
+ (when package-menu--old-archive-contents
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) package-menu--old-archive-contents)
+ (push (car elt) package-menu--new-package-list)))
+ (setq package-menu--old-archive-contents nil)))
+
+(defun package-menu--find-and-notify-upgrades ()
+ "Notify the user of upgradable packages."
+ (when-let ((upgrades (package-menu--find-upgrades)))
+ (message "%d package%s can be upgraded; type `%s' to mark %s for
upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))
+
+(defun package-menu--post-refresh ()
+ "Check for new packages, revert the *Packages* buffer, and check for
upgrades.
+This function is called after `package-refresh-contents' is done.
+It goes in `package--post-download-archives-hook', so that it
+works with async refresh as well."
+ (package-menu--populate-new-package-list)
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (revert-buffer nil 'noconfirm))))
+ (package-menu--find-and-notify-upgrades))
+
+(defcustom package-menu-async t
+ "If non-nil, package-menu will use async operations when possible.
+Currently, only the refreshing of archive contents supports
+asynchronous operations. Package transactions are still done
+synchronously."
+ :type 'boolean
+ :group 'package)
+
;;;###autoload
(defun list-packages (&optional no-fetch)
"Display a list of packages.
@@ -2602,36 +2802,24 @@ The list is displayed in a buffer named `*Packages*'."
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (let (old-archives new-packages)
- (unless no-fetch
- ;; Read the locally-cached archive-contents.
- (package-read-all-archive-contents)
- (setq old-archives package-archive-contents)
- ;; Fetch the remote list of packages.
- (package-refresh-contents)
- ;; Find which packages are new.
- (dolist (elt package-archive-contents)
- (unless (assq (car elt) old-archives)
- (push (car elt) new-packages))))
-
- ;; Generate the Package Menu.
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- (package-menu-mode)
- (set (make-local-variable 'package-menu--new-package-list)
- new-packages)
- (package-menu--generate nil t))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf))
-
- (let ((upgrades (package-menu--find-upgrades)))
- (if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark %s for
upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")
- (if (= (length upgrades) 1) "it" "them"))))))
+ ;; Integrate the package-menu with updating the archives.
+ (add-hook 'package--post-download-archives-hook
+ #'package-menu--post-refresh)
+
+ (unless no-fetch
+ (setq package-menu--old-archive-contents package-archive-contents)
+ (setq package-menu--new-package-list nil)
+ ;; Fetch the remote list of packages.
+ (package-refresh-contents package-menu-async))
+
+ ;; Generate the Package Menu.
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (package-menu--generate nil t))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 0e8a969..3a2fa4f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -103,7 +103,6 @@ UPatterns can take the following forms:
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
'VAL matches if the object is `equal' to VAL
- `QPAT matches if the QPattern QPAT matches.
(pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let UPAT EXP) matches if EXP matches UPAT.
@@ -111,14 +110,6 @@ UPatterns can take the following forms:
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
- its 0..(n-1)th elements, respectively.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-
FUN can take the form
SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
@@ -129,7 +120,10 @@ FUN is assumed to be pure, i.e. it can be dropped if its
result is not used,
and two identical calls can be merged into one.
E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
-`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
+`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:"
(declare (indent 1) (debug (form &rest (pcase-UPAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
@@ -154,6 +148,26 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+;; FIXME: Obviously, this will collide with nadvice's use of
+;; function-documentation if we happen to advise `pcase'.
+(put 'pcase 'function-documentation '(pcase--make-docstring))
+(defun pcase--make-docstring ()
+ (let* ((main (documentation (symbol-function 'pcase) 'raw))
+ (ud (help-split-fundoc main 'pcase)))
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (mapatoms
+ (lambda (symbol)
+ (let ((me (get symbol 'pcase-macroexpander)))
+ (when me
+ (insert "\n\n-- ")
+ (let* ((doc (documentation me 'raw)))
+ (setq doc (help-fns--signature symbol doc me
+ (indirect-function me)))
+ (insert "\n" (or doc "Not documented.")))))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
;;;###autoload
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
@@ -347,9 +361,13 @@ of the form (UPAT EXP)."
;;;###autoload
(defmacro pcase-defmacro (name args &rest body)
"Define a pcase UPattern macro."
- (declare (indent 2) (debug (def-name sexp def-body)) (doc-string 3))
- `(put ',name 'pcase-macroexpander
- (lambda ,args ,@body)))
+ (declare (indent 2) (debug defun) (doc-string 3))
+ (let ((fsym (intern (format "%s--pcase-macroexpander" name))))
+ ;; Add the function via `fsym', so that an autoload cookie placed
+ ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+ `(progn
+ (defun ,fsym ,args ,@body)
+ (put ',name 'pcase-macroexpander #',fsym))))
(defun pcase--match (val upat)
"Build a MATCH structure, hoisting all `or's and `and's outside."
@@ -564,6 +582,7 @@ MATCH is the pattern that needs to be matched, of the form:
(cond ((eq 'pred (car-safe pat)) (cadr pat))
((not (eq 'quote (car-safe pat))) nil)
((consp (cadr pat)) #'consp)
+ ((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
@@ -810,6 +829,14 @@ Otherwise, it defers to REST which is a list of branches
of the form
(t (error "Incorrect MATCH %S" (car matches)))))
(pcase-defmacro \` (qpat)
+ "Backquote-style pcase patterns.
+QPAT can take the following forms:
+ (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
+ [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
+ its 0..(n-1)th elements, respectively.
+ ,UPAT matches if the UPattern UPAT matches.
+ STRING matches if the object is `equal' to STRING.
+ ATOM matches if the object is `eq' to ATOM."
(cond
((eq (car-safe qpat) '\,) (cadr qpat))
((vectorp qpat)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 59b9140..c5f5906 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -33,8 +33,8 @@
;;
;; All provided functions work on lists, strings and vectors.
;;
-;; Functions taking a predicate or a function iterating over the
-;; sequence as argument take the function as their first argument and
+;; Functions taking a predicate or iterating over a sequence using a
+;; function as argument take the function as their first argument and
;; the sequence as their second argument. All other functions take
;; the sequence as their first argument.
;;
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 48bded4..1bc5eb2 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -837,12 +837,12 @@ Possible return values:
;;; Miscellaneous commands using the precedence parser.
-(defun smie-backward-sexp-command (&optional n)
+(defun smie-backward-sexp-command (n)
"Move backward through N logical elements."
(interactive "^p")
(smie-forward-sexp-command (- n)))
-(defun smie-forward-sexp-command (&optional n)
+(defun smie-forward-sexp-command (n)
"Move forward through N logical elements."
(interactive "^p")
(let ((forw (> n 0))
diff --git a/lisp/epg.el b/lisp/epg.el
index f665453..1b75b50 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -2051,7 +2051,9 @@ If you are unsure, use synchronous version of this
function
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
-PARAMETERS specifies parameters for the key.
+PARAMETERS is a string which specifies parameters of the generated key.
+See Info node `(gnupg) Unattended GPG key generation' in the
+GnuPG manual for the format.
If you use this function, you will need to wait for the completion of
`epg-gpg-program' by using `epg-wait-for-completion' and call
@@ -2061,9 +2063,9 @@ If you are unsure, use synchronous version of this
function
(setf (epg-context-operation context) 'generate-key)
(setf (epg-context-result context) nil)
(if (epg-data-file parameters)
- (epg--start context (list "--batch" "--genkey" "--"
+ (epg--start context (list "--batch" "--gen-key" "--"
(epg-data-file parameters)))
- (epg--start context '("--batch" "--genkey"))
+ (epg--start context '("--batch" "--gen-key"))
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
(epg-data-string parameters)))
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index e75b8cc..a4a7d47 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,7 @@
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * erc.el (erc-switch-to-buffer): Fix last change (bug#20187).
+
2015-03-16 Stefan Monnier <address@hidden>
* erc.el (erc-switch-to-buffer): Rename from erc-iswitchb and rewrite
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7e76a6d..cf422f1 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1717,7 +1717,8 @@ If `erc-track-mode' is in enabled, put the last element of
;; Only allow ERC buffers in the same session.
(let ((proc (unless arg erc-server-process)))
(lambda (bufname)
- (let ((buf (get-buffer bufname)))
+ (let ((buf (if (consp bufname)
+ (cdr bufname) (get-buffer bufname))))
(when buf
(erc--buffer-p buf (lambda () t) proc)
(with-current-buffer buf
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 350a6bd..d4e30a0 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -265,20 +265,10 @@ ffap most of the time."
:group 'ffap
:risky t)
-(defcustom ffap-url-fetcher
- (if (fboundp 'browse-url)
- 'browse-url ; rely on browse-url-browser-function
- 'w3-fetch)
- ;; Remote control references:
- ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
- ;; http://home.netscape.com/newsref/std/x-remote.html
+(defcustom ffap-url-fetcher 'browse-url
"A function of one argument, called by ffap to fetch an URL.
-Reasonable choices are `w3-fetch' or a `browse-url-*' function.
For a fancy alternative, get `ffap-url.el'."
- :type '(choice (const w3-fetch)
- (const browse-url) ; in recent versions of browse-url
- (const browse-url-netscape)
- (const browse-url-mosaic)
+ :type '(choice (const browse-url)
function)
:group 'ffap
:risky t)
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 6ec6c9f..96b290e 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -585,11 +585,14 @@ This is normally set via `font-lock-defaults'.")
This is used when turning off Font Lock mode.
This is normally set via `font-lock-defaults'.")
-(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region
+(defvar font-lock-fontify-region-function #'font-lock-default-fontify-region
"Function to use for fontifying a region.
It should take two args, the beginning and end of the region, and an optional
third arg VERBOSE. If VERBOSE is non-nil, the function should print status
-messages. This is normally set via `font-lock-defaults'.")
+messages. This is normally set via `font-lock-defaults'.
+If it fontifies a larger region, it should ideally return a list of the form
+\(jit-lock-bounds BEG . END) indicating the bounds of the region actually
+fontified.")
(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region
"Function to use for unfontifying a region.
@@ -600,6 +603,7 @@ This is normally set via `font-lock-defaults'.")
"List of Font Lock mode related modes that should not be turned on.
Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and
`lazy-lock-mode'. This is normally set via `font-lock-defaults'.")
+(make-obsolete-variable 'font-lock-inhibit-thing-lock nil "25.1")
(defvar-local font-lock-multiline nil
"Whether font-lock should cater to multiline keywords.
@@ -935,7 +939,7 @@ The value of this variable is used when Font Lock mode is
turned on."
;; Don't fontify eagerly (and don't abort if the buffer is large).
(set (make-local-variable 'font-lock-fontified) t)
;; Use jit-lock.
- (jit-lock-register 'font-lock-fontify-region
+ (jit-lock-register #'font-lock-fontify-region
(not font-lock-keywords-only))
;; Tell jit-lock how we extend the region to refontify.
(add-hook 'jit-lock-after-change-extend-region-functions
@@ -1220,7 +1224,8 @@ This function is the default
`font-lock-fontify-region-function'."
(font-lock-fontify-syntactic-keywords-region start end)))
(unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
- (font-lock-fontify-keywords-region beg end loudly)))))
+ (font-lock-fontify-keywords-region beg end loudly)
+ `(jit-lock-bounds ,beg . ,end)))))
;; The following must be rethought, since keywords can override fontification.
;; ;; Now scan for keywords, but not if we are inside a comment now.
@@ -1325,11 +1330,13 @@ This function does 2 things:
(when (memq 'font-lock-extend-region-wholelines
font-lock-extend-region-functions)
(goto-char beg)
- (setq jit-lock-start (min jit-lock-start (line-beginning-position)))
+ (setq beg (min jit-lock-start (line-beginning-position)))
(goto-char end)
- (setq jit-lock-end
+ (setq end
(max jit-lock-end
- (if (bolp) (point) (line-beginning-position 2))))))))
+ (if (bolp) (point) (line-beginning-position 2)))))
+ (setq jit-lock-start beg
+ jit-lock-end end))))
(defun font-lock-fontify-block (&optional arg)
"Fontify some lines the way `font-lock-fontify-buffer' would.
@@ -1416,37 +1423,33 @@ Optional argument OBJECT is the string or buffer
containing the text."
(put-text-property start next prop value object)
(setq start (text-property-any next end prop nil object)))))
-;; For completeness: this is to `remove-text-properties' as `put-text-property'
-;; is to `add-text-properties', etc.
-;;(defun remove-text-property (start end property &optional object)
-;; "Remove a property from text from START to END.
-;;Argument PROPERTY is the property to remove.
-;;Optional argument OBJECT is the string or buffer containing the text.
-;;Return t if the property was actually removed, nil otherwise."
-;; (remove-text-properties start end (list property) object))
-
-;; For consistency: maybe this should be called `remove-single-property' like
-;; `next-single-property-change' (not `next-single-text-property-change'), etc.
-;;(defun remove-single-text-property (start end prop value &optional object)
-;; "Remove a specific property value from text from START to END.
-;;Arguments PROP and VALUE specify the property and value to remove. The
-;;resulting property values are not equal to VALUE nor lists containing VALUE.
-;;Optional argument OBJECT is the string or buffer containing the text."
-;; (let ((start (text-property-not-all start end prop nil object)) next prev)
-;; (while start
-;; (setq next (next-single-property-change start prop object end)
-;; prev (get-text-property start prop object))
-;; (cond ((and (symbolp prev) (eq value prev))
-;; (remove-text-property start next prop object))
-;; ((and (listp prev) (memq value prev))
-;; (let ((new (delq value prev)))
-;; (cond ((null new)
-;; (remove-text-property start next prop object))
-;; ((= (length new) 1)
-;; (put-text-property start next prop (car new) object))
-;; (t
-;; (put-text-property start next prop new object))))))
-;; (setq start (text-property-not-all next end prop nil object)))))
+(defun font-lock--remove-face-from-text-property (start
+ end
+ prop value &optional object)
+ "Remove a specific property value from text from START to END.
+Arguments PROP and VALUE specify the property and value to remove. The
+resulting property values are not `eq' to VALUE nor lists containing VALUE.
+Optional argument OBJECT is the string or buffer containing the text."
+ (let ((start (text-property-not-all start end prop nil object)) next prev)
+ (while start
+ (setq next (next-single-property-change start prop object end)
+ prev (get-text-property start prop object))
+ (cond ((or (atom prev)
+ (keywordp (car prev))
+ (eq (car prev) 'foreground-color)
+ (eq (car prev) 'background-color))
+ (when (eq value prev)
+ (remove-list-of-text-properties start next (list prop) object)))
+ ((memq value prev) ;Assume prev is not dotted.
+ (let ((new (remq value prev)))
+ (cond ((null new)
+ (remove-list-of-text-properties start next (list prop)
+ object))
+ ((= (length new) 1)
+ (put-text-property start next prop (car new) object))
+ (t
+ (put-text-property start next prop new object))))))
+ (setq start (text-property-not-all next end prop nil object)))))
;;; End of Additional text property functions.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 64124bc..95ead23 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,46 @@
+2015-04-01 Eric Abrahamsen <address@hidden>
+
+ * registry.el (registry-prune): Re-use `registry-full' in
+ `registry-prune'. It's a bit of redundant work, but safer.
+ Also ensure that target-size is an integer.
+
+2015-03-31 Daiki Ueno <address@hidden>
+
+ * plstore.el (plstore--decrypt): Clear entry in
+ `plstore-passphrase-alist' if decryption failed (bug#20030).
+
+2015-03-28 Adam Sjøgren <address@hidden>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add "Display HTML images"
+ to "Display" menu.
+
+2015-03-24 Eric Abrahamsen <address@hidden>
+
+ * nnimap.el (nnimap-split-incoming-mail): If a message is already
+ in the group it should be split to, don't re-copy it into the group.
+
+2015-03-23 Ben Bacarisse <address@hidden> (tiny change)
+
+ * nnmh.el (nnmh-request-expire-articles):
+ Work for the case nnmail-expiry-target is an nnmh group (bug#20170).
+
+2015-03-21 Eric Abrahamsen <address@hidden>
+
+ * registry.el (registry-lookup-secondary, registry-full)
+ (registry-prune, registry-collect-prune-candidates):
+ * gnus-registry.el (gnus-registry-load): Use slot names rather than
+ initarg names in `oref' and `oset'.
+
+2015-03-19 Eric Abrahamsen <address@hidden>
+
+ * registry.el (registry-prune): Allow registry to reach full size
+ before pruning.
+
+2015-03-19 Eric Abrahamsen <address@hidden>
+
+ * registry.el (registry-collect-prune-candidates): Fix call to
+ cl-subseq.
+
2015-03-11 Stefan Monnier <address@hidden>
* gnus-registry.el (gnus-registry-handle-action)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 5de4b58..19da2cc 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -7210,6 +7210,8 @@ If given a prefix, show the hidden text instead."
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
+ "Allows images in newsgroups to be shown, blocks images in all
+other groups."
(if (or (gnus-news-group-p group)
(gnus-member-of-valid 'global group))
;; Block nothing in news groups.
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 1d5887d..f73f216 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -335,7 +335,7 @@ This is not required after changing
`gnus-registry-cache-file'."
old-file-name file)))
(progn
(gnus-registry-read old-file-name)
- (setf (oref gnus-registry-db :file) file)
+ (setf (oref gnus-registry-db file) file)
(gnus-message 1 "Registry filename changed to %s" file))
(gnus-registry-remake-db t))))
(error
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 66b1050..c68d496 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2424,6 +2424,7 @@ increase the score of each group you read."
["Lapsed" gnus-article-date-lapsed t]
["User-defined" gnus-article-date-user t])
("Display"
+ ["Display HTML images" gnus-article-show-images t]
["Remove images" gnus-article-remove-images t]
["Toggle smiley" gnus-treat-smiley t]
["Show X-Face" gnus-article-display-x-face t]
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 369d9d3..c476be6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -2086,12 +2086,15 @@ Return the server's response to the SELECT or EXAMINE
command."
(ranges (cdr spec)))
(if (eq group 'junk)
(setq junk-articles ranges)
- (push (list (nnimap-send-command
- "UID COPY %s %S"
- (nnimap-article-ranges ranges)
- (utf7-encode group t))
- ranges)
- sequences))))
+ ;; Don't copy if the message is already in its
+ ;; target group.
+ (unless (string= group nnimap-inbox)
+ (push (list (nnimap-send-command
+ "UID COPY %s %S"
+ (nnimap-article-ranges ranges)
+ (utf7-encode group t))
+ ranges)
+ sequences)))))
;; Wait for the last COPY response...
(when sequences
(nnimap-wait-for-response (caar sequences))
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 9be0c14..04270a5 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -259,12 +259,12 @@ as unread by Gnus.")
&optional server force)
(nnmh-possibly-change-directory newsgroup server)
(let ((is-old t)
+ (dir nnmh-current-directory)
article rest mod-time)
(nnheader-init-server-buffer)
(while (and articles is-old)
- (setq article (concat nnmh-current-directory
- (int-to-string (car articles))))
+ (setq article (concat dir (int-to-string (car articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnmh-deletable-article-p newsgroup (car articles))
(setq is-old
diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
index 12a0413..175e272 100644
--- a/lisp/gnus/plstore.el
+++ b/lisp/gnus/plstore.el
@@ -270,9 +270,16 @@ symmetric encryption will be used.")
context
(cons #'plstore-progress-callback-function
(format "Decrypting %s" (plstore-get-file plstore))))
- (setq plain
- (epg-decrypt-string context
- (plstore--get-encrypted-data plstore)))
+ (condition-case error
+ (setq plain
+ (epg-decrypt-string context
+ (plstore--get-encrypted-data plstore)))
+ (error
+ (let ((entry (assoc (plstore-get-file plstore)
+ plstore-passphrase-alist)))
+ (if entry
+ (setcdr entry nil)))
+ (signal (car error) (cdr error))))
(plstore--set-secret-alist plstore (car (read-from-string plain)))
(plstore--merge-secret plstore)
(plstore--set-encrypted-data plstore nil))))
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index 1c83b93..96a89fc 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -185,8 +185,8 @@ When CREATE is not nil, create the secondary index
hashtable if needed."
(when create
(puthash tracksym
(make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
- (oref db :tracker))
- (gethash tracksym (oref db :tracker))))))
+ (oref db tracker))
+ (gethash tracksym (oref db tracker))))))
(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
@@ -282,7 +282,7 @@ This is the key count of the `data' slot."
(defmethod registry-full ((db registry-db))
"Checks if registry-db THIS is full."
(>= (registry-size db)
- (oref db :max-size)))
+ (oref db max-size)))
(defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
@@ -341,11 +341,12 @@ from the front of the list are deleted first.
Returns the number of deleted entries."
(let ((size (registry-size db))
- (target-size (- (oref db :max-size)
- (* (oref db :max-size)
- (oref db :prune-factor))))
+ (target-size
+ (floor (- (oref db max-size)
+ (* (oref db max-size)
+ (oref db prune-factor)))))
candidates)
- (if (> size target-size)
+ (if (registry-full db)
(progn
(setq candidates
(registry-collect-prune-candidates
@@ -359,7 +360,7 @@ Returns the number of deleted entries."
Proposes only entries without the :precious keys, and attempts to
return LIMIT such candidates. If SORTFUNC is provided, sort
entries first and return candidates from beginning of list."
- (let* ((precious (oref db :precious))
+ (let* ((precious (oref db precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
(data (oref db data))
@@ -371,7 +372,7 @@ entries first and return candidates from beginning of list."
;; list of entry keys.
(when sortfunc
(setq candidates (sort candidates sortfunc)))
- (delq nil (cl-subseq (mapcar #'car candidates) 0 limit))))
+ (cl-subseq (mapcar #'car candidates) 0 (min limit (length candidates)))))
(provide 'registry)
;;; registry.el ends here
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index dcf850d..cca659f 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2941,6 +2941,14 @@ on encoding."
;; char with that name.
(setq ucs-names `(("BELL (BEL)" . 7) ,@names)))))
+(defun mule--ucs-names-annotation (name)
+ ;; FIXME: It would be much better to add this annotation before rather than
+ ;; after the char name, so the annotations are aligned.
+ ;; FIXME: The default behavior of displaying annotations in italics
+ ;; doesn't work well here.
+ (let ((char (assoc name ucs-names)))
+ (when char (format " (%c)" (cdr char)))))
+
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
@@ -2964,7 +2972,9 @@ point or a number in hash notation, e.g. #o21430 for
octal,
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata (category . unicode-name))
+ '(metadata
+ (annotation-function . mule--ucs-names-annotation)
+ (category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
(cond
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 788646c..0faabeb 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -351,6 +351,30 @@ is active."
(min (point-max) (+ start jit-lock-chunk-size)))
'fontified 'defer)))))
+(defun jit-lock--run-functions (beg end)
+ (let ((tight-beg nil) (tight-end nil)
+ (loose-beg beg) (loose-end end))
+ (run-hook-wrapped
+ 'jit-lock-functions
+ (lambda (fun)
+ (pcase-let*
+ ((res (funcall fun beg end))
+ (`(,this-beg . ,this-end)
+ (if (eq (car-safe res) 'jit-lock-bounds)
+ (cdr res) (cons beg end))))
+ ;; If all functions don't fontify the same region, we currently
+ ;; just try to "still be correct". But we could go further and for
+ ;; the chunks of text that was fontified by some functions but not
+ ;; all, we could add text-properties indicating which functions were
+ ;; already run to avoid running them redundantly when we get to
+ ;; those chunks.
+ (setq tight-beg (max (or tight-beg (point-min)) this-beg))
+ (setq tight-end (min (or tight-end (point-max)) this-end))
+ (setq loose-beg (min loose-beg this-beg))
+ (setq loose-end (max loose-end this-end))
+ nil)))
+ `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
+
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
Defaults to the whole buffer. END can be out of bounds."
@@ -376,54 +400,58 @@ Defaults to the whole buffer. END can be out of bounds."
(setq next (or (text-property-any start end 'fontified t)
end))
- ;; Decide which range of text should be fontified.
- ;; The problem is that START and NEXT may be in the
- ;; middle of something matched by a font-lock regexp.
- ;; Until someone has a better idea, let's start
- ;; at the start of the line containing START and
- ;; stop at the start of the line following NEXT.
- (goto-char next) (setq next (line-beginning-position 2))
- (goto-char start) (setq start (line-beginning-position))
-
- ;; Make sure the contextual refontification doesn't re-refontify
- ;; what's already been refontified.
- (when (and jit-lock-context-unfontify-pos
- (< jit-lock-context-unfontify-pos next)
- (>= jit-lock-context-unfontify-pos start)
- ;; Don't move boundary forward if we have to
- ;; refontify previous text. Otherwise, we risk moving
- ;; it past the end of the multiline property and thus
- ;; forget about this multiline region altogether.
- (not (get-text-property start
'jit-lock-defer-multiline)))
- (setq jit-lock-context-unfontify-pos next))
-
;; Fontify the chunk, and mark it as fontified.
;; We mark it first, to make sure that we don't indefinitely
;; re-execute this fontification if an error occurs.
(put-text-property start next 'fontified t)
- (condition-case err
- (run-hook-with-args 'jit-lock-functions start next)
- ;; If the user quits (which shouldn't happen in normal on-the-fly
- ;; jit-locking), make sure the fontification will be performed
- ;; before displaying the block again.
- (quit (put-text-property start next 'fontified nil)
- (funcall 'signal (car err) (cdr err))))
-
- ;; The redisplay engine has already rendered the buffer up-to
- ;; `orig-start' and won't notice if the above jit-lock-functions
- ;; changed the appearance of any part of the buffer prior
- ;; to that. So if `start' is before `orig-start', we need to
- ;; cause a new redisplay cycle after this one so that any changes
- ;; are properly reflected on screen.
- ;; To make such repeated redisplay happen less often, we can
- ;; eagerly extend the refontified region with
- ;; jit-lock-after-change-extend-region-functions.
- (when (< start orig-start)
- (run-with-timer 0 nil #'jit-lock-force-redisplay
- (copy-marker start) (copy-marker orig-start)))
-
- ;; Find the start of the next chunk, if any.
- (setq start (text-property-any next end 'fontified nil))))))))
+ (pcase-let
+ ;; `tight' is the part we've fully refontified, and `loose'
+ ;; is the part we've partly refontified (some of the
+ ;; functions have refontified it but maybe not all).
+ ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end)
+ (condition-case err
+ (jit-lock--run-functions start next)
+ ;; If the user quits (which shouldn't happen in normal
+ ;; on-the-fly jit-locking), make sure the fontification
+ ;; will be performed before displaying the block again.
+ (quit (put-text-property start next 'fontified nil)
+ (signal (car err) (cdr err))))))
+
+ ;; In case we fontified more than requested, take advantage of the
+ ;; good news.
+ (when (or (< tight-beg start) (> tight-end next))
+ (put-text-property tight-beg tight-end 'fontified t))
+
+ ;; Make sure the contextual refontification doesn't re-refontify
+ ;; what's already been refontified.
+ (when (and jit-lock-context-unfontify-pos
+ (< jit-lock-context-unfontify-pos tight-end)
+ (>= jit-lock-context-unfontify-pos tight-beg)
+ ;; Don't move boundary forward if we have to
+ ;; refontify previous text. Otherwise, we risk moving
+ ;; it past the end of the multiline property and thus
+ ;; forget about this multiline region altogether.
+ (not (get-text-property tight-beg
+ 'jit-lock-defer-multiline)))
+ (setq jit-lock-context-unfontify-pos tight-end))
+
+ ;; The redisplay engine has already rendered the buffer up-to
+ ;; `orig-start' and won't notice if the above jit-lock-functions
+ ;; changed the appearance of any part of the buffer prior
+ ;; to that. So if `loose-beg' is before `orig-start', we need to
+ ;; cause a new redisplay cycle after this one so that the changes
+ ;; are properly reflected on screen.
+ ;; To make such repeated redisplay happen less often, we can
+ ;; eagerly extend the refontified region with
+ ;; jit-lock-after-change-extend-region-functions.
+ (when (< loose-beg orig-start)
+ (run-with-timer 0 nil #'jit-lock-force-redisplay
+ (copy-marker loose-beg)
+ (copy-marker orig-start)))
+
+ ;; Find the start of the next chunk, if any.
+ (setq start
+ (text-property-any tight-end end 'fontified nil)))))))))
(defun jit-lock-force-redisplay (start end)
"Force the display engine to re-render START's buffer from START to END.
diff --git a/lisp/json.el b/lisp/json.el
index 98974e6..eaf8596 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -52,13 +52,6 @@
;;; Code:
-
-;; Compatibility code
-
-(defalias 'json-encode-char0 'encode-char)
-(defalias 'json-decode-char0 'decode-char)
-
-
;; Parameters
(defvar json-object-type 'alist
@@ -265,7 +258,6 @@ representation will be parsed correctly."
(defvar json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
- (?/ . ?/)
(?b . ?\b)
(?f . ?\f)
(?n . ?\n)
@@ -287,7 +279,7 @@ representation will be parsed correctly."
((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
(let ((hex (match-string 0)))
(json-advance 4)
- (json-decode-char0 'ucs (string-to-number hex 16))))
+ (string-to-number hex 16)))
(t
(signal 'json-string-escape (list (point)))))))
@@ -313,24 +305,29 @@ representation will be parsed correctly."
;; String encoding
-(defun json-encode-char (char)
- "Encode CHAR as a JSON string."
- (setq char (json-encode-char0 char 'ucs))
- (let ((control-char (car (rassoc char json-special-chars))))
- (cond
- ;; Special JSON character (\n, \r, etc.).
- (control-char
- (format "\\%c" control-char))
- ;; ASCIIish printable character.
- ((and (> char 31) (< char 127))
- (format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form.
- (t
- (format "\\u%04x" char)))))
-
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- (format "\"%s\"" (mapconcat 'json-encode-char string "")))
+ ;; Reimplement the meat of `replace-regexp-in-string', for
+ ;; performance (bug#20154).
+ (let ((l (length string))
+ (start 0)
+ res mb)
+ ;; Only escape quotation mark, backslash and the control
+ ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+ (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
+ (let* ((c (aref string mb))
+ (special (rassq c json-special-chars)))
+ (push (substring string start mb) res)
+ (push (if special
+ ;; Special JSON character (\n, \r, etc.).
+ (string ?\\ (car special))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "\\u%04x" c))
+ res)
+ (setq start (1+ mb))))
+ (push (substring string start l) res)
+ (push "\"" res)
+ (apply #'concat "\"" (nreverse res))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index e0f80fe..b126066 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1245,8 +1245,8 @@ Entering array mode calls the function `array-mode-hook'.
;;;***
-;;;### (autoloads nil "artist" "textmodes/artist.el" (21704 50495
-;;;;;; 455324 752000))
+;;;### (autoloads nil "artist" "textmodes/artist.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/artist.el
(push (purecopy '(artist 1 2 6)) package--builtin-versions)
@@ -1656,8 +1656,8 @@ should be non-nil).
;;;***
-;;;### (autoloads nil "autorevert" "autorevert.el" (21737 47805 354975
-;;;;;; 322000))
+;;;### (autoloads nil "autorevert" "autorevert.el" (21752 15166 568176
+;;;;;; 278000))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
@@ -1802,8 +1802,8 @@ Run script using `bat-run' and `bat-run-args'.
;;;***
-;;;### (autoloads nil "battery" "battery.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "battery" "battery.el" (21754 56896 744606
+;;;;;; 568000))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
@@ -2123,8 +2123,8 @@ a reflection.
;;;***
-;;;### (autoloads nil "bookmark" "bookmark.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "bookmark" "bookmark.el" (21779 56495 106033
+;;;;;; 935000))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
@@ -2317,8 +2317,8 @@ Incremental search of bookmarks, hiding the non-matches
as we go.
;;;***
-;;;### (autoloads nil "browse-url" "net/browse-url.el" (21711 23743
-;;;;;; 625328 319000))
+;;;### (autoloads nil "browse-url" "net/browse-url.el" (21778 35636
+;;;;;; 244616 784000))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
@@ -2363,7 +2363,7 @@ Ask a WWW browser to display the current region.
(autoload 'browse-url "browse-url" "\
Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point. Variable
+Prompt for a URL, defaulting to the URL at or before point. Variable
`browse-url-browser-function' says which browser to use.
If the URL is a mailto: URL, consult `browse-url-mailto-function'
first, if that exists.
@@ -2372,17 +2372,15 @@ first, if that exists.
(autoload 'browse-url-at-point "browse-url" "\
Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use.
+Variable `browse-url-browser-function' says which browser to use.
\(fn &optional ARG)" t nil)
(autoload 'browse-url-at-mouse "browse-url" "\
Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
-but point is not changed. Doesn't let you edit the URL like
-`browse-url'. Variable `browse-url-browser-function' says which browser
-to use.
+but point is not changed. Variable `browse-url-browser-function'
+says which browser to use.
\(fn EVENT)" t nil)
@@ -2412,6 +2410,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-netscape 'nil '"25.1")
+
(autoload 'browse-url-mozilla "browse-url" "\
Ask the Mozilla WWW browser to load URL.
Default to the URL around or before point. The strings in variable
@@ -2433,29 +2433,19 @@ used instead of `browse-url-new-window-flag'.
(autoload 'browse-url-firefox "browse-url" "\
Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point. The strings in
-variable `browse-url-firefox-arguments' are also passed to
-Firefox.
+Defaults to the URL around or before point. Passes the strings
+in the variable `browse-url-firefox-arguments' to Firefox.
-When called interactively, if variable
-`browse-url-new-window-flag' is non-nil, load the document in a
-new Firefox window, otherwise use a random existing one. A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new Firefox window. A non-nil prefix argument
+reverses the effect of `browse-url-new-window-flag'.
If `browse-url-firefox-new-window-is-tab' is non-nil, then
whenever a document would otherwise be loaded in a new window, it
is loaded in a new tab in an existing window instead.
-When called non-interactively, optional second argument
-NEW-WINDOW is used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is
-ignored. Firefox for Windows does not support the \"-remote\"
-command line parameter. Therefore, the
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the requested
-URL in a new window.
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
@@ -2486,6 +2476,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-galeon 'nil '"25.1")
+
(autoload 'browse-url-emacs "browse-url" "\
Ask Emacs to load URL into a buffer and show it in another window.
@@ -2506,6 +2498,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
+
(autoload 'browse-url-mosaic "browse-url" "\
Ask the XMosaic WWW browser to load URL.
@@ -2524,6 +2518,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-mosaic 'nil '"25.1")
+
(autoload 'browse-url-cci "browse-url" "\
Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point.
@@ -2542,6 +2538,28 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-cci 'nil '"25.1")
+
+(autoload 'browse-url-conkeror "browse-url" "\
+Ask the Conkeror WWW browser to load URL.
+Default to the URL around or before point. Also pass the strings
+in the variable `browse-url-conkeror-arguments' to Conkeror.
+
+When called interactively, if variable
+`browse-url-new-window-flag' is non-nil, load the document in a
+new Conkeror window, otherwise use a random existing one. A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-flag'.
+
+If variable `browse-url-conkeror-new-window-is-buffer' is
+non-nil, then whenever a document would otherwise be loaded in a
+new window, load it in a new buffer in an existing window instead.
+
+When called non-interactively, use optional second argument
+NEW-WINDOW instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
+
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
@@ -2562,6 +2580,8 @@ The `browse-url-gnudoit-program' program is used with
options given by
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-w3-gnudoit 'nil '"25.1")
+
(autoload 'browse-url-text-xterm "browse-url" "\
Ask a text browser to load URL.
URL defaults to the URL around or before point.
@@ -3154,8 +3174,8 @@ the absolute file name of the file if STYLE-NAME is nil.
;;;***
-;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21743 190
-;;;;;; 195328 729000))
+;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21786 29744
+;;;;;; 368212 633000))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
@@ -3732,7 +3752,7 @@ Choose `cfengine2-mode' or `cfengine3-mode' by buffer
contents.
;;;***
;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el"
-;;;;;; (21742 67 198174 224000))
+;;;;;; (21750 59840 206034 761000))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
@@ -3749,8 +3769,8 @@ Returns non-nil if any false statements are found.
;;;***
-;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21733
-;;;;;; 50750 334730 5000))
+;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21779
+;;;;;; 56495 106033 935000))
;;; Generated autoloads from emacs-lisp/checkdoc.el
(push (purecopy '(checkdoc 0 6 2)) package--builtin-versions)
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
@@ -4028,8 +4048,8 @@ and runs the normal hook `command-history-hook'.
;;;***
-;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21765
+;;;;;; 23600 805241 145000))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
@@ -4112,8 +4132,8 @@ instead.
;;;***
-;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21727 11963
-;;;;;; 635339 992000))
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/cl-lib.el
(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
@@ -4192,7 +4212,7 @@ If FRAME cannot display COLOR, return nil.
;;;***
-;;;### (autoloads nil "comint" "comint.el" (21740 47646 728890 593000))
+;;;### (autoloads nil "comint" "comint.el" (21781 11826 448890 994000))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(ansi-color-process-output
comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
@@ -4759,8 +4779,8 @@ If FIX is non-nil, run `copyright-fix-years' instead.
;;;***
-;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21771
+;;;;;; 62389 36768 739000))
;;; Generated autoloads from progmodes/cperl-mode.el
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
@@ -5004,8 +5024,8 @@ with empty strings removed.
;;;***
-;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21721 59582
-;;;;;; 784612 824000))
+;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21787 5486
+;;;;;; 8891 32000))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
@@ -5716,8 +5736,8 @@ There is some minimal font-lock support (see vars
;;;***
-;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21741 44862
-;;;;;; 355415 471000))
+;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
@@ -5962,8 +5982,8 @@ This function is meant to be used as a value of
;;;***
-;;;### (autoloads nil "desktop" "desktop.el" (21732 29888 498897
-;;;;;; 471000))
+;;;### (autoloads nil "desktop" "desktop.el" (21753 36028 905339
+;;;;;; 955000))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
@@ -6336,7 +6356,7 @@ Optional arguments are passed to `dig-invoke'.
;;;***
-;;;### (autoloads nil "dired" "dired.el" (21670 32624 385626 484000))
+;;;### (autoloads nil "dired" "dired.el" (21757 29489 158925 687000))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -7552,8 +7572,8 @@ an EDE controlled project.
;;;***
-;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21741 44862
-;;;;;; 856033 862000))
+;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21767 65327
+;;;;;; 504606 256000))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
@@ -8037,15 +8057,15 @@ BUFFER is put back into its original major mode.
;;;***
-;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21735 6155 666757
-;;;;;; 201000))
+;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21781 11826
+;;;;;; 448890 994000))
;;; Generated autoloads from emacs-lisp/eieio.el
(push (purecopy '(eieio 1 4)) package--builtin-versions)
;;;***
-;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21729
-;;;;;; 53695 825320 214000))
+;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21770
+;;;;;; 41522 196747 399000))
;;; Generated autoloads from emacs-lisp/eieio-core.el
(push (purecopy '(eieio-core 1 4)) package--builtin-versions)
@@ -8061,8 +8081,8 @@ It creates an autoload function for CNAME's constructor.
;;;***
-;;;### (autoloads nil "elec-pair" "elec-pair.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "elec-pair" "elec-pair.el" (21783 53552 656724
+;;;;;; 351000))
;;; Generated autoloads from elec-pair.el
(defvar electric-pair-text-pairs '((34 . 34)) "\
@@ -8091,7 +8111,13 @@ the mode if ARG is omitted or nil.
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. (Likewise for brackets, etc.).
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'electric-pair-local-mode "elec-pair" "\
+Toggle `electric-pair-mode' only in this buffer.
\(fn &optional ARG)" t nil)
@@ -8636,7 +8662,7 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "epg" "epg.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "epg" "epg.el" (21777 14770 397461 322000))
;;; Generated autoloads from epg.el
(push (purecopy '(epg 1 0 0)) package--builtin-versions)
@@ -8668,8 +8694,9 @@ Look at CONFIG and try to expand GROUP.
;;;***
-;;;### (autoloads nil "erc" "erc/erc.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "erc" "erc/erc.el" (21779 56495 106033 935000))
;;; Generated autoloads from erc/erc.el
+(push (purecopy '(erc 5 3)) package--builtin-versions)
(autoload 'erc-select-read-args "erc" "\
Prompt the user for values of nick, server, port, and password.
@@ -9257,8 +9284,8 @@ Kill all test buffers that are still live.
;;;***
-;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21767 65327
+;;;;;; 504606 256000))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
@@ -9934,7 +9961,7 @@ fourth arg NOSEP non-nil inhibits this.
;;;***
-;;;### (autoloads nil "eww" "net/eww.el" (21731 9021 668220 181000))
+;;;### (autoloads nil "eww" "net/eww.el" (21753 36029 405318 957000))
;;; Generated autoloads from net/eww.el
(defvar eww-suggest-uris '(eww-links-at-point url-get-url-at-point
eww-current-url) "\
@@ -9954,12 +9981,12 @@ word(s) will be searched for via `eww-search-prefix'.
(defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
-Render a file using EWW.
+Render FILE using EWW.
\(fn FILE)" t nil)
(autoload 'eww-search-words "eww" "\
-Search the web for the text between the point and marker.
+Search the web for the text between BEG and END.
See the `eww-search-prefix' variable for the search engine used.
\(fn &optional BEG END)" t nil)
@@ -10355,7 +10382,7 @@ you can set `feedmail-queue-reminder-alist' to nil.
;;;***
-;;;### (autoloads nil "ffap" "ffap.el" (21696 56380 925320 624000))
+;;;### (autoloads nil "ffap" "ffap.el" (21778 35636 244616 784000))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
@@ -10994,8 +11021,8 @@ Turn flymake mode off.
;;;***
-;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21727 11963
-;;;;;; 635339 992000))
+;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
@@ -11887,8 +11914,8 @@ CLEAN is obsolete and ignored.
;;;***
-;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21743 190 195328
-;;;;;; 729000))
+;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21785 8881 6781
+;;;;;; 649000))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
@@ -12323,7 +12350,7 @@ Like `message-reply'.
;;;***
;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el"
-;;;;;; (21670 32330 885624 725000))
+;;;;;; (21757 29489 158925 687000))
;;; Generated autoloads from gnus/gnus-notifications.el
(autoload 'gnus-notifications "gnus-notifications" "\
@@ -12431,8 +12458,8 @@ Add NUM into sorted LIST by side effect.
;;;***
-;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21707
-;;;;;; 26689 135319 638000))
+;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21774
+;;;;;; 38574 225319 550000))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
@@ -12497,8 +12524,8 @@ Declare back end NAME with ABILITIES as a Gnus back end.
;;;***
-;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21715 20800
-;;;;;; 626041 761000))
+;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21785 8881 6781
+;;;;;; 649000))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
@@ -12817,8 +12844,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if
successful.
;;;***
-;;;### (autoloads nil "gud" "progmodes/gud.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "gud" "progmodes/gud.el" (21769 20661 366048
+;;;;;; 601000))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
@@ -12913,8 +12940,8 @@ it if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21750 59840 206034
+;;;;;; 761000))
;;; Generated autoloads from emacs-lisp/gv.el
(autoload 'gv-get "gv" "\
@@ -14636,7 +14663,7 @@ The main features of this mode are
;;;***
-;;;### (autoloads nil "ido" "ido.el" (21694 14651 747488 989000))
+;;;### (autoloads nil "ido" "ido.el" (21767 65327 504606 256000))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
@@ -14862,7 +14889,7 @@ PROMPT is the prompt to give to the user. DEFAULT if
given is the default
buffer to be selected, which will go to the front of the list.
If REQUIRE-MATCH is non-nil, an existing buffer must be selected.
-\(fn PROMPT &optional DEFAULT REQUIRE-MATCH)" nil nil)
+\(fn PROMPT &optional DEFAULT REQUIRE-MATCH PREDICATE)" nil nil)
(autoload 'ido-read-file-name "ido" "\
Ido replacement for the built-in `read-file-name'.
@@ -15768,8 +15795,8 @@ completion alternatives to currently visited manuals.
;;;***
-;;;### (autoloads nil "info-look" "info-look.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "info-look" "info-look.el" (21764 2734 445319
+;;;;;; 586000))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
@@ -15995,8 +16022,8 @@ Toggle input method in interactive search.
;;;***
-;;;### (autoloads nil "isearchb" "isearchb.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "isearchb" "isearchb.el" (21767 65327 504606
+;;;;;; 256000))
;;; Generated autoloads from isearchb.el
(push (purecopy '(isearchb 1 5)) package--builtin-versions)
@@ -16109,8 +16136,8 @@ Add submenus to the File menu, to convert to and from
various formats.
;;;***
-;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21670 32331
-;;;;;; 885635 586000))
+;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t
exclusive))))
@@ -16445,7 +16472,7 @@ by `jka-compr-installed'.
;;;***
-;;;### (autoloads nil "js" "progmodes/js.el" (21681 2618 385332 620000))
+;;;### (autoloads nil "js" "progmodes/js.el" (21760 5676 875320 615000))
;;; Generated autoloads from progmodes/js.el
(push (purecopy '(js 9)) package--builtin-versions)
@@ -16459,7 +16486,7 @@ Major mode for editing JavaScript.
;;;***
-;;;### (autoloads nil "json" "json.el" (21716 41663 456033 27000))
+;;;### (autoloads nil "json" "json.el" (21779 56495 106033 935000))
;;; Generated autoloads from json.el
(push (purecopy '(json 1 4)) package--builtin-versions)
@@ -17781,8 +17808,8 @@ recursion depth in the minibuffer prompt. This is only
useful if
;;;***
-;;;### (autoloads nil "message" "gnus/message.el" (21706 5826 304666
-;;;;;; 725000))
+;;;### (autoloads nil "message" "gnus/message.el" (21759 29151 445319
+;;;;;; 109000))
;;; Generated autoloads from gnus/message.el
(define-mail-user-agent 'message-user-agent 'message-mail
'message-send-and-exit 'message-kill-buffer 'message-send-hook)
@@ -18283,8 +18310,8 @@ The return value is always nil.
;;;***
-;;;### (autoloads nil "misearch" "misearch.el" (21691 38459 74604
-;;;;;; 918000))
+;;;### (autoloads nil "misearch" "misearch.el" (21767 65327 504606
+;;;;;; 256000))
;;; Generated autoloads from misearch.el
(add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -20199,8 +20226,8 @@ See the command `outline-mode' for more information on
this mode.
;;;***
-;;;### (autoloads nil "package" "emacs-lisp/package.el" (21737 47805
-;;;;;; 354975 322000))
+;;;### (autoloads nil "package" "emacs-lisp/package.el" (21787 50612
+;;;;;; 215339 172000))
;;; Generated autoloads from emacs-lisp/package.el
(push (purecopy '(package 1 0 1)) package--builtin-versions)
@@ -20215,6 +20242,28 @@ activate the package system at any time.")
(custom-autoload 'package-enable-at-startup "package" t)
+(autoload 'package-initialize "package" "\
+Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+
+\(fn &optional NO-ACTIVATE)" t nil)
+
+(autoload 'package-import-keyring "package" "\
+Import keys from FILE.
+
+\(fn &optional FILE)" t nil)
+
+(autoload 'package-refresh-contents "package" "\
+Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument, ASYNC, specifies whether the downloads should
+be performed in the background.
+
+\(fn &optional ASYNC)" t nil)
+
(autoload 'package-install "package" "\
Install the package PKG.
PKG can be a package-desc or the package name of one the available packages
@@ -20228,13 +20277,6 @@ to install it but still mark it as selected.
\(fn PKG &optional DONT-SELECT)" t nil)
-(autoload 'package-reinstall "package" "\
-Reinstall package PKG.
-PKG should be either a symbol, the package name, or a package-desc
-object.
-
-\(fn PKG)" t nil)
-
(autoload 'package-install-from-buffer "package" "\
Install a package from the current buffer.
The current buffer is assumed to be a single .el or .tar file or
@@ -20261,6 +20303,13 @@ If some packages are not installed propose to install
them.
\(fn)" t nil)
+(autoload 'package-reinstall "package" "\
+Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object.
+
+\(fn PKG)" t nil)
+
(autoload 'package-autoremove "package" "\
Remove packages that are no more needed.
@@ -20270,25 +20319,6 @@ will be deleted.
\(fn)" t nil)
-(autoload 'package-import-keyring "package" "\
-Import keys from FILE.
-
-\(fn &optional FILE)" t nil)
-
-(autoload 'package-refresh-contents "package" "\
-Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download.
-
-\(fn)" t nil)
-
-(autoload 'package-initialize "package" "\
-Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages.
-
-\(fn &optional NO-ACTIVATE)" t nil)
-
(autoload 'describe-package "package" "\
Display the full documentation of PACKAGE (a symbol).
@@ -20418,8 +20448,8 @@ Check if KEY is in the cache.
;;;***
-;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21739 3132 687120
-;;;;;; 143000))
+;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
@@ -20433,7 +20463,6 @@ UPatterns can take the following forms:
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
'VAL matches if the object is `equal' to VAL
- `QPAT matches if the QPattern QPAT matches.
(pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let UPAT EXP) matches if EXP matches UPAT.
@@ -20441,14 +20470,6 @@ UPatterns can take the following forms:
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
- its 0..(n-1)th elements, respectively.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-
FUN can take the form
SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
@@ -20461,6 +20482,9 @@ E.g. you can match pairs where the cdr is larger than
the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:
+
\(fn EXP &rest CASES)" nil t)
(function-put 'pcase 'lisp-indent-function '1)
@@ -20473,8 +20497,10 @@ The exhaustive version of `pcase' (which see).
(function-put 'pcase-exhaustive 'lisp-indent-function '1)
(autoload 'pcase-lambda "pcase" "\
-Like `lambda' but allow each argument to be a pattern.
-`&rest' argument is supported.
+Like `lambda' but allow each argument to be a UPattern.
+I.e. accepts the usual &optional and &rest keywords, but every
+formal argument can be any pattern accepted by `pcase' (a mere
+variable name being but a special case of it).
\(fn LAMBDA-LIST &rest BODY)" nil t)
@@ -20948,8 +20974,8 @@ they are not by default assigned to keys.
;;;***
-;;;### (autoloads nil "plstore" "gnus/plstore.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "plstore" "gnus/plstore.el" (21786 29744 368212
+;;;;;; 633000))
;;; Generated autoloads from gnus/plstore.el
(autoload 'plstore-open "plstore" "\
@@ -21987,10 +22013,10 @@ If EXTENSION is any other symbol, it is ignored.
;;;***
-;;;### (autoloads nil "python" "progmodes/python.el" (21743 190 195328
-;;;;;; 729000))
+;;;### (autoloads nil "python" "progmodes/python.el" (21781 11826
+;;;;;; 448890 994000))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy '(python 0 24 4)) package--builtin-versions)
+(push (purecopy '(python 0 24 5)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
@@ -22044,8 +22070,8 @@ them into characters should be done separately.
;;;***
-;;;### (autoloads nil "quail" "international/quail.el" (21673 8506
-;;;;;; 69195 402000))
+;;;### (autoloads nil "quail" "international/quail.el" (21761 26543
+;;;;;; 734945 674000))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
@@ -22275,8 +22301,8 @@ of each directory.
;;;***
-;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21770
+;;;;;; 41522 196747 399000))
;;; Generated autoloads from leim/quail/hangul.el
(autoload 'hangul-input-method-activate "quail/hangul" "\
@@ -22955,8 +22981,8 @@ variable.
;;;***
-;;;### (autoloads nil "rmail" "mail/rmail.el" (21748 38880 365329
-;;;;;; 577000))
+;;;### (autoloads nil "rmail" "mail/rmail.el" (21756 8970 306748
+;;;;;; 51000))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-file-name (purecopy "~/RMAIL") "\
@@ -23403,8 +23429,8 @@ for modes derived from Text mode, like Mail mode.
;;;***
-;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21771
+;;;;;; 62389 36768 739000))
;;; Generated autoloads from progmodes/ruby-mode.el
(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
@@ -23977,8 +24003,8 @@ Major mode for editing Wisent grammars.
;;;***
-;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21670 32331
-;;;;;; 385639 720000))
+;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21786 29744
+;;;;;; 368212 633000))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
@@ -24259,10 +24285,10 @@ Like `mail' command, but display mail buffer in
another frame.
;;;***
-;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (21724 35774 954622
-;;;;;; 790000))
+;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (21778 35636 244616
+;;;;;; 784000))
;;; Generated autoloads from emacs-lisp/seq.el
-(push (purecopy '(seq 1 2)) package--builtin-versions)
+(push (purecopy '(seq 1 3)) package--builtin-versions)
;;;***
@@ -24377,8 +24403,8 @@ formula:
;;;***
-;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21775
+;;;;;; 59440 64641 144000))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
@@ -25352,10 +25378,10 @@ Return a vector containing the lines from
`spook-phrases-file'.
;;;***
-;;;### (autoloads nil "sql" "progmodes/sql.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "sql" "progmodes/sql.el" (21765 23600 805241
+;;;;;; 145000))
;;; Generated autoloads from progmodes/sql.el
-(push (purecopy '(sql 3 4)) package--builtin-versions)
+(push (purecopy '(sql 3 5)) package--builtin-versions)
(autoload 'sql-add-product-keywords "sql" "\
Add highlighting KEYWORDS for SQL PRODUCT.
@@ -26889,7 +26915,7 @@ Normally input is edited in Emacs and sent a line at a
time.
;;;***
-;;;### (autoloads nil "term" "term.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "term" "term.el" (21775 59440 64641 144000))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -28045,8 +28071,8 @@ Its value should be an event that has a binding in MENU.
;;;***
-;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21750
+;;;;;; 59840 206034 761000))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-show "todo-mode" "\
@@ -28244,8 +28270,8 @@ the output buffer or changing the window configuration.
;;;***
-;;;### (autoloads nil "tramp" "net/tramp.el" (21704 50495 455324
-;;;;;; 752000))
+;;;### (autoloads nil "tramp" "net/tramp.el" (21766 44463 655319
+;;;;;; 936000))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
@@ -28331,7 +28357,7 @@ Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
(let ((directory-sep-char 47) (fn (assoc operation
tramp-completion-file-name-handler-alist))) (if (and fn tramp-mode (or (eq
tramp-syntax (quote sep)) (featurep (quote tramp)) (and (boundp (quote
partial-completion-mode)) (symbol-value (quote partial-completion-mode)))
(featurep (quote ido)) (featurep (quote icicles)))) (save-match-data (apply
(cdr fn) args)) (tramp-completion-run-real-handler operation args))))
(defun tramp-autoload-file-name-handler (operation &rest args) "\
-Load Tramp file name handler, and perform OPERATION." (let ((default-directory
(or (symbol-value (quote temporary-file-directory)) "/"))) (load "tramp" nil
t)) (apply operation args))
+Load Tramp file name handler, and perform OPERATION." (let ((default-directory
"/")) (load "tramp" nil t)) (apply operation args))
(defun tramp-register-autoload-file-name-handlers nil "\
Add Tramp file name handlers to `file-name-handler-alist' during autoload."
(add-to-list (quote file-name-handler-alist) (cons tramp-file-name-regexp
(quote tramp-autoload-file-name-handler))) (put (quote
tramp-autoload-file-name-handler) (quote safe-magic) t) (add-to-list (quote
file-name-handler-alist) (cons tramp-completion-file-name-regexp (quote
tramp-completion-file-name-handler))) (put (quote
tramp-completion-file-name-handler) (quote safe-magic) t))
@@ -28912,8 +28938,8 @@ overriding the value of `url-gateway-method'.
;;;***
-;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21766
+;;;;;; 44463 655319 936000))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
@@ -31903,8 +31929,8 @@ The argument has the same meaning as in `apropos'.
;;;***
-;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21779 56495 106033
+;;;;;; 935000))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
@@ -32035,46 +32061,46 @@ Zone out, completely.
;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el"
;;;;;; "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el"
;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-opt.el"
-;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/lisp-mnt.el"
"emacs-lisp/package-x.el"
-;;;;;; "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el"
-;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el"
"emulation/edt-lk201.el"
-;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el"
"emulation/edt-vt100.el"
-;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el"
"emulation/viper-init.el"
-;;;;;; "emulation/viper-keym.el" "emulation/viper-macs.el"
"emulation/viper-mous.el"
-;;;;;; "emulation/viper-util.el" "erc/erc-backend.el" "erc/erc-goodies.el"
-;;;;;; "erc/erc-ibuffer.el" "erc/erc-lang.el" "eshell/em-alias.el"
-;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el"
-;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el"
-;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el"
-;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el"
-;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
-;;;;;; "eshell/em-xtra.el" "eshell/esh-arg.el" "eshell/esh-cmd.el"
-;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el"
-;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el"
-;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "format-spec.el"
-;;;;;; "fringe.el" "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el"
-;;;;;; "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" "gnus/gnus-cloud.el"
-;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el"
-;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-icalendar.el"
-;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el"
-;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-srvr.el"
-;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el"
-;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el"
"gnus/ietf-drums.el"
-;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el"
-;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el"
-;;;;;; "gnus/mm-archive.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
-;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el"
"gnus/mml-smime.el"
-;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el"
-;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el"
-;;;;;; "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" "gnus/nnmaildir.el"
-;;;;;; "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el"
-;;;;;; "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" "gnus/nnspool.el"
-;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/registry.el"
-;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2231.el"
-;;;;;; "gnus/rtree.el" "gnus/sieve-manage.el" "gnus/smime.el"
"gnus/spam-stat.el"
-;;;;;; "gnus/spam-wash.el" "hex-util.el" "hfy-cmap.el" "ibuf-ext.el"
-;;;;;; "international/cp51932.el" "international/eucjp-ms.el"
"international/fontset.el"
-;;;;;; "international/iso-ascii.el" "international/ja-dic-cnv.el"
+;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/generator.el"
+;;;;;; "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" "emacs-lisp/smie.el"
+;;;;;; "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el"
"emacs-lisp/tcover-unsafep.el"
+;;;;;; "emulation/cua-gmrk.el" "emulation/edt-lk201.el"
"emulation/edt-mapper.el"
+;;;;;; "emulation/edt-pc.el" "emulation/edt-vt100.el" "emulation/viper-cmd.el"
+;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el"
"emulation/viper-keym.el"
+;;;;;; "emulation/viper-macs.el" "emulation/viper-mous.el"
"emulation/viper-util.el"
+;;;;;; "erc/erc-backend.el" "erc/erc-goodies.el" "erc/erc-ibuffer.el"
+;;;;;; "erc/erc-lang.el" "eshell/em-alias.el" "eshell/em-banner.el"
+;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el"
+;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el"
+;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el"
+;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el"
+;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el"
+;;;;;; "eshell/esh-arg.el" "eshell/esh-cmd.el" "eshell/esh-ext.el"
+;;;;;; "eshell/esh-groups.el" "eshell/esh-io.el" "eshell/esh-module.el"
+;;;;;; "eshell/esh-opt.el" "eshell/esh-proc.el" "eshell/esh-util.el"
+;;;;;; "eshell/esh-var.el" "ezimage.el" "format-spec.el" "fringe.el"
+;;;;;; "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el"
"gnus/gnus-bcklg.el"
+;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cloud.el" "gnus/gnus-cus.el"
+;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el"
+;;;;;; "gnus/gnus-ems.el" "gnus/gnus-icalendar.el" "gnus/gnus-int.el"
+;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el"
+;;;;;; "gnus/gnus-score.el" "gnus/gnus-srvr.el" "gnus/gnus-topic.el"
+;;;;;; "gnus/gnus-undo.el" "gnus/gnus-util.el" "gnus/gnus-uu.el"
+;;;;;; "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el"
"gnus/legacy-gnus-agent.el"
+;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el"
+;;;;;; "gnus/mailcap.el" "gnus/messcompat.el" "gnus/mm-archive.el"
+;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/mm-util.el"
+;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el"
"gnus/nnagent.el"
+;;;;;; "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" "gnus/nneething.el"
+;;;;;; "gnus/nngateway.el" "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnir.el"
+;;;;;; "gnus/nnmail.el" "gnus/nnmaildir.el" "gnus/nnmairix.el"
"gnus/nnmbox.el"
+;;;;;; "gnus/nnmh.el" "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el"
+;;;;;; "gnus/nnrss.el" "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el"
+;;;;;; "gnus/nnweb.el" "gnus/registry.el" "gnus/rfc1843.el" "gnus/rfc2045.el"
+;;;;;; "gnus/rfc2047.el" "gnus/rfc2231.el" "gnus/rtree.el"
"gnus/sieve-manage.el"
+;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el"
+;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el"
"international/eucjp-ms.el"
+;;;;;; "international/fontset.el" "international/iso-ascii.el"
"international/ja-dic-cnv.el"
;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "kermit.el"
;;;;;; "language/hanja-util.el" "language/thai-word.el" "ldefs-boot.el"
;;;;;; "leim/quail/arabic.el" "leim/quail/croatian.el"
"leim/quail/cyril-jis.el"
@@ -32165,8 +32191,8 @@ Zone out, completely.
;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el"
;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el"
;;;;;; "vc/vc-filewise.el" "vcursor.el" "vt-control.el" "vt100-led.el"
-;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21748 43392 687411
-;;;;;; 995000))
+;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21787 50860 126301
+;;;;;; 167000))
;;;***
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 7e9bd5b..9fa7aa5 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1299,10 +1299,10 @@ external program defined by `sendmail-program'."
(error "Sending...failed to %s"
(buffer-substring (point-min) (point-max)))))))
(kill-buffer tembuf)
- (if (and (bufferp errbuf)
- (not error))
- (kill-buffer errbuf)
- (switch-to-buffer-other-window errbuf)))))
+ (when (buffer-live-p errbuf)
+ (if error
+ (switch-to-buffer-other-window errbuf)
+ (kill-buffer errbuf))))))
(autoload 'rmail-output-to-rmail-buffer "rmailout")
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 5fdb937..2ace316 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1949,20 +1949,20 @@ It must accept a buffer as its only required argument.")
(let ((buffers (buffer-list))
(frames (frame-list))
buffers-menu)
- ;; If requested, list only the N most recently selected buffers.
- (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- (if (> (length buffers) buffers-menu-max-size)
- (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
;; Make the menu of buffers proper.
(setq buffers-menu
- (let (alist)
+ (let ((i 0)
+ (limit (if (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1))
+ buffers-menu-max-size most-positive-fixnum))
+ alist)
;; Put into each element of buffer-list
;; the name for actual display,
;; perhaps truncated in the middle.
- (dolist (buf buffers)
- (let ((name (buffer-name buf)))
+ (while buffers
+ (let* ((buf (pop buffers))
+ (name (buffer-name buf)))
(unless (eq ?\s (aref name 0))
(push (menu-bar-update-buffers-1
(cons buf
@@ -1976,7 +1976,11 @@ It must accept a buffer as its only required argument.")
name (- (/
buffers-menu-buffer-name-length 2))))
name)
))
- alist))))
+ alist)
+ ;; If requested, list only the N most recently
+ ;; selected buffers.
+ (when (= limit (setq i (1+ i)))
+ (setq buffers nil)))))
(list (menu-bar-buffer-vector alist))))
;; Make a Frames menu if we have more than one frame.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index c50913f..5f3fa5d 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -486,9 +486,10 @@ must be one of the symbols `header', `mode', or
`vertical'."
`(menu-item "" ,(lambda () (interactive) (funcall exitfun))
:filter ,(lambda (cmd) (if dragged cmd)))))
;; Some of the events will of course end up looked up
- ;; with a mode-line or header-line prefix ...
+ ;; with a mode-line, header-line or vertical-line prefix ...
(define-key map [mode-line] map)
(define-key map [header-line] map)
+ (define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
;; prefix.
(define-key map [right-divider] map)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index b44bb71..c4ed233 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -31,90 +31,33 @@
;; different methods of remote control so there is one function for
;; each supported browser. If the chosen browser is not running, it
;; is started. Currently there is support for the following browsers,
-;; some of them probably now obsolete:
+;; as well as some other obsolete ones:
;; Function Browser Earliest version
;; browse-url-mozilla Mozilla Don't know
;; browse-url-firefox Firefox Don't know (tried with 1.0.1)
;; browse-url-chromium Chromium 3.0
-;; browse-url-galeon Galeon Don't know
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-netscape Netscape 1.1b1
-;; browse-url-mosaic XMosaic/mMosaic <= 2.4
-;; browse-url-cci XMosaic 2.5
;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
-;; browse-url-w3-gnudoit w3 remotely
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
;; browse-url-xdg-open Free Desktop xdg-open on Gnome, KDE,
Xfce4, LXDE
-;; browse-url-gnome-moz GNOME interface to Mozilla
;; browse-url-kde KDE konqueror (kfm)
;; browse-url-elinks Elinks Don't know (tried with
0.12.GIT)
-;; [A version of the Netscape browser is now free software
-;; <URL:http://www.mozilla.org/>, albeit not GPLed, so it is
-;; reasonable to have that as the default.]
-
-;; Note that versions of Netscape before 1.1b1 did not have remote
-;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html>.
-
;; Browsers can cache Web pages so it may be necessary to tell them to
;; reload the current page if it has changed (e.g., if you have edited
;; it). There is currently no perfect automatic solution to this.
-;; Netscape allows you to specify the id of the window you want to
-;; control but which window DO you want to control and how do you
-;; discover its id?
-
-;; William M. Perry's excellent "w3" WWW browser for
-;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
-;; has a function w3-follow-url-at-point, but that
-;; doesn't let you edit the URL like browse-url.
-;; The `gnuserv' package that can be used to control it in another
-;; Emacs process is available from
-;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
-
-;; Lynx is now distributed by the FSF. See also
-;; <URL:http://lynx.browser.org/>.
-
-;; Free graphical browsers that could be used by `browse-url-generic'
-;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
-;; <URL:http://www.unlv.edu/chimera/>, Arena
-;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena> and Amaya
-;; <URL:ftp://ftp.w3.org/pub/amaya>. mMosaic
-;; <URL:ftp://ftp.enst.fr/pub/mbone/mMosaic/>,
-;; <URL:http://www.enst.fr/~dauphin/mMosaic/> (with development
-;; support for Java applets and multicast) can be used like Mosaic by
-;; setting `browse-url-mosaic-program' appropriately.
-
-;; I [Denis Howe, not Dave Love] recommend Nelson Minar
-;; <address@hidden>'s excellent html-helper-mode.el for editing
-;; HTML and thank Nelson for his many useful comments on this code.
-;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>
-
-;; See also hm--html-menus <URL:http://www.tnt.uni-hannover.de/%7Emuenkel/
-;; software/own/hm--html-menus/>. For composing correct HTML see also
-;; PSGML the general SGML structure editor package
-;; <URL:ftp://ftp.lysator.liu.se/pub/sgml>; hm--html-menus can be used
-;; with this.
-
;; This package generalizes function html-previewer-process in Marc
;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the
;; ffap.el package. The huge hyperbole package also contains similar
;; functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Help!
-
-;; Can you write and test some code for the Macintrash and Windoze
-;; Netscape remote control APIs? (See the URL above).
-
-;; Do any other browsers have remote control?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Usage
;; To display the URL at or before point:
@@ -170,34 +113,9 @@
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To get round the Netscape caching problem, you could EITHER have
-;; write-file in html-helper-mode make Netscape reload the document:
-;;
-;; (autoload 'browse-url-netscape-reload "browse-url"
-;; "Ask a WWW browser to redisplay the current file." t)
-;; (add-hook 'html-helper-mode-hook
-;; (lambda ()
-;; (add-hook 'local-write-file-hooks
-;; (lambda ()
-;; (let ((local-write-file-hooks))
-;; (save-buffer))
-;; (browse-url-netscape-reload)
-;; t) ; => file written by
hook
-;; t))) ; append to l-w-f-hooks
-;;
-;; OR have browse-url-of-file ask Netscape to load and then reload the
-;; file:
-;;
-;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
-
-;; You may also want to customize browse-url-netscape-arguments, e.g.
-;; (setq browse-url-netscape-arguments '("-install"))
-;;
-;; or similarly for the other browsers.
-
;; To invoke different browsers for different URLs:
;; (setq browse-url-browser-function '(("^mailto:"; . browse-url-mail)
-;; ("." . browse-url-netscape)))
+;; ("." . browse-url-firefox)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
@@ -226,17 +144,11 @@ function is passed the URL and any other args of
`browse-url'. The last
regexp should probably be \".\" to specify a default browser."
:type '(choice
(function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "W3 in another Emacs via `gnudoit'"
- :value browse-url-w3-gnudoit)
(function-item :tag "eww" :value eww-browse-url)
(function-item :tag "Mozilla" :value browse-url-mozilla)
(function-item :tag "Firefox" :value browse-url-firefox)
(function-item :tag "Chromium" :value browse-url-chromium)
- (function-item :tag "Galeon" :value browse-url-galeon)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Netscape" :value browse-url-netscape)
- (function-item :tag "Mosaic" :value browse-url-mosaic)
- (function-item :tag "Mosaic using CCI" :value browse-url-cci)
(function-item :tag "Conkeror" :value browse-url-conkeror)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
@@ -250,8 +162,6 @@ regexp should probably be \".\" to specify a default
browser."
:value browse-url-default-windows-browser)
(function-item :tag "Default Mac OS X browser"
:value browse-url-default-macosx-browser)
- (function-item :tag "GNOME invoking Mozilla"
- :value browse-url-gnome-moz)
(function-item :tag "Default browser"
:value browse-url-default-browser)
(function :tag "Your own function")
@@ -284,18 +194,25 @@ system, given vroot.h from the same directory, with cc
flags
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
+
(defcustom browse-url-netscape-arguments nil
"A list of strings to pass to Netscape as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
+
(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
"A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument"))
+
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
+
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
:type '(choice string (const :tag "Default" nil))
@@ -363,11 +280,15 @@ Defaults to the value of `browse-url-firefox-arguments'
at the time
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
+
(defcustom browse-url-galeon-arguments nil
"A list of strings to pass to Galeon as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
+
(defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments
"A list of strings to pass to Galeon when it starts up.
Defaults to the value of `browse-url-galeon-arguments' at the time
@@ -375,6 +296,8 @@ Defaults to the value of `browse-url-galeon-arguments' at
the time
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
+
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke Epiphany."
:type 'string
@@ -395,12 +318,16 @@ Defaults to the value of `browse-url-epiphany-arguments'
at the time
;; GNOME means of invoking either Mozilla or Netscape.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
+(make-obsolete-variable 'browse-url-gnome-moz-program nil "25.1")
+
(defcustom browse-url-gnome-moz-arguments '()
"A list of strings passed to the GNOME mozilla viewer as arguments."
:version "21.1"
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-gnome-moz-arguments nil "25.1")
+
(defcustom browse-url-mozilla-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
@@ -432,6 +359,8 @@ If non-nil, then open the URL in a new tab rather than a
new window if
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
+
(defcustom browse-url-epiphany-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
@@ -447,11 +376,12 @@ window."
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
+
(defcustom browse-url-new-window-flag nil
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
-commands reverses the effect of this variable. Requires Netscape version
-1.1N or later or XMosaic version 2.5 or later if using those browsers."
+commands reverses the effect of this variable."
:type 'boolean
:group 'browse-url)
@@ -461,16 +391,22 @@ commands reverses the effect of this variable. Requires
Netscape version
:version "20.3"
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
+
(defcustom browse-url-mosaic-arguments nil
"A list of strings to pass to Mosaic as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
+
(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
"The name of the pidfile created by Mosaic."
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
+
(defcustom browse-url-conkeror-program "conkeror"
"The name by which to invoke Conkeror."
:type 'string
@@ -521,12 +457,8 @@ Used by the `browse-url-of-file' command."
:group 'browse-url)
(defcustom browse-url-of-file-hook nil
- "Run after `browse-url-of-file' has asked a browser to load a file.
-
-Set this to `browse-url-netscape-reload' to force Netscape to load the
-file rather than displaying a cached copy."
+ "Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook
- :options '(browse-url-netscape-reload)
:group 'browse-url)
(defcustom browse-url-CCI-port 3003
@@ -536,6 +468,8 @@ the value set in the browser."
:type 'integer
:group 'browse-url)
+(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
+
(defcustom browse-url-CCI-host "localhost"
"Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
@@ -543,6 +477,8 @@ enabled. The port number should be set in
`browse-url-CCI-port'."
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
+
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
@@ -594,6 +530,8 @@ incompatibly at version 4."
:type 'number
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
+
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
@@ -946,14 +884,14 @@ used instead of `browse-url-new-window-flag'."
((memq system-type '(darwin))
'browse-url-default-macosx-browser)
((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
- ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
+;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
((executable-find browse-url-chromium-program) 'browse-url-chromium)
- ((executable-find browse-url-galeon-program) 'browse-url-galeon)
+;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
- ((executable-find browse-url-netscape-program) 'browse-url-netscape)
- ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
+;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
+;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
@@ -1019,6 +957,7 @@ is loaded in a new tab in an existing window instead.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
@@ -1046,6 +985,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
@@ -1057,6 +997,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-netscape-reload ()
"Ask Netscape to reload its current document.
How depends on `browse-url-netscape-version'."
+ (declare (obsolete nil "25.1"))
(interactive)
;; Backwards incompatibility reported by
;; <address@hidden>.
@@ -1066,6 +1007,7 @@ How depends on `browse-url-netscape-version'."
(defun browse-url-netscape-send (command)
"Send a remote control command to Netscape."
+ (declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process "netscape" nil
browse-url-netscape-program
@@ -1184,6 +1126,7 @@ new tab in an existing window instead.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
@@ -1205,6 +1148,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
@@ -1287,6 +1231,7 @@ effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(apply 'start-process (concat "gnome-moz-remote " url)
nil
@@ -1315,6 +1260,7 @@ the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
pid)
@@ -1365,6 +1311,7 @@ the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(open-network-stream "browse-url" " *browse-url*"
browse-url-CCI-host browse-url-CCI-port)
@@ -1443,6 +1390,7 @@ used instead of `browse-url-new-window-flag'."
"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
`browse-url-gnudoit-args'. Default to the URL around or before point."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
(apply 'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index b82b4de..f59c5fb 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1175,15 +1175,19 @@ target of the symlink differ."
(tramp-message vec 5 "file attributes with ls: %s" localname)
(tramp-send-command
vec
- (format "(%s %s || %s -h %s) && %s %s %s"
+ (format "(%s %s || %s -h %s) && %s %s %s %s"
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ "--quoting-style=c" "")
(if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname)))
- ;; parse `ls -l' output ...
+ ;; Parse `ls -l' output ...
(with-current-buffer (tramp-get-buffer vec)
(when (> (buffer-size) 0)
(goto-char (point-min))
@@ -1222,11 +1226,14 @@ target of the symlink differ."
;; From the file modes, figure out other stuff.
(setq symlinkp (eq ?l (aref res-filemodes 0)))
(setq dirp (eq ?d (aref res-filemodes 0)))
- ;; if symlink, find out file name pointed to
+ ;; If symlink, find out file name pointed to.
(when symlinkp
(search-forward "-> ")
- (setq res-symlink-target (buffer-substring (point) (point-at-eol))))
- ;; return data gathered
+ (setq res-symlink-target
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ (read (current-buffer))
+ (buffer-substring (point) (point-at-eol)))))
+ ;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for symbolic
;; link, or nil.
@@ -1249,9 +1256,9 @@ target of the symlink differ."
;; 8. File modes, as a string of ten letters or dashes as in ls -l.
res-filemodes
;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'
+ ;; recreated. Will be set in `tramp-convert-file-attributes'.
t
- ;; 10. inode number.
+ ;; 10. Inode number.
res-inode
;; 11. Device number. Will be replaced by a virtual device number.
-1
@@ -1275,16 +1282,21 @@ target of the symlink differ."
(tramp-send-command-and-read
vec
(format
- ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
- ;; parse correctly the sequence "((". Therefore, we add a space.
- "( (%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0
%%se0 \"%%A\" t %%ie0 -1)' \"%s\" || echo nil)"
+ (concat
+ ;; On Opsware, pdksh (which is the true name of ksh there)
+ ;; doesn't parse correctly the sequence "((". Therefore, we add
+ ;; a space. Apostrophes in the stat output are masked as "//",
+ ;; in order to make a proper shell escape of them in file names.
+ "( (%s %s || %s -h %s) && (%s -c "
+ "'((//%%N//) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 //%%A// t %%ie0 -1)' "
+ "%s | sed -e 's/\"/\\\\\"/g' -e 's/\\/\\//\"/g') || echo nil)")
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "\"%U\"")
- (if (eq id-format 'integer) "%ge0" "\"%G\"")
+ (if (eq id-format 'integer) "%ue0" "//%U//")
+ (if (eq id-format 'integer) "%ge0" "//%G//")
(tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
@@ -1717,14 +1729,13 @@ be non-negative integers."
(concat
;; We must care about file names with spaces, or starting with
;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
- ;; but it does not work on all remote systems. Therefore, we
- ;; use \000 as file separator.
- ;; Apostrophes in the stat output are masked as ?/ characters, in
- ;; order to make a proper shell escape of them in file names.
+ ;; but it does not work on all remote systems. Apostrophes in
+ ;; the stat output are masked as "//", in order to make a proper
+ ;; shell escape of them in file names.
"cd %s && echo \"(\"; (%s %s -a | "
"xargs %s -c "
- "'(/%%n/ (/%%N/) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 /%%A/ t %%ie0 -1)' "
- "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/\\//\"/g'); echo \")\"")
+ "'(//%%n// (//%%N//) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 //%%A// t %%ie0
-1)' "
+ "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/\\/\\//\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with
@@ -1732,8 +1743,8 @@ be non-negative integers."
(if (tramp-get-ls-command-with-quoting-style vec)
"--quoting-style=shell" "")
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "/%U/")
- (if (eq id-format 'integer) "%ge0" "/%G/"))))
+ (if (eq id-format 'integer) "%ue0" "//%U//")
+ (if (eq id-format 'integer) "%ge0" "//%G//"))))
;; This function should return "foo/" for directories and "bar" for
;; files.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 4d16a9b..ee5a5a6 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -495,9 +495,9 @@ parameters \(point-min) and \(point-max).")
(c-lang-defconst c-before-font-lock-functions
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
- t 'c-change-set-fl-decl-start
+ t 'c-change-expand-fl-region
(c c++ objc) '(c-neutralize-syntax-in-and-mark-CPP
- c-change-set-fl-decl-start)
+ c-change-expand-fl-region)
awk 'c-awk-extend-and-syntax-tablify-region)
(c-lang-defvar c-before-font-lock-functions
(let ((fs (c-lang-const c-before-font-lock-functions)))
@@ -524,7 +524,7 @@ parameters \(point-min), \(point-max) and <buffer size>.")
(c-lang-defconst c-before-context-fontification-functions
awk nil
- t 'c-context-set-fl-decl-start)
+ t 'c-context-expand-fl-region)
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
(c-lang-defvar c-before-context-fontification-functions
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index f84f4ae..d88fe70 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1148,11 +1148,11 @@ Note that the style variables are always made local to
the buffer."
(funcall fn beg end old-len))
c-before-font-lock-functions))))))
-(defun c-set-fl-decl-start (pos)
+(defun c-fl-decl-start (pos)
;; If the beginning of the line containing POS is in the middle of a "local"
;; declaration (i.e. one which does not start outside of braces enclosing
;; POS, such as a struct), return the beginning of that declaration.
- ;; Otherwise return POS. Note that declarations, in this sense, can be
+ ;; Otherwise return nil. Note that declarations, in this sense, can be
;; nested.
;;
;; This function is called indirectly from font locking stuff - either from
@@ -1189,29 +1189,50 @@ Note that the style variables are always made local to
the buffer."
(1- (point)) 'syntax-table)
c-<-as-paren-syntax)))))
(not (bobp)))
- (backward-char))
- new-pos)) ; back over (, [, <.
-
-(defun c-change-set-fl-decl-start (_beg _end _old-len)
- ;; Set c-new-BEG to the beginning of a "local" declaration if it('s BOL) is
- ;; inside one. This is called from an after-change-function, but the
- ;; parameters BEG END and OLD-LEN are ignored. See `c-set-fl-decl-start'
- ;; for the detailed functionality.
- (if font-lock-mode
- (setq c-new-BEG (c-set-fl-decl-start c-new-BEG))))
-
-(defun c-context-set-fl-decl-start (beg end)
- ;; Return a cons (NEW-BEG . END), where NEW-BEG is the beginning of a
- ;; "local" declaration (BOL at) NEW is inside or BEG. See
- ;; `c-set-fl-decl-start' for the detailed functionality.
- (cons (c-set-fl-decl-start beg) end))
+ (backward-char)) ; back over (, [, <.
+ (and (/= new-pos pos) new-pos)))
+
+(defun c-change-expand-fl-region (beg end old-len)
+ ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
+ ;; region. This will usually be the smallest sequence of whole lines
+ ;; containing `c-new-BEG' and `c-new-END', but if `c-new-BEG' is in a
+ ;; "local" declaration (see `c-fl-decl-start') the beginning of this is used
+ ;; as the lower bound.
+ ;;
+ ;; This is called from an after-change-function, but the parameters BEG END
+ ;; and OLD-LEN are not used.
+ (if font-lock-mode
+ (setq c-new-BEG
+ (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
+ c-new-END (c-point 'bonl c-new-END))))
+
+(defun c-context-expand-fl-region (beg end)
+ ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
+ ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is
+ ;; in. NEW-END is beginning of the line after the one END is in.
+ (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
+ (c-point 'bonl end)))
+
+(defun c-before-context-fl-expand-region (beg end)
+ ;; Expand the region (BEG END) as specified by
+ ;; `c-before-context-fontification-functions'. Return a cons of the bounds
+ ;; of the new region.
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((new-beg beg) (new-end end) new-region)
+ (mapc (lambda (fn)
+ (setq new-region (funcall fn new-beg new-end))
+ (setq new-beg (car new-region) new-end (cdr new-region)))
+ c-before-context-fontification-functions)
+ new-region))))
(defun c-font-lock-fontify-region (beg end &optional verbose)
;; Effectively advice around `font-lock-fontify-region' which extends the
;; region (BEG END), for example, to avoid context fontification chopping
- ;; off the start of the context. Do not do anything if it's already been
- ;; done (i.e. from an after-change fontification. An example (C++) where
- ;; this used to happen is this:
+ ;; off the start of the context. Do not extend the region if it's already
+ ;; been done (i.e. from an after-change fontification. An example (C++)
+ ;; where the chopping off used to happen is this:
;;
;; template <typename T>
;;
@@ -1220,17 +1241,39 @@ Note that the style variables are always made local to
the buffer."
;;
;; Type a space in the first blank line, and the fontification of the next
;; line was fouled up by context fontification.
- (let ((new-beg beg) (new-end end) new-region case-fold-search
- open-paren-in-column-0-is-defun-start)
- (if c-in-after-change-fontification
- (setq c-in-after-change-fontification nil)
- (save-restriction
- (widen)
- (save-excursion
- (mapc (lambda (fn)
- (setq new-region (funcall fn new-beg new-end))
- (setq new-beg (car new-region) new-end (cdr new-region)))
- c-before-context-fontification-functions))))
+ (let (new-beg new-end new-region case-fold-search
+ open-paren-in-column-0-is-defun-start)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously to
+ ;; BOL, which position likely has a syntactically
+ ;; different position. To ensure correct fontification,
+ ;; we start at `c-new-BEG', assuming any characters to the
+ ;; left of `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
(funcall (default-value 'font-lock-fontify-region-function)
new-beg new-end verbose)))
@@ -1277,7 +1320,7 @@ This function is called from `c-common-init', once per
mode initialization."
;; Emacs 22 and later.
(defun c-extend-after-change-region (_beg _end _old-len)
"Extend the region to be fontified, if necessary."
- ;; Note: the parameters are ignored here. This somewhat indirect
+ ;; Note: the parameter OLD-LEN is ignored here. This somewhat indirect
;; implementation exists because it is minimally different from the
;; stand-alone CC Mode which, lacking
;; font-lock-extend-after-change-region-function, is forced to use advice
@@ -1286,6 +1329,13 @@ This function is called from `c-common-init', once per
mode initialization."
;; Of the seven CC Mode languages, currently (2009-05) only C, C++, Objc
;; (the languages with #define) and AWK Mode make non-null use of this
;; function.
+ (when (eq font-lock-support-mode 'jit-lock-mode)
+ (save-restriction
+ (widen)
+ (if (< c-new-BEG beg)
+ (put-text-property c-new-BEG beg 'fontified nil))
+ (if (> c-new-END end)
+ (put-text-property end c-new-END 'fontified nil))))
(cons c-new-BEG c-new-END))
;; Emacs < 22 and XEmacs
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 42272a9..67b44aa 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -696,6 +696,12 @@ It makes underscores and dots word constituent chars.")
:group 'python
:safe 'booleanp)
+(defcustom python-indent-guess-indent-offset-verbose t
+ "Non-nil means to emit a warning when indentation guessing fails."
+ :type 'boolean
+ :group 'python
+ :safe' booleanp)
+
(defcustom python-indent-trigger-commands
'(indent-for-tab-command yas-expand yas/expand)
"Commands that might trigger a `python-indent-line' call."
@@ -766,8 +772,9 @@ work on `python-indent-calculate-indentation' instead."
(current-indentation))))
(if (and indentation (not (zerop indentation)))
(set (make-local-variable 'python-indent-offset) indentation)
- (message "Can't guess python-indent-offset, using defaults: %s"
- python-indent-offset)))))))
+ (when python-indent-guess-indent-offset-verbose
+ (message "Can't guess python-indent-offset, using defaults: %s"
+ python-indent-offset))))))))
(defun python-indent-context ()
"Get information about the current indentation context.
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 921ca31..f2fb95c 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -2069,8 +2069,10 @@ See `font-lock-syntax-table'.")
ruby-font-lock-keyword-beg-re
(regexp-opt
'( ;; built-in methods on Kernel
+ "at_exit"
"autoload"
"autoload?"
+ "callcc"
"catch"
"eval"
"exec"
@@ -2124,10 +2126,8 @@ See `font-lock-syntax-table'.")
"__dir__"
"__method__"
"abort"
- "at_exit"
"binding"
"block_given?"
- "callcc"
"caller"
"exit"
"exit!"
@@ -2143,8 +2143,7 @@ See `font-lock-syntax-table'.")
"readline"
"readlines"
"sleep"
- "srand"
- "throw")
+ "srand")
'symbols))
(1 font-lock-builtin-face))
;; Here-doc beginnings.
diff --git a/lisp/simple.el b/lisp/simple.el
index 98188a0..5185607 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4807,7 +4807,8 @@ run `deactivate-mark-hook'."
;; the region prior to the last command modifying the buffer.
;; Set the selection to that, or to the current region.
(cond (saved-region-selection
- (gui-set-selection 'PRIMARY saved-region-selection)
+ (if (gui-call gui-selection-owner-p 'PRIMARY)
+ (gui-set-selection 'PRIMARY saved-region-selection))
(setq saved-region-selection nil))
;; If another program has acquired the selection, region
;; deactivation should not clobber it (Bug#11772).
@@ -5409,7 +5410,10 @@ lines."
(declare-function font-info "font.c" (name &optional frame))
(defun default-font-height ()
- "Return the height in pixels of the current buffer's default face font."
+ "Return the height in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the height of the remapped face."
(let ((default-font (face-font 'default)))
(cond
((and (display-multi-font-p)
@@ -5420,6 +5424,25 @@ lines."
(aref (font-info default-font) 3))
(t (frame-char-height)))))
+(defun default-font-width ()
+ "Return the width in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the width of the remapped face."
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (let* ((info (font-info (face-font 'default)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10))))
+ (t (frame-char-width)))))
+
(defun default-line-height ()
"Return the pixel height of current buffer's default-face text line.
diff --git a/lisp/subr.el b/lisp/subr.el
index deadca6..163a1c4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1901,6 +1901,30 @@ and the file name is displayed in the echo area."
;;;; Process stuff.
+(defun start-process (name buffer program &rest program-args)
+ "Start a program in a subprocess. Return the process object for it.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer name) to associate with the process.
+
+Process output (both standard output and standard error streams) goes
+at end of BUFFER, unless you specify an output stream or filter
+function to handle the output. BUFFER may also be nil, meaning that
+this process is not associated with any buffer.
+
+PROGRAM is the program file name. It is searched for in `exec-path'
+\(which see). If nil, just associate a pty with the buffer. Remaining
+arguments are strings to give program as arguments.
+
+If you want to separate standard output from standard error, invoke
+the command through a shell and redirect one of them using the shell
+syntax."
+ (unless (fboundp 'make-process)
+ (error "Emacs was compiled without subprocess support"))
+ (apply #'make-process
+ (append (list :name name :buffer buffer)
+ (if program
+ (list :command (cons program program-args))))))
+
(defun process-lines (program &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
Signal an error if the program returns with a non-zero exit status."
diff --git a/lisp/term.el b/lisp/term.el
index a629af9..43138fa 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1145,7 +1145,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-scroll-show-maximum-output)
(make-local-variable 'term-ptyp)
(make-local-variable 'term-exec-hook)
- (make-local-variable 'term-vertical-motion)
+ (set (make-local-variable 'term-vertical-motion) 'vertical-motion)
(set (make-local-variable 'term-pending-delete-marker) (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
@@ -1155,6 +1155,13 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(set (make-local-variable 'font-lock-defaults) '(nil t))
+ (add-function :filter-return
+ (local 'window-adjust-process-window-size-function)
+ (lambda (size)
+ (when size
+ (term-reset-size (cdr size) (car size)))
+ size))
+
(easy-menu-add term-terminal-menu)
(easy-menu-add term-signals-menu)
(or term-input-ring
@@ -1197,12 +1204,6 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(goto-char save-point)))
found))
-(defun term-check-size (process)
- (when (or (/= term-height (window-text-height))
- (/= term-width (term-window-width)))
- (term-reset-size (window-text-height) (term-window-width))
- (set-process-window-size process term-height term-width)))
-
(defun term-send-raw-string (chars)
(deactivate-mark)
(let ((proc (get-buffer-process (current-buffer))))
@@ -2772,15 +2773,11 @@ See `term-prompt-regexp'."
(when (/= (point) (process-mark proc))
(setq save-point (point-marker)))
- ;; Note if the window size has changed. We used to reset
- ;; point too, but that gives incorrect results (Bug#4635).
- (if (eq (window-buffer) (current-buffer))
- (progn
- (setq term-vertical-motion (symbol-function 'vertical-motion))
- (term-check-size proc))
- (setq term-vertical-motion
- (symbol-function 'term-buffer-vertical-motion)))
- (setq save-marker (copy-marker (process-mark proc)))
+ (setf term-vertical-motion
+ (if (eq (window-buffer) (current-buffer))
+ 'vertical-motion
+ 'term-buffer-vertical-motion))
+ (setq save-marker (copy-marker (process-mark proc)))
(goto-char (process-mark proc))
(save-restriction
@@ -3082,9 +3079,7 @@ See `term-prompt-regexp'."
(eq (window-buffer selected) (current-buffer)))
(term-display-line (car term-pending-frame)
(cdr term-pending-frame))
- (setq term-pending-frame nil)
- ;; We have created a new window, so check the window size.
- (term-check-size proc))
+ (setq term-pending-frame nil))
;; Scroll each window displaying the buffer but (by default)
;; only if the point matches the process-mark we started with.
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 3e7612a..7280080 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -370,14 +370,13 @@ pseudo-classes, and at-rules."
(css--complete-at-rule)))
;;;###autoload
-(define-derived-mode css-mode fundamental-mode "CSS"
+(define-derived-mode css-mode prog-mode "CSS"
"Major mode to edit Cascading Style Sheets."
(setq-local font-lock-defaults css-font-lock-defaults)
(setq-local comment-start "/*")
(setq-local comment-start-skip "/\\*+[ \t]*")
(setq-local comment-end "*/")
(setq-local comment-end-skip "[ \t]*\\*+/")
- (setq-local parse-sexp-ignore-comments t)
(setq-local fill-paragraph-function 'css-fill-paragraph)
(setq-local add-log-current-defun-function #'css-current-defun-name)
(smie-setup css-smie-grammar #'css-smie-rules
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 12d98c8..8266647 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -46,6 +46,25 @@
:type 'integer
:group 'sgml)
+(defcustom sgml-attribute-offset 0
+ "Specifies a delta for attribute indentation in `sgml-indent-line'.
+
+When 0, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>
+
+When 2, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>"
+ :version "25.1"
+ :type 'integer
+ :safe 'integerp
+ :group 'sgml)
+
(defcustom sgml-xml-mode nil
"When non-nil, tag insertion functions will be XML-compliant.
It is set to be buffer-local when the file has
@@ -1510,13 +1529,13 @@ LCON is the lexical context, if any."
(`pi nil)
(`tag
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
(if (not (eolp))
(current-column)
;; This is the first attribute: indent.
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(+ (current-column) sgml-basic-offset)))
(`text
diff --git a/lisp/window.el b/lisp/window.el
index cc8a7fc..46a7dd0 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1835,6 +1835,61 @@ optional argument PIXELWISE is passed to the functions."
(window-body-width window pixelwise)
(window-body-height window pixelwise)))
+(defun window-font-width (&optional window face)
+ "Return average character width for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10)))
+ (frame-char-width))))
+
+(defun window-font-height (&optional window face)
+ "Return character height for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face))))
+ (aref info 3))
+ (frame-char-height))))
+
+(defun window-max-chars-per-line (&optional window face)
+ "Return the number of characters that can be displayed on one line in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The character width of FACE is used for the calculation. If FACE
+is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function uses the
+remapped face.
+
+This function is different from `window-body-width' in two
+ways. First, it accounts for the portions of the line reserved
+for the continuation glyph. Second, it accounts for the size of
+the font."
+ (with-selected-window (window-normalize-window window t)
+ (let* ((window-width (window-body-width window t))
+ (font-width (window-font-width window face))
+ (ncols (/ window-width font-width)))
+ (if (and (display-graphic-p)
+ overflow-newline-into-fringe
+ (/= (frame-parameter nil 'left-fringe) 0)
+ (/= (frame-parameter nil 'right-fringe) 0))
+ ncols
+ (1- ncols)))))
+
(defun window-current-scroll-bars (&optional window)
"Return the current scroll bar types for WINDOW.
WINDOW must be a live window and defaults to the selected one.
@@ -7974,7 +8029,107 @@ Otherwise, consult the value of
`truncate-partial-width-windows'
(window-buffer window))))
(if (integerp t-p-w-w)
(< (window-width window) t-p-w-w)
- t-p-w-w))))
+ t-p-w-w))))
+
+
+;; Automatically inform subprocesses of changes to window size.
+
+(defcustom window-adjust-process-window-size-function
+ 'window-adjust-process-window-size-smallest
+ "Control how Emacs chooses inferior process window sizes.
+Emacs uses this function to tell processes the space they have
+available for displaying their output. After each window
+configuration change, Emacs calls the value of
+`window-adjust-process-window-size-function' for each process
+with a buffer being displayed in at least one window.
+This function is responsible for combining the sizes of the
+displayed windows and returning a cons (WIDTH . HEIGHT)
+describing the width and height with which Emacs will call
+`set-process-window-size' for that process. If the function
+returns `nil', Emacs does not call `set-process-window-size'.
+
+This function is called with the process buffer as the current
+buffer and with two arguments: the process and a list of windows
+displaying process. Modes can make this variable buffer-local;
+additionally, the `adjust-window-size-function' process property
+overrides the global or buffer-local value of
+`window-adjust-process-window-size-function'."
+ :type '(choice
+ (const :tag "Minimum area of any window"
+ window-adjust-process-window-size-smallest)
+ (const :tag "Maximum area of any window"
+ window-adjust-process-window-size-largest)
+ (const :tag "Do not adjust process window sizes" ignore)
+ function)
+ :group 'windows
+ :version "25.1")
+
+(defun window-adjust-process-window-size (reducer process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. REDUCER is
+a two-argument function used to combine the widths and heights of
+the given windows."
+ (when windows
+ (let ((width (window-body-width (car windows)))
+ (height (window-body-height (car windows))))
+ (dolist (window (cdr windows))
+ (setf width (funcall reducer width (window-body-width window)))
+ (setf height (funcall reducer height (window-body-height window))))
+ (cons width height))))
+
+(defun window-adjust-process-window-size-smallest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+smallest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'min process windows))
+
+(defun window-adjust-process-window-size-largest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+largest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'max process windows))
+
+(defun window--process-window-list ()
+ "Return an alist mapping processes to associated windows.
+A window is associated with a process if that window is
+displaying that processes's buffer."
+ (let ((processes (process-list))
+ (process-windows nil))
+ (walk-windows
+ (lambda (window)
+ (let ((buffer (window-buffer window))
+ (iter processes))
+ (while (let ((process (car iter)))
+ (if (and (process-live-p process)
+ (eq buffer (process-buffer process)))
+ (let ((procwin (assq process process-windows)))
+ ;; Add this window to the list of windows
+ ;; displaying process.
+ (if procwin
+ (push window (cdr procwin))
+ (push (list process window) process-windows))
+ ;; We found our process for this window, so
+ ;; stop iterating over the process list.
+ nil)
+ (setf iter (cdr iter)))))))
+ 1 t)
+ process-windows))
+
+(defun window--adjust-process-windows ()
+ "Update process window sizes to match the current window configuration."
+ (dolist (procwin (window--process-window-list))
+ (let ((process (car procwin)))
+ (with-demoted-errors "Error adjusting window size: %S"
+ (with-current-buffer (process-buffer process)
+ (let ((size (funcall
+ (or (process-get process 'adjust-window-size-function)
+ window-adjust-process-window-size-function)
+ process (cdr procwin))))
+ (when size
+ (set-process-window-size process (cdr size) (car size)))))))))
+
+(add-hook 'window-configuration-change-hook 'window--adjust-process-windows)
+
;; Some of these are in tutorial--default-keys, so update that if you
;; change these.
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 52630132..b99db48 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -217,10 +217,10 @@ WINDOW is the window where the drop happened. ACTION is
ignored.
DATA is the moz-url, which is formatted as two strings separated by \\r\\n.
The first string is the URL, the second string is the title of that URL.
DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'."
- ;; Mozilla and applications based on it (Galeon for example) uses
- ;; text/unicode, but it is impossible to tell if it is le or be. Use what
- ;; the machine Emacs runs on use. This loses if dropping between machines
- ;; with different endian, but it is the best we can do.
+ ;; Mozilla and applications based on it use text/unicode, but it is
+ ;; impossible to tell if it is le or be. Use what the machine Emacs
+ ;; runs on uses. This loses if dropping between machines
+ ;; with different endian-ness, but it is the best we can do.
(let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))
(string (decode-coding-string data coding))
(strings (split-string string "[\r\n]" t))
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index b87c1a2..f8ae73c 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -60,6 +60,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(ev-data (nth 1 event))
(ev-where (nth 1 ev-data))
(vec (vector event))
+ (is-move (eq 'mouse-movement ev-command))
(is-down (string-match "down-" (symbol-name ev-command))))
;; Mouse events symbols must have an 'event-kind property with
@@ -71,6 +72,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(is-down
(setf (terminal-parameter nil 'xterm-mouse-last-down) event)
vec)
+ (is-move vec)
(t
(let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
(down-data (nth 1 down))
@@ -132,65 +134,89 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(fdiff (- f (* 1.0 maxwrap dbig))))
(+ (truncate fdiff) (* maxwrap dbig))))))
-;; Normal terminal mouse click reporting: expect three bytes, of the
-;; form <BUTTON+32> <X+32> <Y+32>. Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1000 ()
- (let* ((code (- (read-event) 32))
- (type
- ;; For buttons > 3, the release-event looks differently
- ;; (see xc/programs/xterm/button.c, function EditorButton),
- ;; and come in a release-event only, no down-event.
- (cond ((>= code 64)
- (format "mouse-%d" (- code 60)))
- ((memq code '(8 9 10))
- (format "M-down-mouse-%d" (- code 7)))
- ((memq code '(3 11))
- (let ((down (car (terminal-parameter
- nil 'xterm-mouse-last-down))))
- (when (and down (string-match "[0-9]" (symbol-name down)))
- (format (if (eq code 3) "mouse-%s" "M-mouse-%s")
- (match-string 0 (symbol-name down))))))
- ((memq code '(0 1 2))
- (format "down-mouse-%d" (+ 1 code)))))
- (x (- (read-event) 33))
- (y (- (read-event) 33)))
- (and type (wholenump x) (wholenump y)
- (list (intern type) x y))))
-
-;; XTerm's 1006-mode terminal mouse click reporting has the form
-;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
-;; in encoded (decimal) form. Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1006 ()
- (let (button-bytes x-bytes y-bytes c)
- (while (not (eq (setq c (read-event)) ?\;))
- (push c button-bytes))
- (while (not (eq (setq c (read-event)) ?\;))
- (push c x-bytes))
- (while (not (memq (setq c (read-event)) '(?m ?M)))
- (push c y-bytes))
- (list (let* ((code (string-to-number
- (apply 'string (nreverse button-bytes))))
- (wheel (>= code 64))
- (down (and (not wheel)
- (eq c ?M))))
- (intern (format "%s%smouse-%d"
- (cond (wheel "")
- ((< code 4) "")
- ((< code 8) "S-")
- ((< code 12) "M-")
- ((< code 16) "M-S-")
- ((< code 20) "C-")
- ((< code 24) "C-S-")
- ((< code 28) "C-M-")
- ((< code 32) "C-M-S-")
- (t
- (error "Unexpected escape sequence from
XTerm")))
- (if down "down-" "")
- (if wheel
- (- code 60)
- (1+ (mod code 4))))))
- (1- (string-to-number (apply 'string (nreverse x-bytes))))
- (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+(defun xterm-mouse--read-utf8-char (&optional prompt seconds)
+ "Read an utf-8 encoded character from the current terminal.
+This function reads and returns an utf-8 encoded character of
+command input. If the user generates an event which is not a
+character (i.e., a mouse click or function key event), read-char
+signals an error.
+
+The returned event may come directly from the user, or from a
+keyboard macro. It is not decoded by the keyboard's input coding
+system and always treated with an utf-8 input encoding.
+
+The optional arguments PROMPT and SECONDS work like in
+`read-event'."
+ (let ((tmp (keyboard-coding-system)))
+ (set-keyboard-coding-system 'utf-8)
+ (prog1 (read-event prompt t seconds)
+ (set-keyboard-coding-system tmp))))
+
+;; In default mode, each numeric parameter of XTerm's mouse report is
+;; a single char, possibly encoded as utf-8. The actual numeric
+;; parameter then is obtained by subtracting 32 from the character
+;; code. In extended mode the parameters are returned as decimal
+;; string delimited either by semicolons or for the last parameter by
+;; one of the characters "m" or "M". If the last character is a "m",
+;; then the mouse event was a button release, else it was a button
+;; press or a mouse motion. Return value is a cons cell with
+;; (NEXT-NUMERIC-PARAMETER . LAST-CHAR)
+(defun xterm-mouse--read-number-from-terminal (extension)
+ (let (c)
+ (if extension
+ (let ((n 0))
+ (while (progn
+ (setq c (read-char))
+ (<= ?0 c ?9))
+ (setq n (+ (* 10 n) c (- ?0))))
+ (cons n c))
+ (cons (- (setq c (xterm-mouse--read-utf8-char)) 32) c))))
+
+;; XTerm reports mouse events as
+;; <EVENT-CODE> <X> <Y> in default mode, and
+;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
+;; The macro read-number-from-terminal takes care of reading
+;; the response parameters appropriately. The EVENT-CODE differs
+;; slightly between default and extended mode.
+;; Return a list (EVENT-TYPE-SYMBOL X Y).
+(defun xterm-mouse--read-event-sequence (&optional extension)
+ (pcase-let*
+ ((`(,code . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,x . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,y . ,c) (xterm-mouse--read-number-from-terminal extension))
+ (wheel (/= (logand code 64) 0))
+ (move (/= (logand code 32) 0))
+ (ctrl (/= (logand code 16) 0))
+ (meta (/= (logand code 8) 0))
+ (shift (/= (logand code 4) 0))
+ (down (and (not wheel)
+ (not move)
+ (if extension
+ (eq c ?M)
+ (/= (logand code 3) 3))))
+ (btn (cond
+ ((or extension down wheel)
+ (+ (logand code 3) (if wheel 4 1)))
+ ;; The default mouse protocol does not report the button
+ ;; number in release events: extract the button number
+ ;; from last button-down event.
+ ((terminal-parameter nil 'xterm-mouse-last-down)
+ (string-to-number
+ (substring
+ (symbol-name
+ (car (terminal-parameter nil 'xterm-mouse-last-down)))
+ -1)))
+ ;; Spurious release event without previous button-down
+ ;; event: assume, that the last button was button 1.
+ (t 1)))
+ (sym (if move 'mouse-movement
+ (intern (concat (if ctrl "C-" "")
+ (if meta "M-" "")
+ (if shift "S-" "")
+ (if down "down-" "")
+ "mouse-"
+ (number-to-string btn))))))
+ (list sym (1- x) (1- y))))
(defun xterm-mouse--set-click-count (event click-count)
(setcdr (cdr event) (list click-count))
@@ -207,12 +233,10 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
EXTENSION, if non-nil, means to use an extension to the usual
terminal mouse protocol; we currently support the value 1006,
which is the \"1006\" extension implemented in Xterm >= 277."
- (let* ((click (cond ((null extension)
- (xterm-mouse--read-event-sequence-1000))
- ((eq extension 1006)
- (xterm-mouse--read-event-sequence-1006))
- (t
- (error "Unsupported XTerm mouse protocol")))))
+ (let ((click (cond ((memq extension '(1006 nil))
+ (xterm-mouse--read-event-sequence extension))
+ (t
+ (error "Unsupported XTerm mouse protocol")))))
(when click
(let* ((type (nth 0 click))
(x (nth 1 click))
@@ -291,13 +315,36 @@ down the SHIFT key while pressing the mouse button."
(setq mouse-position-function nil)))
(defconst xterm-mouse-tracking-enable-sequence
- "\e[?1000h\e[?1006h"
+ "\e[?1000h\e[?1002h\e[?1005h\e[?1006h"
"Control sequence to enable xterm mouse tracking.
-Enables basic tracking, then extended tracking on
-terminals that support it.")
+Enables basic mouse tracking, mouse motion events and finally
+extended tracking on terminals that support it. The following
+escape sequences are understood by modern xterms:
+
+\"\\e[?1000h\" `Basic mouse mode´: Enables reports for mouse
+ clicks. There is a limit to the maximum row/column
+ position (<= 223), which can be reported in this
+ basic mode.
+
+\"\\e[?1002h\" `Mouse motion mode´: Enables reports for mouse
+ motion events during dragging operations.
+
+\"\\e[?1005h\" `UTF-8 coordinate extension`: Enables an extension
+ to the basic mouse mode, which uses UTF-8
+ characters to overcome the 223 row/column limit. This
+ extension may conflict with non UTF-8 applications or
+ non UTF-8 locales.
+
+\"\\e[?1006h\" `SGR coordinate extension´: Enables a newer
+ alternative extension to the basic mouse mode, which
+ overcomes the 223 row/column limit without the
+ drawbacks of the UTF-8 coordinate extension.
+
+The two extension modes are mutually exclusive, where the last
+given escape sequence takes precedence over the former.")
(defconst xterm-mouse-tracking-disable-sequence
- "\e[?1006l\e[?1000l"
+ "\e[?1006l\e[?1005l\e[?1002l\e[?1000l"
"Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
(defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
diff --git a/nt/ChangeLog b/nt/ChangeLog
index 9d954d5..b44988f 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-27 Eli Zaretskii <address@hidden>
+
+ * inc/ms-w32.h (BROKEN_NON_BLOCKING_CONNECT): Don't define.
+ (Bug#20159)
+
2015-03-09 Eli Zaretskii <address@hidden>
* INSTALL: Add some more installation instructions for mingw-get
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index c06ed58..da77290 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -58,10 +58,6 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
Look in <sys/time.h> for a timeval structure. */
#define HAVE_TIMEVAL 1
-/* But our select implementation doesn't allow us to make non-blocking
- connects. So until that is fixed, this is necessary: */
-#define BROKEN_NON_BLOCKING_CONNECT 1
-
/* And the select implementation does 1-byte read-ahead waiting
for received packets, so datagrams are broken too. */
#define BROKEN_DATAGRAM_SOCKETS 1
diff --git a/src/ChangeLog b/src/ChangeLog
index bdec3c9..7c7892a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,141 @@
+2015-03-31 Eli Zaretskii <address@hidden>
+
+ * keyboard.c (read_key_sequence): Don't let
+ this_single_command_key_start become negative. (Bug#20223)
+
+2015-03-29 Jan Djärv <address@hidden>
+
+ * gtkutil.c (xg_display_open):
+ * xterm.c (x_display_ok, x_term_init): Block SIGIO when opening
+ a display (Bug#19175).
+
+2015-03-29 Martin Rudalics <address@hidden>
+
+ * gtkutil.c (update_theme_scrollbar_width): Don't round up
+ scroll bar width with GTK3 (Bug#20182).
+
+2015-03-28 Jan Djärv <address@hidden>
+
+ * xsmfns.c (smc_save_yourself_CB): Return if Vinvocation_name or
+ user_login_name are not strings.
+
+2015-03-28 Eli Zaretskii <address@hidden>
+
+ * w32.c (sys_connect): Fix a mistake in previous commit that broke
+ blocking connections. (Bug#20159)
+
+2015-03-27 Paul Eggert <address@hidden>
+
+ Avoid some core dumps in X session management
+ Derived from a bug report by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ * xsmfns.c (smc_save_yourself_CB): Don't dump core if
+ invocation-name is not a string. Initialize user-login-name if it
+ is not already initialized, and don't dump core if it is not a
+ string.
+ (create_client_leader_window): Don't dump core if x-resource-name
+ and x-resource-class are not both strings.
+ (x_session_initialize): Don't dump core if x-session-previous-id,
+ invocation-directory, and invocation-name are not strings.
+
+ Port user-login-name initialization to Qnil == 0
+ Derived from a bug report by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ * editfns.c (Fuser_login_name, Fuser_real_login_name)
+ (syms_of_editfns): Don't rely on all-bits-zero being an Elisp integer,
+ as this is no longer true now that Qnil == 0.
+
+ Assume !BROKEN_NON_BLOCKING_CONNECT
+ From a suggestion by Eli Zaretskii in:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00824.html
+ * process.c (NON_BLOCKING_CONNECT): Simplify by assuming that
+ BROKEN_NON_BLOCKING_CONNECT is not defined.
+ (SELECT_CAN_DO_WRITE_MASK): Remove, and assume it's now true.
+
+2015-03-27 Eli Zaretskii <address@hidden>
+
+ * lread.c (substitute_object_recurse): For sub-char-tables, start
+ the recursive SUBSTITUTE loop from index of 2, to skip the
+ non-Lisp members of the sub-char-table. See the discussion at
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00520.html
+ for the details.
+
+ Support non-blocking connect on MS-Windows.
+ Based on ideas from Kim F. Storm <address@hidden>, see
+ http://lists.gnu.org/archive/html/emacs-devel/2006-12/msg00873.html.
+
+ * w32proc.c (reader_thread): If the FILE_CONNECT flag is set, call
+ '_sys_wait_connect'. If it returns STATUS_CONNECT_FAILED, exit
+ the thread with code 2.
+ (sys_select): Support 'wfds' in addition to 'rfds'. If a
+ descriptor in 'wfds' has its bit set, but the corresponding
+ fd_info member doesn't have its FILE_CONNECT flag set, ignore the
+ descriptor. Otherwise, acknowledge a successful non-blocking
+ connect by resetting the FILE_CONNECT flag and setting cp->status
+ to STATUS_READ_ACKNOWLEDGED. (Bug#20159)
+
+ * w32.h (STATUS_CONNECT_FAILED): New enumeration value.
+ (struct _child_process): New member 'errcode'.
+ (FILE_CONNECT): New flag.
+ (_sys_wait_connect): Add prototype.
+
+ * w32.c (pfn_WSAEnumNetworkEvents): New function pointer.
+ (init_winsock): Load WSAEnumNetworkEvents from winsock DLL.
+ (set_errno): Map WSAEWOULDBLOCK and WSAENOTCONN.
+ (sys_connect): Support non-blocking 'connect' calls by setting the
+ FILE_CONNECT flag in the fd_info member and returning EINPROGRESS.
+ (_sys_read_ahead): Add debug message if this function is called
+ for a descriptor that waits for a non-blocking connect to complete.
+ (_sys_wait_connect): New function.
+ (sys_read): Support STATUS_CONNECT_FAILED. Return the error code
+ recorded by _sys_wait_connect when the non-blocking connect
+ failed. Don't call WSAGetLastError before a call to set_errno had
+ a chance to use its value, since WSAGetLastError clears the last
+ error.
+
+2015-03-25 Stefan Monnier <address@hidden>
+
+ * editfns.c (save_excursion_save): Don't save the mark.
+ (save_excursion_restore): Don't restore the mark.
+ (Fsave_excursion): Fix docstring accordingly.
+
+2015-03-24 Paul Eggert <address@hidden>
+
+ Fix minor ldexp issues
+ * floatfns.c (Fldexp): Require 2 args. Avoid undefined behavior
+ if the exponent is out of 'int' range. Improve documentation.
+ Fixes: bug#20185
+
+2015-03-24 Daniel Colascione <address@hidden>
+
+ * process.c (Fprocess_running_child_p): Return number identifier of
+ the foreground process group if we know it.
+
+2015-03-23 Paul Eggert <address@hidden>
+
+ Minor refactoring of new Fmake_process code
+ * process.c (Fmake_process): Refactor to avoid call to Flength, to
+ avoid cast to 'char **', and to reduce indenting and reuse of locals.
+
+2015-03-23 Daiki Ueno <address@hidden>
+
+ * process.c (Fmake_process): New function.
+ (create_process, create_pty): Check p->pty_flag instead of
+ Vprocess_connection_type.
+ (syms_of_process): Register QCcommand, QCconnection_type, Qpty,
+ Qpipe, and Smake_process. Unregister Sstart_process.
+
+2015-03-22 Jan Djärv <address@hidden>
+
+ * fontset.c (fontset_pattern_regexp): Replace + 1 with + 3 for
+ regexsize (Bug#20156).
+
+2015-03-21 Eli Zaretskii <address@hidden>
+
+ * emacs.c (synchronize_locale) [WINDOWSNT]: Ignore 'category' and
+ always use LC_ALL instead. Fixes problems with setting
+ system-time-locale to something non-default.
+
2015-03-18 Glenn Morris <address@hidden>
* frame.h (x_set_bitmap_icon): Don't set the icon if icon-type is
diff --git a/src/editfns.c b/src/editfns.c
index 7c146f1..7d3e462 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -849,14 +849,11 @@ save_excursion_save (void)
{
return make_save_obj_obj_obj_obj
(Fpoint_marker (),
- /* Do not copy the mark if it points to nowhere. */
- (XMARKER (BVAR (current_buffer, mark))->buffer
- ? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
- : Qnil),
+ Qnil,
/* Selected window if current buffer is shown in it, nil otherwise. */
(EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
? selected_window : Qnil),
- BVAR (current_buffer, mark_active));
+ Qnil);
}
/* Restore saved buffer before leaving `save-excursion' special form. */
@@ -864,8 +861,8 @@ save_excursion_save (void)
void
save_excursion_restore (Lisp_Object info)
{
- Lisp_Object tem, tem1, omark, nmark;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tem, tem1;
+ struct gcpro gcpro1;
tem = Fmarker_buffer (XSAVE_OBJECT (info, 0));
/* If we're unwinding to top level, saved buffer may be deleted. This
@@ -873,8 +870,7 @@ save_excursion_restore (Lisp_Object info)
if (NILP (tem))
goto out;
- omark = nmark = Qnil;
- GCPRO3 (info, omark, nmark);
+ GCPRO1 (info);
Fset_buffer (tem);
@@ -883,34 +879,6 @@ save_excursion_restore (Lisp_Object info)
Fgoto_char (tem);
unchain_marker (XMARKER (tem));
- /* Mark marker. */
- tem = XSAVE_OBJECT (info, 1);
- omark = Fmarker_position (BVAR (current_buffer, mark));
- if (NILP (tem))
- unchain_marker (XMARKER (BVAR (current_buffer, mark)));
- else
- {
- Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
- nmark = Fmarker_position (tem);
- unchain_marker (XMARKER (tem));
- }
-
- /* Mark active. */
- tem = XSAVE_OBJECT (info, 3);
- tem1 = BVAR (current_buffer, mark_active);
- bset_mark_active (current_buffer, tem);
-
- /* If mark is active now, and either was not active
- or was at a different place, run the activate hook. */
- if (! NILP (tem))
- {
- if (! EQ (omark, nmark))
- run_hook (intern ("activate-mark-hook"));
- }
- /* If mark has ceased to be active, run deactivate hook. */
- else if (! NILP (tem1))
- run_hook (intern ("deactivate-mark-hook"));
-
/* If buffer was visible in a window, and a different window was
selected, and the old selected window is still showing this
buffer, restore point in that window. */
@@ -932,18 +900,12 @@ save_excursion_restore (Lisp_Object info)
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
- doc: /* Save point, mark, and current buffer; execute BODY; restore
those things.
+ doc: /* Save point, and current buffer; execute BODY; restore those
things.
Executes BODY just like `progn'.
-The values of point, mark and the current buffer are restored
+The values of point and the current buffer are restored
even in case of abnormal exit (throw or error).
-The state of activation of the mark is also restored.
-
-This construct does not save `deactivate-mark', and therefore
-functions that change the buffer will still cause deactivation
-of the mark at the end of the command. To prevent that, bind
-`deactivate-mark' with `let'.
-If you only want to save the current buffer but not point nor mark,
+If you only want to save the current buffer but not point,
then just use `save-current-buffer', or even `with-current-buffer'.
usage: (save-excursion &rest BODY) */)
@@ -1229,7 +1191,7 @@ of the user with that uid, or nil if there is no such
user. */)
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_login_name))
+ if (NILP (Vuser_login_name))
init_editfns ();
if (NILP (uid))
@@ -1252,7 +1214,7 @@ This ignores the environment variables LOGNAME and USER,
so it differs from
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_login_name))
+ if (NILP (Vuser_login_name))
init_editfns ();
return Vuser_real_login_name;
}
@@ -4993,6 +4955,7 @@ functions if all the text being accessed has this
property. */);
DEFVAR_LISP ("user-login-name", Vuser_login_name,
doc: /* The user's name, taken from environment variables if
possible. */);
+ Vuser_login_name = Qnil;
DEFVAR_LISP ("user-real-login-name", Vuser_real_login_name,
doc: /* The user's name, based upon the real uid only. */);
diff --git a/src/emacs.c b/src/emacs.c
index 02b2c30..c5ed78e 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2158,6 +2158,13 @@ synchronize_locale (int category, Lisp_Object *plocale,
Lisp_Object desired_loca
{
if (! EQ (*plocale, desired_locale))
{
+#ifdef WINDOWSNT
+ /* Changing categories like LC_TIME usually requires to specify
+ an encoding suitable for the new locale, but MS-Windows's
+ 'setlocale' will only switch the encoding when LC_ALL is
+ specified. So we ignore CATEGORY and use LC_ALL instead. */
+ category = LC_ALL;
+#endif
*plocale = desired_locale;
setlocale (category, (STRINGP (desired_locale)
? SSDATA (desired_locale)
diff --git a/src/floatfns.c b/src/floatfns.c
index c68b9bd..072e857 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -185,14 +185,14 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */)
return Fcons (make_float (sgnfcand), make_number (exponent));
}
-DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
- doc: /* Construct number X from significand SGNFCAND and exponent EXP.
-Returns the floating point value resulting from multiplying SGNFCAND
-(the significand) by 2 raised to the power of EXP (the exponent). */)
+DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0,
+ doc: /* Return X * 2**EXP, as a floating point number.
+EXP must be an integer. */)
(Lisp_Object sgnfcand, Lisp_Object exponent)
{
CHECK_NUMBER (exponent);
- return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
+ int e = min (max (INT_MIN, XINT (exponent)), INT_MAX);
+ return make_float (ldexp (XFLOATINT (sgnfcand), e));
}
DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
diff --git a/src/fontset.c b/src/fontset.c
index c0303fa..763d846 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1074,7 +1074,7 @@ fontset_pattern_regexp (Lisp_Object pattern)
expression matching. */
ptrdiff_t regexsize = (SBYTES (pattern)
+ (ndashes < 14 ? 2 : 5) * nstars
- + 2 * nescs + 1);
+ + 2 * nescs + 3);
USE_SAFE_ALLOCA;
p1 = regex = SAFE_ALLOCA (regexsize);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 6f17078..41cc7a7 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -187,7 +187,9 @@ xg_display_open (char *display_name, Display **dpy)
{
GdkDisplay *gdpy;
+ unrequest_sigio (); // See comment in x_display_ok, xterm.c.
gdpy = gdk_display_open (display_name);
+ request_sigio ();
if (!gdpy_def && gdpy)
{
gdpy_def = gdpy;
@@ -3516,7 +3518,9 @@ update_theme_scrollbar_width (void)
gtk_widget_destroy (wscroll);
g_object_unref (G_OBJECT (wscroll));
w += 2*b;
+#ifndef HAVE_GTK3
if (w < 16) w = 16;
+#endif
scroll_bar_width_for_theme = w;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 2122984..cfdcd9b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -9606,6 +9606,18 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize,
Lisp_Object prompt,
/* Record what part of this_command_keys is the current key sequence. */
this_single_command_key_start = this_command_key_count - t;
+ /* When 'input-method-function' called above causes events to be
+ put on 'unread-post-input-method-events', and as result
+ 'reread' is set to 'true', the value of 't' can become larger
+ than 'this_command_key_count', because 'add_command_key' is
+ not called to update 'this_command_key_count'. If this
+ happens, 'this_single_command_key_start' will become negative
+ above, and any call to 'this-single-command-keys' will return
+ a garbled vector. See bug #20223 for one such situation.
+ Here we force 'this_single_command_key_start' to never become
+ negative, to avoid that. */
+ if (this_single_command_key_start < 0)
+ this_single_command_key_start = 0;
/* Look for this sequence in input-decode-map.
Scan from indec.end until we find a bound suffix. */
diff --git a/src/lread.c b/src/lread.c
index ae17529..050e43e 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3280,7 +3280,7 @@ substitute_object_recurse (Lisp_Object object,
Lisp_Object placeholder, Lisp_Obj
{
case Lisp_Vectorlike:
{
- ptrdiff_t i, length = 0;
+ ptrdiff_t i = 0, length = 0;
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
@@ -3295,7 +3295,9 @@ substitute_object_recurse (Lisp_Object object,
Lisp_Object placeholder, Lisp_Obj
behavior. */
wrong_type_argument (Qsequencep, subtree);
- for (i = 0; i < length; i++)
+ if (SUB_CHAR_TABLE_P (subtree))
+ i = 2;
+ for ( ; i < length; i++)
SUBSTITUTE (AREF (subtree, i),
ASET (subtree, i, true_value));
return subtree;
diff --git a/src/process.c b/src/process.c
index 1d935ba..2800fa5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -195,24 +195,15 @@ static EMACS_INT process_tick;
/* Number of events for which the user or sentinel has been notified. */
static EMACS_INT update_tick;
-/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
+/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.
+ The code can be simplified by assuming NON_BLOCKING_CONNECT once
+ Emacs starts assuming POSIX 1003.1-2001 or later. */
-/* Only W32 has this, it really means that select can't take write mask. */
-#ifdef BROKEN_NON_BLOCKING_CONNECT
-#undef NON_BLOCKING_CONNECT
-enum { SELECT_CAN_DO_WRITE_MASK = false };
-#else
-enum { SELECT_CAN_DO_WRITE_MASK = true };
-#ifndef NON_BLOCKING_CONNECT
-#ifdef HAVE_SELECT
-#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
-#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
-#define NON_BLOCKING_CONNECT
-#endif /* EWOULDBLOCK || EINPROGRESS */
-#endif /* HAVE_GETPEERNAME || GNU_LINUX */
-#endif /* HAVE_SELECT */
-#endif /* NON_BLOCKING_CONNECT */
-#endif /* BROKEN_NON_BLOCKING_CONNECT */
+#if (defined HAVE_SELECT \
+ && (defined GNU_LINUX || defined HAVE_GETPEERNAME) \
+ && (defined EWOULDBLOCK || defined EINPROGRESS))
+# define NON_BLOCKING_CONNECT
+#endif
/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
this system. We need to read full packets, so we need a
@@ -1355,34 +1346,62 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0,
0, 0,
static void start_process_unwind (Lisp_Object proc);
-DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
+DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for
it.
-NAME is name for process. It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer name) to associate with the process.
-Process output (both standard output and standard error streams) goes
-at end of BUFFER, unless you specify an output stream or filter
-function to handle the output. BUFFER may also be nil, meaning that
-this process is not associated with any buffer.
+This is similar to `start-process', but arguments are specified as
+keyword/argument pairs. The following arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:command COMMAND -- COMMAND is a list starting with the program file
+name, followed by strings to give to the program as arguments.
-PROGRAM is the program file name. It is searched for in `exec-path'
-(which see). If nil, just associate a pty with the buffer. Remaining
-arguments are strings to give program as arguments.
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
-If you want to separate standard output from standard error, invoke
-the command through a shell and redirect one of them using the shell
-syntax.
+:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
+the process is running. If BOOL is not given, query before exiting.
-usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a process does not accept incoming data, but you
+can send outgoing data. The stopped state is cleared by
+`continue-process' and set by `stop-process'.
+
+:connection-type TYPE -- TYPE is control type of device used to
+communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
+to use a pty, or nil to use the default specified through
+`process-connection-type'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+usage: (make-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object buffer, name, program, proc, current_dir, tem;
- unsigned char **new_argv;
- ptrdiff_t i;
+ Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
ptrdiff_t count = SPECPDL_INDEX ();
+ struct gcpro gcpro1;
USE_SAFE_ALLOCA;
- buffer = args[1];
+ if (nargs == 0)
+ return Qnil;
+
+ /* Save arguments for process-contact and clone-process. */
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
+ buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
@@ -1402,10 +1421,14 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
UNGCPRO;
}
- name = args[0];
+ name = Fplist_get (contact, QCname);
CHECK_STRING (name);
- program = args[2];
+ command = Fplist_get (contact, QCcommand);
+ if (CONSP (command))
+ program = XCAR (command);
+ else
+ program = Qnil;
if (!NILP (program))
CHECK_STRING (program);
@@ -1423,7 +1446,22 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
pset_buffer (XPROCESS (proc), buffer);
pset_sentinel (XPROCESS (proc), Qinternal_default_process_sentinel);
pset_filter (XPROCESS (proc), Qinternal_default_process_filter);
- pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
+ pset_command (XPROCESS (proc), Fcopy_sequence (command));
+
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ XPROCESS (proc)->kill_without_query = 1;
+ if (tem = Fplist_get (contact, QCstop), !NILP (tem))
+ pset_command (XPROCESS (proc), Qt);
+
+ tem = Fplist_get (contact, QCconnection_type);
+ if (EQ (tem, Qpty))
+ XPROCESS (proc)->pty_flag = true;
+ else if (EQ (tem, Qpipe))
+ XPROCESS (proc)->pty_flag = false;
+ else if (NILP (tem))
+ XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+ else
+ report_file_error ("Unknown connection type", tem);
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
@@ -1453,15 +1491,29 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
Lisp_Object val, *args2;
struct gcpro gcpro1, gcpro2;
- val = Vcoding_system_for_read;
+ tem = Fplist_get (contact, QCcoding);
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ else
+ val = Vcoding_system_for_read;
if (NILP (val))
{
- SAFE_ALLOCA_LISP (args2, nargs + 1);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ ptrdiff_t nargs2 = 3 + XINT (Flength (command));
+ Lisp_Object tem2;
+ SAFE_ALLOCA_LISP (args2, nargs2);
+ ptrdiff_t i = 0;
+ args2[i++] = Qstart_process;
+ args2[i++] = name;
+ args2[i++] = buffer;
+ for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
+ args2[i++] = XCAR (tem2);
GCPRO2 (proc, current_dir);
if (!NILP (program))
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ coding_systems = Ffind_operation_coding_system (nargs2, args2);
UNGCPRO;
if (CONSP (coding_systems))
val = XCAR (coding_systems);
@@ -1470,17 +1522,30 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
}
pset_decode_coding_system (XPROCESS (proc), val);
- val = Vcoding_system_for_write;
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else
+ val = Vcoding_system_for_write;
if (NILP (val))
{
if (EQ (coding_systems, Qt))
{
- SAFE_ALLOCA_LISP (args2, nargs + 1);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ ptrdiff_t nargs2 = 3 + XINT (Flength (command));
+ Lisp_Object tem2;
+ SAFE_ALLOCA_LISP (args2, nargs2);
+ ptrdiff_t i = 0;
+ args2[i++] = Qstart_process;
+ args2[i++] = name;
+ args2[i++] = buffer;
+ for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
+ args2[i++] = XCAR (tem2);
GCPRO2 (proc, current_dir);
if (!NILP (program))
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ coding_systems = Ffind_operation_coding_system (nargs2, args2);
UNGCPRO;
}
if (CONSP (coding_systems))
@@ -1506,16 +1571,18 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
if (!NILP (program))
{
+ Lisp_Object program_args = XCDR (command);
+
/* If program file name is not absolute, search our path for it.
Put the name we will really use in TEM. */
if (!IS_DIRECTORY_SEP (SREF (program, 0))
&& !(SCHARS (program) > 1
&& IS_DEVICE_SEP (SREF (program, 1))))
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2;
tem = Qnil;
- GCPRO4 (name, program, buffer, current_dir);
+ GCPRO2 (buffer, current_dir);
openp (Vexec_path, program, Vexec_suffixes, &tem,
make_number (X_OK), false);
UNGCPRO;
@@ -1533,54 +1600,55 @@ usage: (start-process NAME BUFFER PROGRAM &rest
PROGRAM-ARGS) */)
/* Remove "/:" from TEM. */
tem = remove_slash_colon (tem);
- {
- Lisp_Object arg_encoding = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tem);
+ Lisp_Object arg_encoding = Qnil;
+ struct gcpro gcpro1;
+ GCPRO1 (tem);
- /* Encode the file name and put it in NEW_ARGV.
- That's where the child will use it to execute the program. */
- tem = list1 (ENCODE_FILE (tem));
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = list1 (ENCODE_FILE (tem));
+ ptrdiff_t new_argc = 1;
- /* Here we encode arguments by the coding system used for sending
- data to the process. We don't support using different coding
- systems for encoding arguments and for encoding data sent to the
- process. */
+ /* Here we encode arguments by the coding system used for sending
+ data to the process. We don't support using different coding
+ systems for encoding arguments and for encoding data sent to the
+ process. */
- for (i = 3; i < nargs; i++)
- {
- tem = Fcons (args[i], tem);
- CHECK_STRING (XCAR (tem));
- if (STRING_MULTIBYTE (XCAR (tem)))
- {
- if (NILP (arg_encoding))
- arg_encoding = (complement_process_encoding_system
- (XPROCESS (proc)->encode_coding_system));
- XSETCAR (tem,
- code_convert_string_norecord
- (XCAR (tem), arg_encoding, 1));
- }
- }
+ for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
+ {
+ Lisp_Object arg = XCAR (tem2);
+ CHECK_STRING (arg);
+ if (STRING_MULTIBYTE (arg))
+ {
+ if (NILP (arg_encoding))
+ arg_encoding = (complement_process_encoding_system
+ (XPROCESS (proc)->encode_coding_system));
+ arg = code_convert_string_norecord (arg, arg_encoding, 1);
+ }
+ tem = Fcons (arg, tem);
+ new_argc++;
+ }
- UNGCPRO;
- }
+ UNGCPRO;
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
- SAFE_NALLOCA (new_argv, 1, nargs - 1);
- new_argv[nargs - 2] = 0;
+ char **new_argv;
+ SAFE_NALLOCA (new_argv, 1, new_argc + 1);
+ new_argv[new_argc] = 0;
- for (i = nargs - 2; i-- != 0; )
+ for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
{
- new_argv[i] = SDATA (XCAR (tem));
+ new_argv[i] = SSDATA (XCAR (tem));
tem = XCDR (tem);
}
- create_process (proc, (char **) new_argv, current_dir);
+ create_process (proc, new_argv, current_dir);
}
else
create_pty (proc);
+ UNGCPRO;
SAFE_FREE ();
return unbind_to (count, proc);
}
@@ -1648,7 +1716,7 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
inchannel = outchannel = -1;
- if (!NILP (Vprocess_connection_type))
+ if (p->pty_flag)
outchannel = inchannel = allocate_pty (pty_name);
if (inchannel >= 0)
@@ -1701,8 +1769,12 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
p->pty_flag = pty_flag;
pset_status (p, Qrun);
- FD_SET (inchannel, &input_wait_mask);
- FD_SET (inchannel, &non_keyboard_wait_mask);
+ if (!EQ (p->command, Qt))
+ {
+ FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
+ }
+
if (inchannel > max_process_desc)
max_process_desc = inchannel;
@@ -1894,7 +1966,7 @@ create_pty (Lisp_Object process)
{
struct Lisp_Process *p = XPROCESS (process);
char pty_name[PTY_NAME_SIZE];
- int pty_fd = NILP (Vprocess_connection_type) ? -1 : allocate_pty (pty_name);
+ int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
if (pty_fd >= 0)
{
@@ -4525,7 +4597,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
Available = input_wait_mask;
Writeok = write_mask;
check_delay = wait_proc ? 0 : process_output_delay_count;
- check_write = SELECT_CAN_DO_WRITE_MASK;
+ check_write = true;
}
/* If frame size has changed or the window is newly mapped,
@@ -5658,9 +5730,10 @@ emacs_get_tty_pgrp (struct Lisp_Process *p)
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
- doc: /* Return t if PROCESS has given the terminal to a child.
-If the operating system does not make it possible to find out,
-return t unconditionally. */)
+ doc: /* Return non-nil if PROCESS has given the terminal to a
+child. If the operating system does not make it possible to find out,
+return t. If we can find out, return the numeric ID of the foreground
+process group. */)
(Lisp_Object process)
{
/* Initialize in case ioctl doesn't exist or gives an error,
@@ -5683,6 +5756,8 @@ return t unconditionally. */)
if (gid == p->pid)
return Qnil;
+ if (gid != -1)
+ return make_number (gid);
return Qt;
}
@@ -7269,6 +7344,10 @@ syms_of_process (void)
DEFSYM (QCstop, ":stop");
DEFSYM (QCoptions, ":options");
DEFSYM (QCplist, ":plist");
+ DEFSYM (QCcommand, ":command");
+ DEFSYM (QCconnection_type, ":connection-type");
+ DEFSYM (Qpty, "pty");
+ DEFSYM (Qpipe, "pipe");
DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
@@ -7371,7 +7450,7 @@ The variable takes effect when `start-process' is called.
*/);
defsubr (&Sprocess_plist);
defsubr (&Sset_process_plist);
defsubr (&Sprocess_list);
- defsubr (&Sstart_process);
+ defsubr (&Smake_process);
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
defsubr (&Sset_network_process_option);
diff --git a/src/w32.c b/src/w32.c
index 547db0f..6f16704 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -7038,6 +7038,9 @@ int (PASCAL *pfn_WSAStartup) (WORD wVersionRequired,
LPWSADATA lpWSAData);
void (PASCAL *pfn_WSASetLastError) (int iError);
int (PASCAL *pfn_WSAGetLastError) (void);
int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long
lNetworkEvents);
+int (PASCAL *pfn_WSAEnumNetworkEvents) (SOCKET s, HANDLE hEventObject,
+ WSANETWORKEVENTS *NetworkEvents);
+
HANDLE (PASCAL *pfn_WSACreateEvent) (void);
int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent);
int (PASCAL *pfn_socket) (int af, int type, int protocol);
@@ -7123,6 +7126,7 @@ init_winsock (int load_now)
LOAD_PROC (WSASetLastError);
LOAD_PROC (WSAGetLastError);
LOAD_PROC (WSAEventSelect);
+ LOAD_PROC (WSAEnumNetworkEvents);
LOAD_PROC (WSACreateEvent);
LOAD_PROC (WSACloseEvent);
LOAD_PROC (socket);
@@ -7206,6 +7210,8 @@ set_errno (void)
case WSAEMFILE: errno = EMFILE; break;
case WSAENAMETOOLONG: errno = ENAMETOOLONG; break;
case WSAENOTEMPTY: errno = ENOTEMPTY; break;
+ case WSAEWOULDBLOCK: errno = EWOULDBLOCK; break;
+ case WSAENOTCONN: errno = ENOTCONN; break;
default: errno = wsa_err; break;
}
}
@@ -7473,7 +7479,17 @@ sys_connect (int s, const struct sockaddr * name, int
namelen)
{
int rc = pfn_connect (SOCK_HANDLE (s), name, namelen);
if (rc == SOCKET_ERROR)
- set_errno ();
+ {
+ set_errno ();
+ /* If this is a non-blocking 'connect', set the bit in flags
+ that will tell reader_thread to wait for connection
+ before trying to read. */
+ if (errno == EWOULDBLOCK && (fd_info[s].flags & FILE_NDELAY) != 0)
+ {
+ errno = EINPROGRESS; /* that's what process.c expects */
+ fd_info[s].flags |= FILE_CONNECT;
+ }
+ }
return rc;
}
errno = ENOTSOCK;
@@ -7984,6 +8000,8 @@ _sys_read_ahead (int fd)
emacs_abort ();
}
+ if ((fd_info[fd].flags & FILE_CONNECT) != 0)
+ DebPrint (("_sys_read_ahead: read requested from fd %d, which waits for
async connect!\n", fd));
cp->status = STATUS_READ_IN_PROGRESS;
if (fd_info[fd].flags & FILE_PIPE)
@@ -8106,6 +8124,60 @@ _sys_wait_accept (int fd)
}
int
+_sys_wait_connect (int fd)
+{
+ HANDLE hEv;
+ child_process * cp;
+ int rc;
+
+ if (fd < 0 || fd >= MAXDESC)
+ return STATUS_READ_ERROR;
+
+ cp = fd_info[fd].cp;
+ if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY)
+ return STATUS_READ_ERROR;
+
+ cp->status = STATUS_READ_FAILED;
+
+ hEv = pfn_WSACreateEvent ();
+ rc = pfn_WSAEventSelect (SOCK_HANDLE (fd), hEv, FD_CONNECT);
+ if (rc != SOCKET_ERROR)
+ {
+ do {
+ rc = WaitForSingleObject (hEv, 500);
+ Sleep (5);
+ } while (rc == WAIT_TIMEOUT
+ && cp->status != STATUS_READ_ERROR
+ && cp->char_avail);
+ if (rc == WAIT_OBJECT_0)
+ {
+ /* We've got an event, but it could be a successful
+ connection, or it could be a failure. Find out
+ which one is it. */
+ WSANETWORKEVENTS events;
+
+ pfn_WSAEnumNetworkEvents (SOCK_HANDLE (fd), hEv, &events);
+ if ((events.lNetworkEvents & FD_CONNECT) != 0
+ && events.iErrorCode[FD_CONNECT_BIT])
+ {
+ cp->status = STATUS_CONNECT_FAILED;
+ cp->errcode = events.iErrorCode[FD_CONNECT_BIT];
+ }
+ else
+ {
+ cp->status = STATUS_READ_SUCCEEDED;
+ cp->errcode = 0;
+ }
+ }
+ pfn_WSAEventSelect (SOCK_HANDLE (fd), NULL, 0);
+ }
+ else
+ pfn_WSACloseEvent (hEv);
+
+ return cp->status;
+}
+
+int
sys_read (int fd, char * buffer, unsigned int count)
{
int nchars;
@@ -8174,6 +8246,7 @@ sys_read (int fd, char * buffer, unsigned int count)
ResetEvent (cp->char_avail);
case STATUS_READ_ACKNOWLEDGED:
+ case STATUS_CONNECT_FAILED:
break;
default:
@@ -8239,7 +8312,29 @@ sys_read (int fd, char * buffer, unsigned int count)
{
if (winsock_lib == NULL) emacs_abort ();
- /* do the equivalent of a non-blocking read */
+ /* When a non-blocking 'connect' call fails,
+ wait_reading_process_output detects this by calling
+ 'getpeername', and then attempts to obtain the connection
+ error code by trying to read 1 byte from the socket. If
+ we try to serve that read by calling 'recv' below, the
+ error we get is a generic WSAENOTCONN, not the actual
+ connection error. So instead, we use the actual error
+ code stashed by '_sys_wait_connect' in cp->errcode.
+ Alternatively, we could have used 'getsockopt', like on
+ GNU/Linux, but: (a) I have no idea whether the winsock
+ version could hang, as it does "on some systems" (see the
+ comment in process.c); and (b) 'getsockopt' on Windows is
+ documented to clear the socket error for the entire
+ process, which I'm not sure is TRT; FIXME. */
+ if (current_status == STATUS_CONNECT_FAILED
+ && (fd_info[fd].flags & FILE_CONNECT) != 0
+ && cp->errcode != 0)
+ {
+ pfn_WSASetLastError (cp->errcode);
+ set_errno ();
+ return -1;
+ }
+ /* Do the equivalent of a non-blocking read. */
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONREAD, &waiting);
if (waiting == 0 && nchars == 0)
{
@@ -8253,9 +8348,9 @@ sys_read (int fd, char * buffer, unsigned int count)
int res = pfn_recv (SOCK_HANDLE (fd), buffer, count, 0);
if (res == SOCKET_ERROR)
{
- DebPrint (("sys_read.recv failed with error %d on socket
%ld\n",
- pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
set_errno ();
+ DebPrint (("sys_read.recv failed with error %d on socket
%ld\n",
+ errno, SOCK_HANDLE (fd)));
return -1;
}
nchars += res;
diff --git a/src/w32.h b/src/w32.h
index 835557d..9b3521d 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -61,7 +61,8 @@ enum {
STATUS_READ_IN_PROGRESS,
STATUS_READ_FAILED,
STATUS_READ_SUCCEEDED,
- STATUS_READ_ACKNOWLEDGED
+ STATUS_READ_ACKNOWLEDGED,
+ STATUS_CONNECT_FAILED
};
/* This structure is used for both pipes and sockets; for
@@ -96,6 +97,8 @@ typedef struct _child_process
/* Status of subprocess/connection and of reading its output. For
values, see the enumeration above. */
volatile int status;
+ /* Used to store errno value of failed async 'connect' calls. */
+ volatile int errcode;
/* Holds a single character read by _sys_read_ahead, when a
subprocess has some output ready. */
char chr;
@@ -122,7 +125,8 @@ extern filedesc fd_info [ MAXDESC ];
/* fd_info flag definitions */
#define FILE_READ 0x0001
#define FILE_WRITE 0x0002
-#define FILE_LISTEN 0x0004
+#define FILE_LISTEN 0x0004
+#define FILE_CONNECT 0x0008
#define FILE_BINARY 0x0010
#define FILE_LAST_CR 0x0020
#define FILE_AT_EOF 0x0040
@@ -171,6 +175,7 @@ extern void init_timers (void);
extern int _sys_read_ahead (int fd);
extern int _sys_wait_accept (int fd);
+extern int _sys_wait_connect (int fd);
extern HMODULE w32_delayed_load (Lisp_Object);
diff --git a/src/w32proc.c b/src/w32proc.c
index 74731db..7d982f8 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -786,6 +786,138 @@ alarm (int seconds)
#endif
}
+
+
+/* Here's an overview of how support for subprocesses and
+ network/serial streams is implemented on MS-Windows.
+
+ The management of both subprocesses and network/serial streams
+ circles around the child_procs[] array, which can record up to the
+ grand total of MAX_CHILDREN (= 32) of these. (The reasons for the
+ 32 limitation will become clear below.) Each member of
+ child_procs[] is a child_process structure, defined on w32.h.
+
+ A related data structure is the fd_info[] array, which holds twice
+ as many members, 64, and records the information about file
+ descriptors used for communicating with subprocesses and
+ network/serial devices. Each member of the array is the filedesc
+ structure, which records the Windows handle for communications,
+ such as the read end of the pipe to a subprocess, a socket handle,
+ etc.
+
+ Both these arrays reference each other: there's a member of
+ child_process structure that records the file corresponding
+ descriptor, and there's a member of filedesc structure that holds a
+ pointer to the corresponding child_process.
+
+ Whenever Emacs starts a subprocess or opens a network/serial
+ stream, the function new_child is called to prepare a new
+ child_process structure. new_child looks for the first vacant slot
+ in the child_procs[] array, initializes it, and starts a "reader
+ thread" that will watch the output of the subprocess/stream and its
+ status. (If no vacant slot can be found, new_child returns a
+ failure indication to its caller, and the higher-level Emacs
+ primitive will then fail with EMFILE or EAGAIN.)
+
+ The reader thread started by new_child communicates with the main
+ (a.k.a. "Lisp") thread via two event objects and a status, all of
+ them recorded by the members of the child_process structure in
+ child_procs[]. The event objects serve as semaphores between the
+ reader thread and the 'select' emulation in sys_select, as follows:
+
+ . Initially, the reader thread is waiting for the char_consumed
+ event to become signaled by sys_select, which is an indication
+ for the reader thread to go ahead and try reading more stuff
+ from the subprocess/stream.
+
+ . The reader thread then attempts to read by calling a
+ blocking-read function. When the read call returns, either
+ successfully or with some failure indication, the reader thread
+ updates the status of the read accordingly, and signals the 2nd
+ event object, char_avail, on whose handle sys_select is
+ waiting. This tells sys_select that the file descriptor
+ allocated for the subprocess or the the stream is ready to be
+ read from.
+
+ When the subprocess exits or the network/serial stream is closed,
+ the reader thread sets the status accordingly and exits. It also
+ exits when the main thread sets the ststus to STATUS_READ_ERROR
+ and/or the char_avail and char_consumed event handles are NULL;
+ this is how delete_child, called by Emacs when a subprocess or a
+ stream is terminated, terminates the reader thread as part of
+ deleting the child_process object.
+
+ The sys_select function emulates the Posix 'pselect' function; it
+ is needed because the Windows 'select' function supports only
+ network sockets, while Emacs expects 'pselect' to work for any file
+ descriptor, including pipes and serial streams.
+
+ When sys_select is called, it uses the information in fd_info[]
+ array to convert the file descriptors which it was asked to watch
+ into Windows handles. In general, the handle to watch is the
+ handle of the char_avail event of the child_process structure that
+ corresponds to the file descriptor. In addition, for subprocesses,
+ sys_select watches one more handle: the handle for the subprocess,
+ so that it could emulate the SIGCHLD signal when the subprocess
+ exits.
+
+ If file descriptor zero (stdin) doesn't have its bit set in the
+ 'rfds' argument to sys_select, the function always watches for
+ keyboard interrupts, to be able to return when the user presses
+ C-g.
+
+ Having collected the handles to watch, sys_select calls
+ WaitForMultipleObjects to wait for any one of them to become
+ signaled. Since WaitForMultipleObjects can only watch up to 64
+ handles, Emacs on Windows is limited to maximum 32 child_process
+ objects (since a subprocess consumes 2 handles to be watched, see
+ above).
+
+ When any of the handles become signaled, sys_select does whatever
+ is appropriate for the corresponding child_process object:
+
+ . If it's a handle to the char_avail event, sys_select marks the
+ corresponding bit in 'rfds', and Emacs will then read from that
+ file descriptor.
+
+ . If it's a handle to the process, sys_select calls the SIGCHLD
+ handler, to inform Emacs of the fact that the subprocess
+ exited.
+
+ The waitpid emulation works very similar to sys_select, except that
+ it only watches handles of subprocesses, and doesn't synchronize
+ with the reader thread.
+
+ Because socket descriptors on Windows are handles, while Emacs
+ expects them to be file descriptors, all low-level I/O functions,
+ such as 'read' and 'write', and all socket operations, like
+ 'connect', 'recvfrom', 'accept', etc., are redirected to the
+ corresponding 'sys_*' functions, which must convert a file
+ descriptor to a handle using the fd_info[] array, and then invoke
+ the corresponding Windows API on the handle. Most of these
+ redirected 'sys_*' functions are implemented on w32.c.
+
+ When the file descriptor was produced by functions such as 'open',
+ the corresponding handle is obtained by calling _get_osfhandle. To
+ produce a file descriptor for a socket handle, which has no file
+ descriptor as far as Windows is concerned, the function
+ socket_to_fd opens the null device; the resulting file descriptor
+ will never be used directly in any I/O API, but serves as an index
+ into the fd_info[] array, where the socket handle is stored. The
+ SOCK_HANDLE macro retrieves the handle when given the file
+ descriptor.
+
+ The function sys_kill emulates the Posix 'kill' functionality to
+ terminate other processes. It does that by attaching to the
+ foreground window of the process and sending a Ctrl-C or Ctrl-BREAK
+ signal to the process; if that doesn't work, then it calls
+ TerminateProcess to forcibly terminate the process. Note that this
+ only terminates the immediate process whose PID was passed to
+ sys_kill; it doesn't terminate the child processes of that process.
+ This means, for example, that an Emacs subprocess run through a
+ shell might not be killed, because sys_kill will only terminate the
+ shell. (In practice, however, such problems are very rare.) */
+
/* Defined in <process.h> which conflicts with the local copy */
#define _P_NOWAIT 1
@@ -1011,7 +1143,9 @@ reader_thread (void *arg)
{
int rc;
- if (cp->fd >= 0 && fd_info[cp->fd].flags & FILE_LISTEN)
+ if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_CONNECT) != 0)
+ rc = _sys_wait_connect (cp->fd);
+ else if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_LISTEN) != 0)
rc = _sys_wait_accept (cp->fd);
else
rc = _sys_read_ahead (cp->fd);
@@ -1031,8 +1165,8 @@ reader_thread (void *arg)
return 1;
}
- if (rc == STATUS_READ_ERROR)
- return 1;
+ if (rc == STATUS_READ_ERROR || rc == STATUS_CONNECT_FAILED)
+ return 2;
/* If the read died, the child has died so let the thread die */
if (rc == STATUS_READ_FAILED)
@@ -1929,7 +2063,7 @@ int
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
struct timespec *timeout, void *ignored)
{
- SELECT_TYPE orfds;
+ SELECT_TYPE orfds, owfds;
DWORD timeout_ms, start_time;
int i, nh, nc, nr;
DWORD active;
@@ -1947,15 +2081,27 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE
*wfds, SELECT_TYPE *efds,
return 0;
}
- /* Otherwise, we only handle rfds, so fail otherwise. */
- if (rfds == NULL || wfds != NULL || efds != NULL)
+ /* Otherwise, we only handle rfds and wfds, so fail otherwise. */
+ if ((rfds == NULL && wfds == NULL) || efds != NULL)
{
errno = EINVAL;
return -1;
}
- orfds = *rfds;
- FD_ZERO (rfds);
+ if (rfds)
+ {
+ orfds = *rfds;
+ FD_ZERO (rfds);
+ }
+ else
+ FD_ZERO (&orfds);
+ if (wfds)
+ {
+ owfds = *wfds;
+ FD_ZERO (wfds);
+ }
+ else
+ FD_ZERO (&owfds);
nr = 0;
/* If interrupt_handle is available and valid, always wait on it, to
@@ -1970,7 +2116,7 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE
*wfds, SELECT_TYPE *efds,
/* Build a list of pipe handles to wait on. */
for (i = 0; i < nfds; i++)
- if (FD_ISSET (i, &orfds))
+ if (FD_ISSET (i, &orfds) || FD_ISSET (i, &owfds))
{
if (i == 0)
{
@@ -1984,7 +2130,7 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE
*wfds, SELECT_TYPE *efds,
/* Check for any emacs-generated input in the queue since
it won't be detected in the wait */
- if (detect_input_pending ())
+ if (rfds && detect_input_pending ())
{
FD_SET (i, rfds);
return 1;
@@ -1999,6 +2145,13 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE
*wfds, SELECT_TYPE *efds,
{
/* Child process and socket/comm port input. */
cp = fd_info[i].cp;
+ if (FD_ISSET (i, &owfds)
+ && cp
+ && (fd_info[i].flags && FILE_CONNECT) == 0)
+ {
+ DebPrint (("sys_select: fd %d is in wfds, but FILE_CONNECT is
reset!\n", i));
+ cp = NULL;
+ }
if (cp)
{
int current_status = cp->status;
@@ -2007,6 +2160,8 @@ sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE
*wfds, SELECT_TYPE *efds,
{
/* Tell reader thread which file handle to use. */
cp->fd = i;
+ /* Zero out the error code. */
+ cp->errcode = 0;
/* Wake up the reader thread for this process */
cp->status = STATUS_READ_READY;
if (!SetEvent (cp->char_consumed))
@@ -2197,7 +2352,7 @@ count_children:
if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
- /* SIG_DFL for SIGCHLD is ignore */
+ /* SIG_DFL for SIGCHLD is ignored */
else if (sig_handlers[SIGCHLD] != SIG_DFL &&
sig_handlers[SIGCHLD] != SIG_IGN)
{
@@ -2214,7 +2369,7 @@ count_children:
errno = EINTR;
return -1;
}
- else if (fdindex[active] == 0)
+ else if (rfds && fdindex[active] == 0)
{
/* Keyboard input available */
FD_SET (0, rfds);
@@ -2222,9 +2377,33 @@ count_children:
}
else
{
- /* must be a socket or pipe - read ahead should have
- completed, either succeeding or failing. */
- FD_SET (fdindex[active], rfds);
+ /* Must be a socket or pipe - read ahead should have
+ completed, either succeeding or failing. If this handle
+ was waiting for an async 'connect', reset the connect
+ flag, so it could read from now on. */
+ if (wfds && (fd_info[fdindex[active]].flags & FILE_CONNECT) != 0)
+ {
+ cp = fd_info[fdindex[active]].cp;
+ if (cp)
+ {
+ /* Don't reset the FILE_CONNECT bit and don't
+ acknowledge the read if the status is
+ STATUS_CONNECT_FAILED or some other
+ failure. That's because the thread exits in those
+ cases, so it doesn't need the ACK, and we want to
+ keep the FILE_CONNECT bit as evidence that the
+ connect failed, to be checked in sys_read. */
+ if (cp->status == STATUS_READ_SUCCEEDED)
+ {
+ fd_info[cp->fd].flags &= ~FILE_CONNECT;
+ cp->status = STATUS_READ_ACKNOWLEDGED;
+ }
+ ResetEvent (cp->char_avail);
+ }
+ FD_SET (fdindex[active], wfds);
+ }
+ else if (rfds)
+ FD_SET (fdindex[active], rfds);
nr++;
}
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 0e635d3..48aaa9b 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -168,8 +168,12 @@ smc_save_yourself_CB (SmcConn smcConn,
int val_idx = 0, vp_idx = 0;
int props_idx = 0;
int i;
- char *cwd = get_current_dir_name ();
char *smid_opt, *chdir_opt = NULL;
+ Lisp_Object user_login_name = Fuser_login_name (Qnil);
+
+ // Must have these.
+ if (! STRINGP (Vinvocation_name) || ! STRINGP (user_login_name))
+ return;
/* How to start a new instance of Emacs. */
props[props_idx] = &prop_ptr[props_idx];
@@ -197,11 +201,11 @@ smc_save_yourself_CB (SmcConn smcConn,
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
- props[props_idx]->vals[0].length = SBYTES (Vuser_login_name);
- props[props_idx]->vals[0].value = SDATA (Vuser_login_name);
+ props[props_idx]->vals[0].length = SBYTES (user_login_name);
+ props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
-
+ char *cwd = get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
@@ -372,6 +376,7 @@ create_client_leader_window (struct x_display_info
*dpyinfo, char *client_ID)
-1, -1, 1, 1,
CopyFromParent, CopyFromParent, CopyFromParent);
+ validate_x_resource_name ();
class_hints.res_name = SSDATA (Vx_resource_name);
class_hints.res_class = SSDATA (Vx_resource_class);
XSetClassHint (dpyinfo->display, w, &class_hints);
@@ -402,22 +407,24 @@ x_session_initialize (struct x_display_info *dpyinfo)
/* Check if we where started by the session manager. If so, we will
have a previous id. */
- if (! NILP (Vx_session_previous_id) && STRINGP (Vx_session_previous_id))
+ if (STRINGP (Vx_session_previous_id))
previous_id = SSDATA (Vx_session_previous_id);
/* Construct the path to the Emacs program. */
- if (! NILP (Vinvocation_directory))
+ if (STRINGP (Vinvocation_directory))
name_len += SBYTES (Vinvocation_directory);
- name_len += SBYTES (Vinvocation_name);
+ if (STRINGP (Vinvocation_name))
+ name_len += SBYTES (Vinvocation_name);
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
emacs_program = xmalloc (name_len + 1);
char *z = emacs_program;
- if (! NILP (Vinvocation_directory))
+ if (STRINGP (Vinvocation_directory))
z = lispstpcpy (z, Vinvocation_directory);
- lispstpcpy (z, Vinvocation_name);
+ if (STRINGP (Vinvocation_name))
+ lispstpcpy (z, Vinvocation_name);
/* The SM protocol says all callbacks are mandatory, so set up all
here and in the mask passed to SmcOpenConnection. */
diff --git a/src/xterm.c b/src/xterm.c
index 0213812..866c9ff 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10698,7 +10698,10 @@ get_bits_and_offset (unsigned long mask, int *bits,
int *offset)
bool
x_display_ok (const char *display)
{
+ /* XOpenDisplay fails if it gets a signal. Block SIGIO which may arrive. */
+ unrequest_sigio ();
Display *dpy = XOpenDisplay (display);
+ request_sigio ();
if (!dpy)
return false;
XCloseDisplay (dpy);
@@ -10878,7 +10881,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
/* gtk_init does set_locale. Fix locale before and after. */
fixup_locale ();
+ unrequest_sigio (); /* See comment in x_display_ok. */
gtk_init (&argc, &argv2);
+ request_sigio ();
fixup_locale ();
g_log_remove_handler ("GLib", id);
@@ -10928,10 +10933,12 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
argv[argc++] = xrm_option;
}
turn_on_atimers (false);
+ unrequest_sigio (); /* See comment in x_display_ok. */
dpy = XtOpenDisplay (Xt_app_con, SSDATA (display_name),
resource_name, EMACS_CLASS,
emacs_options, XtNumber (emacs_options),
&argc, argv);
+ request_sigio ();
turn_on_atimers (true);
#ifdef HAVE_X11XTR6
@@ -10942,7 +10949,9 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#else /* not USE_X_TOOLKIT */
XSetLocaleModifiers ("");
+ unrequest_sigio (); // See comment in x_display_ok.
dpy = XOpenDisplay (SSDATA (display_name));
+ request_sigio ();
#endif /* not USE_X_TOOLKIT */
#endif /* not USE_GTK*/
diff --git a/test/ChangeLog b/test/ChangeLog
index 15408a3..f7bec2e 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,29 @@
+2015-04-01 Artur Malabarba <address@hidden>
+
+ * automated/package-test.el: Avoid async while testing.
+ (package-test-update-archives): Fix test.
+
+2015-03-27 Wolfgang Jenkner <address@hidden>
+
+ * automated/textprop-tests.el: New file.
+ (textprop-tests-font-lock--remove-face-from-text-property): New test.
+
+2015-03-24 Michael Albinus <address@hidden>
+
+ * automated/tramp-tests.el (tramp-test18-file-attributes)
+ (tramp--test-check-files): Extend tests.
+ (tramp-test31-utf8): Do not skip for tramp-adb.el.
+
+2015-03-24 Daiki Ueno <address@hidden>
+
+ * automated/epg-tests.el: New file.
+ * automated/data/epg/pubkey.asc: New file.
+ * automated/data/epg/seckey.asc: New file.
+
+2015-03-22 Dmitry Gutov <address@hidden>
+
+ * automated/json-tests.el: New file.
+
2015-03-19 Stefan Monnier <address@hidden>
* automated/eieio-tests.el (eieio-test-17-virtual-slot): Don't use
diff --git a/test/automated/data/epg/pubkey.asc
b/test/automated/data/epg/pubkey.asc
new file mode 100644
index 0000000..c0bf28f
--- /dev/null
+++ b/test/automated/data/epg/pubkey.asc
@@ -0,0 +1,20 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+Version: GnuPG v1
+
+mI0EVRDxCAEEALcScrRmxq5N+Hh+NxPg75RJJdtEi824pwtqMlT/3wG1esmP5gNu
+ZIPVaTTSGNZkEzeYdhaLXBUe5qD+RQIQVh+MLt9nisF9nD35imyOrhHwAHnglOPx
+GdylH8nQ/tIO5p/lfUlw+iCBlPH7eZHqFJhwP0hJML4PKE8ArWG6RtsxABEBAAG0
+J0pvZSBUZXN0ZXIgKHRlc3Qga2V5KSA8am9lQGV4YW1wbGUuY29tPoi4BBMBAgAi
+BQJVEPEIAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRAoscCWMvu4GGYO
+A/0Zzoc2z/dvAtFVLh4ovKqP2qliQt2qschJHVP30hJnKT7dmJfJl7kz9mXmMfSt
+Ym0luYmeSzdeWORM9SygLRYXuDfN6G4ZPJTlsRhgnARhNzNhSx+YlcFh48Z+a5zR
+goBMn7DgYVqfU4UteZOSXMlnuA2Z5ao1qgGhVqESSJgU5riNBFUQ8QgBBADacLkK
+D0U11nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFt
+LO8owCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQ
+q/M2oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABiJ8EGAECAAkFAlUQ8QgC
+GwwACgkQKLHAljL7uBj44AQAkMJRm7VJUryrDKFtfIfytQx/vmyU/cZcVV6IpKqP
+KhztgR+QD9czlHvQhz+y3hqtLRShu2Eyf75dNexcUvKs/lS4LIDXg5V7pWSRk9eQ
+G403muqR/NGu6+QmUx09rJl72trdaGxNkyHA7Zy7ZDGkcMvQsd3qoSNGsPR5TKes
+w7Q=
+=NMxb
+-----END PGP PUBLIC KEY BLOCK-----
diff --git a/test/automated/data/epg/seckey.asc
b/test/automated/data/epg/seckey.asc
new file mode 100644
index 0000000..4ac7ba4
--- /dev/null
+++ b/test/automated/data/epg/seckey.asc
@@ -0,0 +1,33 @@
+-----BEGIN PGP PRIVATE KEY BLOCK-----
+Version: GnuPG v1
+
+lQHYBFUQ8QgBBAC3EnK0ZsauTfh4fjcT4O+USSXbRIvNuKcLajJU/98BtXrJj+YD
+bmSD1Wk00hjWZBM3mHYWi1wVHuag/kUCEFYfjC7fZ4rBfZw9+Ypsjq4R8AB54JTj
+8RncpR/J0P7SDuaf5X1JcPoggZTx+3mR6hSYcD9ISTC+DyhPAK1hukbbMQARAQAB
+AAP9Hs9agZTobA5QOksXjt9kwqJ63gePtbwVVNz3AoobaGi39PMkRUCPZwaEEbEo
+H/CwsUMV4J5sjVtpef/A8mN4csai7NYp82mbo+dPim4p+SUtBg4Ms8ujGVcQeRQd
+1CXtIkixDu6fw4wDtNw03ZyNJOhBOXVTgAyOTSlIz3D+6n8CAMeCqEFBHQIVoQpf
+Bza4YvFtJRdfGMTix3u7Cb6y9CHGBok7uUgQAeWnzQvMGTCHc3e8iHGAYBQ88GPF
+v1TpiusCAOroRe69Aiid5JMVTjWoJ0SHKd47nIj0gQFiDfa5de0BNq9gYj7JLg+R
+EjsJbJN39z+Z9HWjIOCUOIXDvucmM1MB/iNxW1Z8mEMflEYK5rop+PDxwqUbr8uZ
+kzogw98ZdmuEuN0bheGWUiJI+0Pd8jb40zlR1KgOEMx1mZchToAJdtybMLQnSm9l
+IFRlc3RlciAodGVzdCBrZXkpIDxqb2VAZXhhbXBsZS5jb20+iLgEEwECACIFAlUQ
+8QgCGwMGCwkIBwMCBhUIAgkKCwQWAgMBAh4BAheAAAoJECixwJYy+7gYZg4D/RnO
+hzbP928C0VUuHii8qo/aqWJC3aqxyEkdU/fSEmcpPt2Yl8mXuTP2ZeYx9K1ibSW5
+iZ5LN15Y5Ez1LKAtFhe4N83obhk8lOWxGGCcBGE3M2FLH5iVwWHjxn5rnNGCgEyf
+sOBhWp9ThS15k5JcyWe4DZnlqjWqAaFWoRJImBTmnQHYBFUQ8QgBBADacLkKD0U1
+1nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFtLO8o
+wCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQq/M2
+oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABAAP7B8uNtb/DLvGoRfL+mA0Q
+REhgOJ1WpRcU6rvKYNPh8xTkKMvM+EK0nVU/znBedEpXjb0pY1WRT0uvXs2pzY2V
+YeaugyKIkdUpPWnyWoEQwI8hFvHOWmU2rNHyXLW0MY7bxcGgqv2XbkL4m7/D6VQS
+SR8hQ2CxBbW+9ov6aBMwv/UCAOW89+5xxuzkv48AVraWlMnaU0ggVOf6ht0Qa40+
++uw2yziNlD403gAAAycoICiB/oqwslx61B2xOHn0laCKrgsCAPNpIsHRlAwWbAsq
+uCtfIQxg+C3mPXkqsNTMjeK5NjLNytrmO49NXco36zVEG6q7qz5Zj9d9IPYoGOSa
+I+dQZ6sB/RKF5aonR5/e7IHJgc8BG7I0yiya4llE0AB9ghnRI/3uHwnCBnmo/32a
+n4+rQkx6vm+rg3JA/09Gi7W4R9SwV+ane4ifBBgBAgAJBQJVEPEIAhsMAAoJECix
+wJYy+7gY+OAEAJDCUZu1SVK8qwyhbXyH8rUMf75slP3GXFVeiKSqjyoc7YEfkA/X
+M5R70Ic/st4arS0UobthMn++XTXsXFLyrP5UuCyA14OVe6VkkZPXkBuNN5rqkfzR
+ruvkJlMdPayZe9ra3WhsTZMhwO2cu2QxpHDL0LHd6qEjRrD0eUynrMO0
+=iCIm
+-----END PGP PRIVATE KEY BLOCK-----
diff --git a/test/automated/epg-tests.el b/test/automated/epg-tests.el
new file mode 100644
index 0000000..a958d82
--- /dev/null
+++ b/test/automated/epg-tests.el
@@ -0,0 +1,172 @@
+;;; epg-tests.el --- Test suite for epg.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'epg)
+
+(defvar epg-tests-context nil)
+
+(defvar epg-tests-data-directory
+ (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY"))
+ "Directory containing epg test data.")
+
+(defun epg-tests-gpg-usable (&optional require-passphrase)
+ (and (executable-find epg-gpg-program)
+ (condition-case nil
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (if require-passphrase
+ (string-match "\\`1\\."
+ (cdr (assq 'version (epg-configuration))))
+ t))
+ (error nil))))
+
+(defun epg-tests-passphrase-callback (_c _k _d)
+ ;; Need to create a copy here, since the string will be wiped out
+ ;; after the use.
+ (copy-sequence "test0123456789"))
+
+(cl-defmacro with-epg-tests ((&optional &key require-passphrase
+ require-public-key
+ require-secret-key)
+ &rest body)
+ "Set up temporary locations and variables for testing."
+ (declare (indent 1))
+ `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)))
+ (unwind-protect
+ (let ((context (epg-make-context 'OpenPGP)))
+ (setf (epg-context-home-directory context)
+ epg-tests-home-directory)
+ (setenv "GPG_AGENT_INFO")
+ ,(if require-passphrase
+ `(epg-context-set-passphrase-callback
+ context
+ #'epg-tests-passphrase-callback))
+ ,(if require-public-key
+ `(epg-import-keys-from-file
+ context
+ (expand-file-name "pubkey.asc" epg-tests-data-directory)))
+ ,(if require-secret-key
+ `(epg-import-keys-from-file
+ context
+ (expand-file-name "seckey.asc" epg-tests-data-directory)))
+ (with-temp-buffer
+ (make-local-variable 'epg-tests-context)
+ (setq epg-tests-context context)
+ ,@body))
+ (when (file-directory-p epg-tests-home-directory)
+ (delete-directory epg-tests-home-directory t)))))
+
+(ert-deftest epg-decrypt-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t)
+ (should (equal "test"
+ (epg-decrypt-string epg-tests-context "\
+-----BEGIN PGP MESSAGE-----
+Version: GnuPG v2
+
+jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
+=U8z7
+-----END PGP MESSAGE-----")))))
+
+(ert-deftest epg-roundtrip-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t)
+ (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil)))
+ (should (equal "symmetric"
+ (epg-decrypt-string epg-tests-context cipher))))))
+
+(ert-deftest epg-roundtrip-2 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let* ((recipients (epg-list-keys epg-tests-context "address@hidden"))
+ (cipher (epg-encrypt-string epg-tests-context "public key"
+ recipients nil t)))
+ (should (equal "public key"
+ (epg-decrypt-string epg-tests-context cipher))))))
+
+(ert-deftest epg-sign-verify-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "address@hidden"))
+ (setq signature (epg-sign-string epg-tests-context "signed" t))
+ (epg-verify-string epg-tests-context signature "signed")
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-sign-verify-2 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "address@hidden"))
+ (setq signature (epg-sign-string epg-tests-context "clearsigned" 'clear))
+ ;; Clearsign signature always ends with a new line.
+ (should (equal "clearsigned\n"
+ (epg-verify-string epg-tests-context signature)))
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-sign-verify-3 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "address@hidden"))
+ (setq signature (epg-sign-string epg-tests-context "normal signed"))
+ (should (equal "normal signed"
+ (epg-verify-string epg-tests-context signature)))
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-import-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase nil)
+ (should (= 0 (length (epg-list-keys epg-tests-context))))
+ (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
+ (with-epg-tests (:require-passphrase nil
+ :require-public-key t)
+ (should (= 1 (length (epg-list-keys epg-tests-context))))
+ (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
+ (with-epg-tests (:require-public-key nil
+ :require-public-key t
+ :require-secret-key t)
+ (should (= 1 (length (epg-list-keys epg-tests-context))))
+ (should (= 1 (length (epg-list-keys epg-tests-context nil t))))))
+
+(provide 'epg-tests)
+
+;;; epg-tests.el ends here
diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el
new file mode 100644
index 0000000..fd89b7a
--- /dev/null
+++ b/test/automated/json-tests.el
@@ -0,0 +1,46 @@
+;;; json-tests.el --- Test suite for json.el
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov <address@hidden>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'json)
+
+(ert-deftest json-encode-simple-alist ()
+ (should (equal (json-encode '((a . 1)
+ (b . 2)))
+ "{\"a\":1,\"b\":2}")))
+
+(ert-deftest json-read-simple-alist ()
+ (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}")
+ '((b . 2)
+ (a . 1)))))
+
+(ert-deftest json-encode-string-with-special-chars ()
+ (should (equal (json-encode-string "a\n\fb")
+ "\"a\\n\\fb\""))
+ (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
+ "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
+
+(ert-deftest json-read-string-with-special-chars ()
+ (should (equal (json-read-from-string
"\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
+ "\nasdфывfgh\t")))
+
+(provide 'json-tests)
+;;; json-tests.el ends here
diff --git a/test/automated/package-test.el b/test/automated/package-test.el
index 5da3c36..359f354 100644
--- a/test/automated/package-test.el
+++ b/test/automated/package-test.el
@@ -36,6 +36,8 @@
(require 'ert)
(require 'cl-lib)
+(setq package-menu-async nil)
+
(defvar package-test-user-dir nil
"Directory to use for installing packages during testing.")
@@ -324,7 +326,7 @@ Must called from within a `tar-mode' buffer."
;; New version should be available and old version should be installed
(goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil
t))
+ (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available"
nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed"
nil t))
(goto-char (point-min))
diff --git a/test/automated/textprop-tests.el b/test/automated/textprop-tests.el
new file mode 100644
index 0000000..310a7a0
--- /dev/null
+++ b/test/automated/textprop-tests.el
@@ -0,0 +1,57 @@
+;;; textprop-tests.el --- Test suite for text properties.
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Wolfgang Jenkner <address@hidden>
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest textprop-tests-font-lock--remove-face-from-text-property ()
+ "Test `font-lock--remove-face-from-text-property'."
+ (let* ((string "foobar")
+ (stack (list string))
+ (faces '(bold (:foreground "red") underline)))
+ ;; Build each string in `stack' by adding a face to the previous
+ ;; string.
+ (let ((faces (reverse faces)))
+ (push (copy-sequence (car stack)) stack)
+ (put-text-property 0 3 'font-lock-face (pop faces) (car stack))
+ (push (copy-sequence (car stack)) stack)
+ (put-text-property 3 6 'font-lock-face (pop faces) (car stack))
+ (push (copy-sequence (car stack)) stack)
+ (font-lock-prepend-text-property 2 5
+ 'font-lock-face (pop faces) (car stack)))
+ ;; Check that removing the corresponding face from each string
+ ;; yields the previous string in `stack'.
+ (while faces
+ ;; (message "%S" (car stack))
+ (should (equal-including-properties
+ (progn
+ (font-lock--remove-face-from-text-property 0 6
+ 'font-lock-face
+ (pop faces)
+ (car stack))
+ (pop stack))
+ (car stack))))
+ ;; Sanity check.
+ ;; (message "%S" (car stack))
+ (should (and (equal-including-properties (pop stack) string)
+ (null stack)))))
diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el
index 9ba6743..cc2c753 100644
--- a/test/automated/tramp-tests.el
+++ b/test/automated/tramp-tests.el
@@ -124,8 +124,7 @@ shall not contain a timeout."
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
- (with-current-buffer
- (tramp-get-debug-buffer v)
+ (with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string))))))))
(ert-deftest tramp-test00-availability ()
@@ -982,17 +981,18 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
This tests also `file-readable-p' and `file-regular-p'."
(skip-unless (tramp--test-enabled))
- (let ((tmp-name (tramp--test-make-temp-name))
+ (let ((tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (tramp--test-make-temp-name))
attr)
(unwind-protect
(progn
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (consp attr))
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should (file-regular-p tmp-name))
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should (file-regular-p tmp-name1))
;; We do not test inodes and device numbers.
(should (null (car attr)))
(should (numberp (nth 1 attr))) ;; Link.
@@ -1007,18 +1007,33 @@ This tests also `file-readable-p' and `file-regular-p'."
(should (numberp (nth 7 attr))) ;; Size.
(should (stringp (nth 8 attr))) ;; Modes.
- (setq attr (file-attributes tmp-name 'string))
+ (setq attr (file-attributes tmp-name1 'string))
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
- (delete-file tmp-name)
- (make-directory tmp-name)
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should-not (file-regular-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (condition-case err
+ (progn
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-exists-p tmp-name2))
+ (should (file-symlink-p tmp-name2))
+ (setq attr (file-attributes tmp-name2))
+ (should (string-equal
+ (car attr)
+ (file-remote-p (file-truename tmp-name1) 'localname)))
+ (delete-file tmp-name2))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+ (delete-file tmp-name1)
+
+ (make-directory tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should-not (file-regular-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (eq (car attr) t)))
- (ignore-errors (delete-directory tmp-name)))))
+
+ (ignore-errors (delete-directory tmp-name1)))))
(ert-deftest tramp-test19-directory-files-and-attributes ()
"Check `directory-files-and-attributes'."
@@ -1530,7 +1545,7 @@ This requires restrictions of file name syntax."
(dolist (elt files)
(let* ((file1 (expand-file-name elt tmp-name1))
(file2 (expand-file-name elt tmp-name2))
- (file3 (concat file1 "foo")))
+ (file3 (expand-file-name (concat elt "foo") tmp-name1)))
(write-region elt nil file1)
(should (file-exists-p file1))
@@ -1557,6 +1572,10 @@ This requires restrictions of file name syntax."
(should
(string-equal
(expand-file-name file1) (file-truename file3)))
+ (should
+ (string-equal
+ (car (file-attributes file3))
+ (file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file3)
@@ -1596,8 +1615,10 @@ This requires restrictions of file name syntax."
;; Check directory creation. We use a subdirectory "foo"
;; in order to avoid conflicts with previous file name tests.
(dolist (elt files)
- (let* ((file1 (expand-file-name (concat "foo/" elt) tmp-name1))
- (file2 (expand-file-name elt file1)))
+ (let* ((elt1 (concat elt "foo"))
+ (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
+ (file2 (expand-file-name elt file1))
+ (file3 (expand-file-name elt1 file1)))
(make-directory file1 'parents)
(should (file-directory-p file1))
(write-region elt nil file2)
@@ -1611,6 +1632,28 @@ This requires restrictions of file name syntax."
(caar (directory-files-and-attributes
file1 nil directory-files-no-dot-files-regexp))
elt))
+
+ ;; Check symlink in `directory-files-and-attributes'.
+ (condition-case err
+ (progn
+ (make-symbolic-link file2 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (caar (directory-files-and-attributes
+ file1 nil (regexp-quote elt1)))
+ elt1))
+ (should
+ (string-equal
+ (cadr (car (directory-files-and-attributes
+ file1 nil (regexp-quote elt1))))
+ (file-remote-p (file-truename file2) 'localname)))
+ (delete-file file3)
+ (should-not (file-exists-p file3)))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+
(delete-file file2)
(should-not (file-exists-p file2))
(delete-directory file1)
@@ -1725,7 +1768,6 @@ Use the `ls' command."
(ert-deftest tramp-test31-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-adb-p)))
(tramp--test-utf8))
@@ -1920,7 +1962,6 @@ Since it unloads Tramp, it shall be the last test to run."
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
-; (progn (message "`%s' still bound" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
diff --git a/test/indent/sgml-mode-attribute.html
b/test/indent/sgml-mode-attribute.html
new file mode 100644
index 0000000..4cbec0a
--- /dev/null
+++ b/test/indent/sgml-mode-attribute.html
@@ -0,0 +1,14 @@
+<element attribute="value"></element>
+
+<element
+ attribute="value">
+ <element
+ attribute="value">
+ </element>
+</element>
+
+<!--
+ Local Variables:
+ sgml-attribute-offset: 2
+ End:
+ -->