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

Merge emacs-26

Browse source
This commit is contained in:
Stefan Monnier 2017-10-06 09:50:54 -04:00
commit 11f9cb522f
63 changed files with 31479 additions and 2206 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28971
ChangeLog.3
View file

File diff suppressed because it is too large Load diff

6
INSTALL
View file

@ -273,8 +273,10 @@ a POP3 server by default. Versions of the POP protocol older than
POP3 are not supported. While POP3 support is typically enabled,
whether Emacs actually uses POP3 is controlled by individual users;
see the Rmail chapter of the Emacs manual. Unless --with-mailutils is
in effect, it is a good idea to configure --without-pop so that users
are less likely to inadvertently read email via insecure channels.
in effect, it is a good idea to configure without POP3 support so that
users are less likely to inadvertently read email via insecure
channels. On native MS-Windows, --with-pop is the default; on other
platforms, --without-pop is the default.
For image support you may have to download, build, and install the
appropriate image support libraries for image types other than XBM and

2
Makefile.in
View file

@ -1115,7 +1115,7 @@ ChangeLog:
./$(emacslog) -o $(CHANGELOG) -n $(CHANGELOG_HISTORY_INDEX_MAX)
# Check that we are in a good state for changing history.
PREFERRED_BRANCH = master
PREFERRED_BRANCH = emacs-26
preferred-branch-is-current:
git branch | grep -q '^\* $(PREFERRED_BRANCH)$$'
unchanged-history-files:

27
admin/authors.el
View file

@ -1,3 +1,4 @@
;;; authors.el --- utility for maintaining Emacs's AUTHORS file
;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
@ -391,7 +392,7 @@ Changes to files matching one of the regexps in this list are not listed.")
"vms" "mac" "url" "tree-widget"
"info/dir"
;; Not in gnulib anymore
"lib/qset-acl.c" "lib/qcopy-acl.c" "lib/file-has-acl.c"
"lib/qset-acl.c" "lib/qcopy-acl.c" "lib/file-has-acl.c" "lib/secure_getenv.c"
;; files from old MS Windows build procedures
"nt/gnulib-modules-to-delete.cfg"
"makefile.w32-in"
@ -736,6 +737,8 @@ Changes to files in this list are not listed.")
"org-exp-blocks.el" ; maybe this is ob-exp now? dunno
"org-lparse.el"
"org-special-blocks.el" "org-taskjuggler.el"
"ob-sh.el"
"ob-scala.el"
"progmodes/cap-words.el"
"w32-common-fns.el"
;; gnus
@ -751,7 +754,7 @@ Changes to files in this list are not listed.")
"format-spec.el" "gnus-move.el" "gnus-sync.el"
"auth-source.el" "ecomplete.el" "gravatar.el" "mailcap.el" "plstore.el"
"pop3.el" "qp.el" "registry.el" "rfc2231.el" "rtree.el"
"sieve.el" "sieve-mode.el"
"sieve.el" "sieve-mode.el" "gnus-ems.el"
;; doc
"getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi"
"back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el"
@ -801,7 +804,12 @@ Changes to files in this list are not listed.")
"cedet-utests.el" "ede-tests.el" "semantic-ia-utest.el"
"semantic-tests.el" "semantic-utest-c.el" "semantic-utest.el"
"srecode-tests.el" "make-test-deps.emacs-lisp"
)
"nxml-uchnm.el"
"decoder-tests.el"
"obsolete/scribe.el"
"cp51932.el"
"eucjp-ms.el"
"lisp.mk")
"File names which are valid, but no longer exist (or cannot be found)
in the repository.")
@ -906,6 +914,8 @@ in the repository.")
("patcomp.el" . "patcomp.el")
("emulation/ws-mode.el" . "ws-mode.el")
("vc/vc-arch.el" . "vc-arch.el")
("lisp/gnus/messcompat.el" . "messcompat.el")
("html2text.el" . "html2text.el")
;; From lisp to etc/forms.
("forms-d2.el" . "forms-d2.el")
("forms-pass.el" . "forms-pass.el")
@ -950,9 +960,17 @@ in the repository.")
;; Moved from lisp/gnus/ to lisp/mail/
("binhex.el" . "mail/binhex.el")
("uudecode.el" . "mail/uudecode.el")
("mail-parse.el" . "mail/mail-parse.el")
("yenc.el" . "mail/yenc.el")
("flow-fill.el" . "mail/flow-fill.el")
("ietf-drums.el" . "mail/ietf-drums.el")
("sieve-manage.el" . "mail/sieve-manage.el")
;; Moved from lisp/gnus/ to lisp/image/
("compface.el" . "image/compface.el")
;; Moved from lisp/gnus/ to lisp/net/
("imap.el" . "net/imap.el")
("rfc2104.el" . "net/rfc2104.el")
("starttls.el" . "net/starttls.el")
;; And from emacs/ to misc/ and back again.
("ns-emacs.texi" . "macos.texi")
("overrides.texi" . "gnus-overrides.texi")
@ -993,6 +1011,7 @@ in the repository.")
("edt-user.doc" . "edt.texi")
("DEV-NOTES" . "nextstep")
("org/COPYRIGHT-AND-LICENSE" . "org/README")
("lisp/net/idna.el" . "puny.el")
;; Moved to different directories.
("ctags.1" . "ctags.1")
("etags.1" . "etags.1")
@ -1021,6 +1040,8 @@ in the repository.")
;; module.* moved to emacs-module.*
("src/module.h" . "src/emacs-module.h")
("src/module.c" . "src/emacs-module.c")
;; gnulib
("lib/strftime.c" . "lib/nstrftime.c")
)
"Alist of files which have been renamed during their lifetime.
Elements are (OLDNAME . NEWNAME).")

36
configure.ac
View file

@ -232,9 +232,9 @@ AC_DEFUN([OPTION_DEFAULT_ON], [dnl
m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=$with_features])dnl
])dnl
# FIXME: The default options '--without-mailutils --with-pop' result
# in a movemail implementation that supports only unencrypted POP3
# connections. Encrypted connections should be the default.
# For retrieving mail, unencrypted network connections are the default
# only on native MS-Windows platforms. (FIXME: These platforms should
# also be secure by default.)
AC_ARG_WITH([mailutils],
[AS_HELP_STRING([--with-mailutils],
@ -251,9 +251,16 @@ if test "$with_mailutils" = no; then
fi
AC_SUBST([with_mailutils])
OPTION_DEFAULT_ON([pop],
[don't support POP mail retrieval with movemail (--without-pop or
--with-mailutils is recommended, as movemail POP is insecure)])
AC_ARG_WITH([pop],
[AS_HELP_STRING([--with-pop],
[Support POP mail retrieval if Emacs movemail is used (not recommended,
as Emacs movemail POP is insecure). This is the default only on
native MS-Windows.])],
[],
[case $host in
*-mingw*) with_pop=yes;;
*) with_pop=no-by-default;;
esac])
if test "$with_pop" = yes; then
AC_DEFINE(MAIL_USE_POP)
fi
@ -1313,7 +1320,7 @@ dnl For a long time, -znocombreloc was added to LDFLAGS rather than
dnl LD_SWITCH_SYSTEM_TEMACS. That is:
dnl * inappropriate, as LDFLAGS is a user option but this is essential.
dnl Eg "make LDFLAGS=... all" could run into problems,
dnl http://bugs.debian.org/684788
dnl https://bugs.debian.org/684788
dnl * unnecessary, since temacs is the only thing that actually needs it.
dnl Indeed this is where it was originally, prior to:
dnl https://lists.gnu.org/archive/html/emacs-pretest-bug/2004-03/msg00170.html
@ -1392,10 +1399,6 @@ case "$opsys" in
# The resulting binary has a complete symbol table, and is better
# for debugging and other observability tools (debuggers, pstack, etc).
#
# If you encounter a problem using dldump(), please consider sending
# a message to the OpenSolaris tools-linking mailing list:
# http://mail.opensolaris.org/mailman/listinfo/tools-linking
#
# It is likely that dldump() works with older Solaris too, but this has
# not been tested, so for now this change is for Solaris 10 or newer.
UNEXEC_OBJ=unexsol.o
@ -2644,7 +2647,7 @@ if test x"$pkg_check_gtk" = xyes; then
closing open displays. This is no problem if you just use
one display, but if you use more than one and close one of them
Emacs may crash.
See http://bugzilla.gnome.org/show_bug.cgi?id=85715]])
See https://bugzilla.gnome.org/show_bug.cgi?id=85715]])
fi
fi
@ -4457,7 +4460,6 @@ 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* | nacl | openbsd | sol2* | unixware )
emacs_broken_SIGIO=yes
;;
@ -5568,6 +5570,12 @@ if test ! "$with_mailutils"; then
AC_MSG_WARN([This configuration installs a 'movemail' program
that retrieves POP3 email via only insecure channels.
To omit insecure POP3, you can use '$0 --without-pop'.])
elif test "$with_pop" = no-by-default; then
AC_MSG_WARN([This configuration installs a 'movemail' program
that does not retrieve POP3 email. By default, Emacs 25 and earlier
installed a 'movemail' program that retrieved POP3 email via only
insecure channels, a practice that is no longer recommended but that
you can continue to support by using '$0 --with-pop'.])
fi
case $opsys in
@ -5579,7 +5587,7 @@ To omit insecure POP3, you can use '$0 --without-pop'.])
case `(movemail --version) 2>/dev/null` in
*Mailutils*) ;;
*) emacs_fix_movemail="install GNU Mailutils
<http://mailutils.org> and $emacs_fix_movemail";;
<https://mailutils.org> and $emacs_fix_movemail";;
esac
AC_MSG_NOTICE([You might want to $emacs_fix_movemail.]);;
esac

10
doc/lispref/strings.texi
View file

@ -812,15 +812,19 @@ formatting feature described here; they differ from @code{format-message} only
in how they use the result of formatting.
@defun format string &rest objects
This function returns a new string that is made by copying
@var{string} and then replacing any format specification
in the copy with encodings of the corresponding @var{objects}. The
This function returns a string equal to @var{string}, replacing any format
specifications with encodings of the corresponding @var{objects}. The
arguments @var{objects} are the computed values to be formatted.
The characters in @var{string}, other than the format specifications,
are copied directly into the output, including their text properties,
if any. Any text properties of the format specifications are copied
to the produced string representations of the argument @var{objects}.
The output string need not be newly-allocated. For example, if
@code{x} is the string @code{"foo"}, the expressions @code{(eq x
(format x))} and @code{(eq x (format "%s" x))} might both yield
@code{t}.
@end defun
@defun format-message string &rest objects

540
doc/misc/flymake.texi
View file

@ -4,7 +4,7 @@
@set VERSION 0.3
@set UPDATED April 2004
@settitle GNU Flymake @value{VERSION}
@include docstyle.texi
@include ../emacs/docstyle.texi
@syncodeindex pg cp
@comment %**end of header
@ -35,7 +35,7 @@ modify this GNU manual.''
@titlepage
@title GNU Flymake
@subtitle for version @value{VERSION}, @value{UPDATED}
@author Pavel Kobiakov(@email{pk_at_work@@yahoo.com})
@author Pavel Kobiakov(@email{pk_at_work@@yahoo.com}) and João Távora.
@page
@vskip 0pt plus 1filll
@insertcopying
@ -53,8 +53,8 @@ modify this GNU manual.''
* Overview of Flymake::
* Installing Flymake::
* Using Flymake::
* Configuring Flymake::
* Flymake Implementation::
* Extending Flymake::
* The legacy Proc backend::
* GNU Free Documentation License::
* Index::
@end menu
@ -63,67 +63,56 @@ modify this GNU manual.''
@chapter Overview
@cindex Overview of Flymake
Flymake is a universal on-the-fly syntax checker implemented as an
Emacs minor mode. Flymake runs the pre-configured syntax check tool
(compiler for C++ files, @code{perl} for perl files, etc.)@: in the
background, passing it a temporary copy of the current buffer, and
parses the output for known error/warning message patterns. Flymake
then highlights erroneous lines (i.e., lines for which at least one
error or warning has been reported by the syntax check tool), and
displays an overall buffer status in the mode line. Status information
displayed by Flymake contains total number of errors and warnings
reported for the buffer during the last syntax check.
Flymake is a universal on-the-fly buffer checker implemented as an
Emacs minor mode. When enabled, Flymake visually annotates the buffer
with diagnostic information coming from one or more different sources,
or @emph{backends}.
@code{flymake-goto-next-error} and @code{flymake-goto-prev-error}
functions allow for easy navigation to the next/previous erroneous
line, respectively.
Historically, Flymake used to accept diagnostics from a single, albeit
reasonably flexible, backend.
Calling @code{flymake-display-err-menu-for-current-line} will popup a
menu containing error messages reported by the syntax check tool for
the current line. Errors/warnings belonging to another file, such as a
@code{.h} header file included by a @code{.c} file, are shown in the
current buffer as belonging to the first line. Menu items for such
messages also contain a filename and a line number. Selecting such a
menu item will automatically open the file and jump to the line with
error.
This backend isn't (yet) obsolete and so is still available as a
fallback and active by default(@pxref{The legacy Proc backend}). It works by
selecting a syntax check tool from a preconfigured list (compiler for
C++ files, @code{perl} for perl files, etc.), and executing it in the
background, passing it a temporary file which is a copy of the current
buffer, and parsing the output for known error/warning message
patterns.
Flymake annotates the buffer by highlighting problematic buffer
regions with a special space. It also displays an overall buffer
status in the mode line. Status information displayed by Flymake
contains totals for different types of diagnostics.
@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are
commands that allow easy navigation to the next/previous erroneous
line, respectively. If might be a good idea to map them to @kbd{M-n}
and @kbd{M-p} in @code{flymake-mode}, by adding to your init file:
@lisp
(define-key flymake-mode-map (kbd "M-n") 'flymake-goto-next-error)
(define-key flymake-mode-map (kbd "M-p") 'flymake-goto-prev-error)
@end lisp
Syntax check is done ``on-the-fly''. It is started whenever
@itemize @bullet
@item buffer is loaded
@item a newline character is added to the buffer
@item @code{flymake-mode} is started;
@item a newline character is added to the buffer;
@item some changes were made to the buffer more than @code{0.5} seconds ago (the
delay is configurable).
@end itemize
Flymake is a universal syntax checker in the sense that it's easily
extended to support new syntax check tools and error message
patterns. @xref{Configuring Flymake}.
extended to support new backends. @xref{Customizable variables}.
@node Installing Flymake
@chapter Installing
@cindex Installing Flymake
Flymake is packaged in a single file, @code{flymake.el}.
To install/update Flymake, place @code{flymake.el} to a directory
somewhere on Emacs load path. You might also want to byte-compile
@code{flymake.el} to improve performance.
Also, place the following line in the @code{.emacs} file.
@lisp
(require 'flymake)
@end lisp
You might also map the most frequently used Flymake functions, such as
@code{flymake-goto-next-error}, to some keyboard shortcuts:
@lisp
(global-set-key [f3] 'flymake-display-err-menu-for-current-line)
(global-set-key [f4] 'flymake-goto-next-error)
@end lisp
Flymake is included with Emacs and its main commands, like
@code{flymake-mode}, are autoloaded. This means there is usually
nothing to do by way of installation.
@node Using Flymake
@chapter Using Flymake
@ -132,10 +121,10 @@ You might also map the most frequently used Flymake functions, such as
@menu
* Flymake mode::
* Running the syntax check::
* Navigating to error lines::
* Viewing error messages::
* Navigating to error lines:: @c * Viewing error messages::
* Syntax check statuses::
* Troubleshooting::
* Customizable variables::
@end menu
@node Flymake mode
@ -161,10 +150,8 @@ line in @code{.emacs}:
When @code{flymake-mode} is active, syntax check is started
automatically on any of the three conditions mentioned above. Syntax
check can also be started manually by using the
@code{flymake-start-syntax-check-for-current-buffer} function. This
can be used, for example, when changes were made to some other buffer
affecting the current buffer.
check can also be started manually by using the @code{flymake-start}
function.
@node Navigating to error lines
@section Navigating to error lines
@ -185,69 +172,37 @@ navigate the highlighted lines.
@end multitable
These functions treat erroneous lines as a linked list. Therefore,
@code{flymake-goto-next-error} will go to the first erroneous line
when invoked in the end of the buffer.
@node Viewing error messages
@section Viewing error messages
@cindex Viewing error messages
To view error messages belonging to the current line, use the
@code{flymake-display-err-menu-for-current-line} function. If there's
at least one error or warning reported for the current line, this
function will display a popup menu with error/warning texts.
Selecting the menu item whose error belongs to another file brings
forward that file with the help of the
@code{flymake-goto-file-and-line} function.
If the user option @code{flymake-wrap-around} is active
(@pxref{Customizable variables}), these functions treat diagnostics
as a linked list. Therefore, @code{flymake-goto-next-error} will go
to the first diagnostic when invoked in the end of the buffer.
@node Syntax check statuses
@section Syntax check statuses
@cindex Syntax check statuses
After syntax check is finished, its status is displayed in the mode line.
The following statuses are defined.
The following statuses are defined:
@multitable @columnfractions 0.25 0.75
@item Flymake* or Flymake:E/W*
@tab Flymake is currently running. For the second case, E/W contains the
error and warning count for the previous run.
@item @code{Wait}
@tab Some flymake backends haven't reported since the last time they
where questioned.
@item Flymake
@tab Syntax check is not running. Usually this means syntax check was
successfully passed (no errors, no warnings). Other possibilities are:
syntax check was killed as a result of executing
@code{flymake-compile}, or syntax check cannot start as compilation
is currently in progress.
@item @code{!}
@tab All the configured Flymake backends have disabled themselves.
Left-clicking the ``Flymake'' mode line indicator beings the user
@code{*Flymake log*} buffer where these situations may be investigated
@item Flymake:E/W
@tab Number of errors/warnings found by the syntax check process.
@item @code{?}
@tab There are no configured Flymake backends in
@code{flymake-diagnostic-functions}.
@item Flymake:!
@tab Flymake was unable to find master file for the current buffer.
@item @emph{[nerrors nwarnings]}
@tab Normal operation, number of errors/warnings found by the syntax
check process.
@end multitable
The following errors cause a warning message and switch flymake mode
OFF for the buffer.
@multitable @columnfractions 0.25 0.75
@item CFGERR
@tab Syntax check process returned nonzero exit code, but no
errors/warnings were reported. This indicates a possible configuration
error (for example, no suitable error message patterns for the
syntax check tool).
@item NOMASTER
@tab Flymake was unable to find master file for the current buffer.
@item NOMK
@tab Flymake was unable to find a suitable buildfile for the current buffer.
@item PROCERR
@tab Flymake was unable to launch a syntax check process.
@end multitable
@node Troubleshooting
@section Troubleshooting
@cindex Logging
@ -255,70 +210,20 @@ syntax check tool).
Flymake uses a simple logging facility for indicating important points
in the control flow. The logging facility sends logging messages to
the @file{*Messages*} buffer. The information logged can be used for
the @file{*Flymake log*} buffer. The information logged can be used for
resolving various problems related to Flymake.
Logging output is controlled by the @code{flymake-log-level}
variable. @code{3} is the most verbose level, and @code{-1} switches
logging off.
@node Configuring Flymake
@chapter Configuring and Extending Flymake
@cindex Configuring and Extending Flymake
@menu
* Customizable variables::
* Adding support for a new syntax check tool::
@end menu
Flymake was designed to be easily extended for supporting new syntax
check tools and error message patterns.
Logging output is controlled by the Emacs @code{warning-minimum-log-level}
and @code{warning-minimum-level} variables.
@node Customizable variables
@section Customizable variables
@cindex Customizable variables
This section summarizes variables used for Flymake
configuration.
This section summarizes variables used for the configuration of the
Flymake user interface.
@table @code
@item flymake-log-level
Controls logging output, see @ref{Troubleshooting}.
@item flymake-allowed-file-name-masks
A list of @code{(filename-regexp, init-function, cleanup-function
getfname-function)} for configuring syntax check tools. @xref{Adding
support for a new syntax check tool}.
@ignore
@item flymake-buildfile-dirs
A list of directories (relative paths) for searching a
buildfile. @xref{Locating the buildfile}.
@end ignore
@item flymake-master-file-dirs
A list of directories for searching a master file. @xref{Locating a
master file}.
@item flymake-get-project-include-dirs-function
A function used for obtaining a list of project include dirs (C/C++
specific). @xref{Getting the include directories}.
@item flymake-master-file-count-limit
@itemx flymake-check-file-limit
Used when looking for a master file. @xref{Locating a master file}.
@item flymake-err-line-patterns
Patterns for error/warning messages in the form @code{(regexp file-idx
line-idx col-idx err-text-idx)}. @xref{Parsing the output}.
@item flymake-warning-predicate
Predicate to classify error text as warning. @xref{Parsing the output}.
@item flymake-compilation-prevents-syntax-check
A flag indicating whether compilation and syntax check of the same
file cannot be run simultaneously.
@item flymake-no-changes-timeout
If any changes are made to the buffer, syntax check is automatically
started after @code{flymake-no-changes-timeout} seconds.
@ -327,13 +232,17 @@ started after @code{flymake-no-changes-timeout} seconds.
A boolean flag indicating whether to start syntax check after a
newline character is added to the buffer.
@item flymake-errline
A custom face for highlighting lines for which at least one error has
been reported.
@item flymake-error
A custom face for highlighting regions for which an error has been
reported.
@item flymake-warnline
A custom face for highlighting lines for which at least one warning
and no errors have been reported.
@item flymake-warning
A custom face for highlighting regions for which a warning has been
reported.
@item flymake-note
A custom face for highlighting regions for which a note has been
reported.
@item flymake-error-bitmap
A bitmap used in the fringe to mark lines for which an error has
@ -346,6 +255,76 @@ been reported.
@item flymake-fringe-indicator-position
Which fringe (if any) should show the warning/error bitmaps.
@item flymake-wrap-around
If non-nil, moving to errors with @code{flymake-goto-next-error} and
@code{flymake-goto-prev-error} wraps around buffer boundaries.
@end table
@node Extending Flymake
@chapter Extending Flymake
@cindex Extending Flymake
@node The legacy Proc backend
@chapter The legacy ``Proc'' backend
@cindex The legacy Proc backend
@menu
* Proc customization variables::
* Adding support for a new syntax check tool::
* Implementation overview::
* Making a temporary copy::
* Locating a master file::
* Getting the include directories::
* Locating the buildfile::
* Starting the syntax check process::
* Parsing the output::
* Interaction with other modes::
@end menu
The backend @code{flymake-proc-legacy-backend} was originally designed
to be extended for supporting new syntax check tools and error message
patterns. It is also controlled by its own set of customization variables
@node Proc customization variables
@section Customization variables for the Proc backend
@cindex Proc customization variables
@table @code
@item flymake-proc-allowed-file-name-masks
A list of @code{(filename-regexp, init-function, cleanup-function
getfname-function)} for configuring syntax check tools. @xref{Adding
support for a new syntax check tool}.
@item flymake-proc-master-file-dirs
A list of directories for searching a master file. @xref{Locating a
master file}.
@item flymake-proc-get-project-include-dirs-function
A function used for obtaining a list of project include dirs (C/C++
specific). @xref{Getting the include directories}.
@item flymake-proc-master-file-count-limit
@itemx flymake-proc-check-file-limit
Used when looking for a master file. @xref{Locating a master file}.
@item flymake-proc-err-line-patterns
Patterns for error/warning messages in the form @code{(regexp file-idx
line-idx col-idx err-text-idx)}. @xref{Parsing the output}.
@item flymake-proc-diagnostic-type-pred
A function to classify a diagnostic text as particular type of
error. Should be a function taking an error text and returning one of
the symbols indexing @code{flymake-diagnostic-types-alist}. If non-nil
is returned but there is no such symbol in that table, a warning is
assumed. If nil is returned, an error is assumed. Can also be a
regular expression that should match only warnings. This variable
replaces the old @code{flymake-warning-re} and
@code{flymake-warning-predicate}.
@item flymake-proc-compilation-prevents-syntax-check
A flag indicating whether compilation and syntax check of the same
file cannot be run simultaneously.
@end table
@node Adding support for a new syntax check tool
@ -358,7 +337,7 @@ Which fringe (if any) should show the warning/error bitmaps.
@end menu
Syntax check tools are configured using the
@code{flymake-allowed-file-name-masks} list. Each item of this list
@code{flymake-proc-allowed-file-name-masks} list. Each item of this list
has the following format:
@lisp
@ -369,15 +348,15 @@ has the following format:
@item filename-regexp
This field is used as a key for locating init/cleanup/getfname
functions for the buffer. Items in
@code{flymake-allowed-file-name-masks} are searched sequentially. The
first item with @code{filename-regexp} matching buffer filename is
@code{flymake-proc-allowed-file-name-masks} are searched sequentially.
The first item with @code{filename-regexp} matching buffer filename is
selected. If no match is found, @code{flymake-mode} is switched off.
@item init-function
@code{init-function} is required to initialize the syntax check,
usually by creating a temporary copy of the buffer contents. The
function must return @code{(list cmd-name arg-list)}. If
@code{init-function} returns null, syntax check is aborted, by
@code{init-function} returns null, syntax check is aborted, but
@code{flymake-mode} is not switched off.
@item cleanup-function
@ -390,16 +369,16 @@ This function is used for translating filenames reported by the syntax
check tool into ``real'' filenames. Filenames reported by the tool
will be different from the real ones, as actually the tool works with
the temporary copy. In most cases, the default implementation
provided by Flymake, @code{flymake-get-real-file-name}, can be used as
@code{getfname-function}.
provided by Flymake, @code{flymake-proc-get-real-file-name}, can be
used as @code{getfname-function}.
@end table
To add support for a new syntax check tool, write corresponding
@code{init-function}, and, optionally @code{cleanup-function} and
@code{init-function} and, optionally, @code{cleanup-function} and
@code{getfname-function}. If the format of error messages reported by
the new tool is not yet supported by Flymake, add a new entry to
the @code{flymake-err-line-patterns} list.
the @code{flymake-proc-err-line-patterns} list.
The following sections contain some examples of configuring Flymake
support for various syntax check tools.
@ -415,42 +394,42 @@ checking.
First, we write the @code{init-function}:
@lisp
(defun flymake-perl-init ()
(let* ((temp-file (flymake-init-create-temp-buffer-copy
'flymake-create-temp-inplace))
(defun flymake-proc-perl-init ()
(let* ((temp-file (flymake-proc-init-create-temp-buffer-copy
'flymake-proc-create-temp-inplace))
(local-file (file-relative-name
temp-file
(file-name-directory buffer-file-name))))
(list "perl" (list "-wc " local-file))))
@end lisp
@code{flymake-perl-init} creates a temporary copy of the buffer
@code{flymake-proc-perl-init} creates a temporary copy of the buffer
contents with the help of
@code{flymake-init-create-temp-buffer-copy}, and builds an appropriate
@code{flymake-proc-init-create-temp-buffer-copy}, and builds an appropriate
command line.
Next, we add a new entry to the
@code{flymake-allowed-file-name-masks}:
@code{flymake-proc-allowed-file-name-masks}:
@lisp
(setq flymake-allowed-file-name-masks
(setq flymake-proc-allowed-file-name-masks
(cons '(".+\\.pl$"
flymake-perl-init
flymake-simple-cleanup
flymake-get-real-file-name)
flymake-allowed-file-name-masks))
flymake-proc-perl-init
flymake-proc-simple-cleanup
flymake-proc-get-real-file-name)
flymake-proc-allowed-file-name-masks))
@end lisp
Note that we use standard @code{cleanup-function} and
@code{getfname-function}.
Finally, we add an entry to @code{flymake-err-line-patterns}:
Finally, we add an entry to @code{flymake-proc-err-line-patterns}:
@lisp
(setq flymake-err-line-patterns
(setq flymake-proc-err-line-patterns
(cons '("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]"
2 3 nil 1)
flymake-err-line-patterns))
flymake-proc-err-line-patterns))
@end lisp
@node Example---Configuring a tool called via make
@ -462,18 +441,18 @@ In this example we will add support for C files syntax checked by
We're not required to write any new functions, as Flymake already has
functions for @command{make}. We just add a new entry to the
@code{flymake-allowed-file-name-masks}:
@code{flymake-proc-allowed-file-name-masks}:
@lisp
(setq flymake-allowed-file-name-masks
(setq flymake-proc-allowed-file-name-masks
(cons '(".+\\.c$"
flymake-simple-make-init
flymake-simple-cleanup
flymake-get-real-file-name)
flymake-allowed-file-name-masks))
flymake-proc-simple-make-init
flymake-proc-simple-cleanup
flymake-proc-get-real-file-name)
flymake-proc-allowed-file-name-masks))
@end lisp
@code{flymake-simple-make-init} builds the following @command{make}
@code{flymake-proc-simple-make-init} builds the following @command{make}
command line:
@lisp
@ -492,7 +471,7 @@ our case this target might look like this:
@verbatim
check-syntax:
gcc -o /dev/null -S ${CHK_SOURCES}
gcc -o /dev/null -S ${CHK_SOURCES} || true
@end verbatim
@noindent
@ -504,42 +483,25 @@ Automake variable @code{COMPILE}:
@verbatim
check-syntax:
$(COMPILE) -o /dev/null -S ${CHK_SOURCES}
$(COMPILE) -o /dev/null -S ${CHK_SOURCES} || true
@end verbatim
@node Flymake Implementation
@chapter Flymake Implementation
@cindex Implementation details
@menu
* Determining whether syntax check is possible::
* Making a temporary copy::
* Locating a master file::
* Getting the include directories::
* Locating the buildfile::
* Starting the syntax check process::
* Parsing the output::
* Highlighting erroneous lines::
* Interaction with other modes::
@end menu
Syntax check is started by calling @code{flymake-start-syntax-check-for-current-buffer}.
Flymake first determines whether it is able to do syntax
check. It then saves a copy of the buffer in a temporary file in the
buffer's directory (or in the system temp directory, for java
files), creates a syntax check command and launches a process with
this command. The output is parsed using a list of error message patterns,
and error information (file name, line number, type and text) is
saved. After the process has finished, Flymake highlights erroneous
lines in the buffer using the accumulated error information.
@node Determining whether syntax check is possible
@section Determining whether syntax check is possible
@node Implementation overview
@section Implementation overview
@cindex Syntax check models
@cindex Master file
@code{flymake-proc-legacy-backend} saves a copy of the buffer in a
temporary file in the buffer's directory (or in the system temp
directory, for Java files), creates a syntax check command and
launches a process with this command. The output is parsed using a
list of error message patterns, and error information (file name, line
number, type and text) is saved. After the process has finished,
Flymake highlights erroneous lines in the buffer using the accumulated
error information.
Syntax check is considered possible if there's an entry in
@code{flymake-allowed-file-name-masks} matching buffer's filename and
@code{flymake-proc-allowed-file-name-masks} matching buffer's filename and
its @code{init-function} returns non-@code{nil} value.
Two syntax check modes are distinguished:
@ -564,10 +526,10 @@ will also check syntax in the current file. Examples are C/C++ (.h,
These modes are handled inside init/cleanup/getfname functions, see
@ref{Adding support for a new syntax check tool}.
Flymake contains implementations of all functionality required to
support different syntax check modes described above (making temporary
copies, finding master files, etc.), as well as some tool-specific
(routines for Make, Ant, etc.)@: code.
The Proc backend contains implementations of all functionality
required to support different syntax check modes described above
(making temporary copies, finding master files, etc.), as well as some
tool-specific (routines for Make, Ant, etc.)@: code.
@node Making a temporary copy
@ -609,15 +571,16 @@ Master file is located in two steps.
First, a list of possible master files is built. A simple name
matching is used to find the files. For a C++ header @code{file.h},
Flymake searches for all @code{.cpp} files in the directories whose relative paths are
stored in a customizable variable @code{flymake-master-file-dirs}, which
usually contains something like @code{("." "./src")}. No more than
@code{flymake-master-file-count-limit} entries is added to the master file
list. The list is then sorted to move files with names @code{file.cpp} to
the top.
the Proc backend searches for all @code{.cpp} files in the directories
whose relative paths are stored in a customizable variable
@code{flymake-proc-master-file-dirs}, which usually contains something
like @code{("." "./src")}. No more than
@code{flymake-proc-master-file-count-limit} entries is added to the
master file list. The list is then sorted to move files with names
@code{file.cpp} to the top.
Next, each master file in a list is checked to contain the appropriate
include directives. No more than @code{flymake-check-file-limit} of each
include directives. No more than @code{flymake-proc-check-file-limit} of each
file are parsed.
For @code{file.h}, the include directives to look for are
@ -639,10 +602,10 @@ and project include directories. The former is just the contents of the
@code{INCLUDE} environment variable. The latter is not so easy to obtain,
and the way it can be obtained can vary greatly for different projects.
Therefore, a customizable variable
@code{flymake-get-project-include-dirs-function} is used to provide the
@code{flymake-proc-get-project-include-dirs-function} is used to provide the
way to implement the desired behavior.
The default implementation, @code{flymake-get-project-include-dirs-imp},
The default implementation, @code{flymake-proc-get-project-include-dirs-imp},
uses a @command{make} call. This requires a correct base directory, that is, a
directory containing a correct @file{Makefile}, to be determined.
@ -656,27 +619,27 @@ of every syntax check attempt.
@cindex buildfile, locating
@cindex Makefile, locating
Flymake can be configured to use different tools for performing syntax
checks. For example, it can use direct compiler call to syntax check a perl
script or a call to @command{make} for a more complicated case of a
@code{C/C++} source. The general idea is that simple files, like perl
scripts and html pages, can be checked by directly invoking a
corresponding tool. Files that are usually more complex and generally
used as part of larger projects, might require non-trivial options to
be passed to the syntax check tool, like include directories for
C++. The latter files are syntax checked using some build tool, like
Make or Ant.
The Proc backend can be configured to use different tools for
performing syntax checks. For example, it can use direct compiler
call to syntax check a perl script or a call to @command{make} for a
more complicated case of a @code{C/C++} source. The general idea is
that simple files, like perl scripts and html pages, can be checked by
directly invoking a corresponding tool. Files that are usually more
complex and generally used as part of larger projects, might require
non-trivial options to be passed to the syntax check tool, like
include directories for C++. The latter files are syntax checked
using some build tool, like Make or Ant.
All Make configuration data is usually stored in a file called
@code{Makefile}. To allow for future extensions, flymake uses a notion of
@code{Makefile}. To allow for future extensions, Flymake uses a notion of
buildfile to reference the 'project configuration' file.
Special function, @code{flymake-find-buildfile} is provided for locating buildfiles.
Special function, @code{flymake-proc-find-buildfile} is provided for locating buildfiles.
Searching for a buildfile is done in a manner similar to that of searching
for possible master files.
@ignore
A customizable variable
@code{flymake-buildfile-dirs} holds a list of relative paths to the
@code{flymake-proc-buildfile-dirs} holds a list of relative paths to the
buildfile. They are checked sequentially until a buildfile is found.
@end ignore
In case there's no build file, syntax check is aborted.
@ -687,12 +650,12 @@ Buildfile values are also cached.
@section Starting the syntax check process
@cindex Syntax check process
The command line (command name and the list of arguments) for launching a process is returned by the
initialization function. Flymake then just calls @code{start-process}
to start an asynchronous process and configures a process filter and
sentinel, which are used for processing the output of the syntax check
tool. When exiting Emacs, running Flymake processes will be killed
without prompting the user.
The command line (command name and the list of arguments) for
launching a process is returned by the initialization function. The
Proc backend then just starts an asynchronous process and configures a
process filter and sentinel, which are used for processing the output
of the syntax check tool. When exiting Emacs, running processes will
be killed without prompting the user.
@node Parsing the output
@section Parsing the output
@ -700,7 +663,7 @@ without prompting the user.
The output generated by the syntax check tool is parsed in the process
filter/sentinel using the error message patterns stored in the
@code{flymake-err-line-patterns} variable. This variable contains a
@code{flymake-proc-err-line-patterns} variable. This variable contains a
list of items of the form @code{(regexp file-idx line-idx
err-text-idx)}, used to determine whether a particular line is an
error message and extract file name, line number and error text,
@ -709,66 +672,39 @@ error text with the '@code{^[wW]arning}' pattern. Anything that was not
classified as a warning is considered an error. Type is then used to
sort error menu items, which shows error messages first.
Flymake is also able to interpret error message patterns missing err-text-idx
information. This is done by merely taking the rest of the matched line
(@code{(substring line (match-end 0))}) as error text. This trick allows
making use of a huge collection of error message line patterns from
@code{compile.el}. All these error patterns are appended to
the end of @code{flymake-err-line-patterns}.
The Proc backend is also able to interpret error message patterns
missing err-text-idx information. This is done by merely taking the
rest of the matched line (@code{(substring line (match-end 0))}) as
error text. This trick allows making use of a huge collection of
error message line patterns from @code{compile.el}. All these error
patterns are appended to the end of
@code{flymake-proc-err-line-patterns}.
The error information obtained is saved in a buffer local
variable. The buffer for which the process output belongs is
determined from the process-id@w{}->@w{}buffer mapping updated
after every process launch/exit.
@node Highlighting erroneous lines
@section Highlighting erroneous lines
@cindex Erroneous lines, faces
Highlighting is implemented with overlays and happens in the process
sentinel, after calling the cleanup function. Two customizable faces
are used: @code{flymake-errline} and
@code{flymake-warnline}. Errors belonging outside the current
buffer are considered to belong to line 1 of the current buffer.
@c This manual does not use vindex.
@c @vindex flymake-fringe-indicator-position
@c @vindex flymake-error-bitmap
@c @vindex flymake-warning-bitmap
If the option @code{flymake-fringe-indicator-position} is non-@code{nil},
errors and warnings are also highlighted in the left or right fringe,
using the bitmaps specified by @code{flymake-error-bitmap}
and @code{flymake-warning-bitmap}.
@node Interaction with other modes
@section Interaction with other modes
@cindex Interaction with other modes
@cindex Interaction with compile mode
The only mode flymake currently knows about is @code{compile}.
The only mode the Proc backend currently knows about is
@code{compile}.
Flymake can be configured to not start syntax check if it thinks the
compilation is in progress. The check is made by the
@code{flymake-compilation-is-running}, which tests the
The Proc backend can be configured to not start syntax check if it
thinks the compilation is in progress, by testing the
@code{compilation-in-progress} variable. The reason why this might be
useful is saving CPU time in case both syntax check and compilation
are very CPU intensive. The original reason for adding this feature,
though, was working around a locking problem with MS Visual C++
compiler.
compiler. The variable in question is
@code{flymake-proc-compilation-prevents-syntax-check}.
Flymake also provides an alternative command for starting compilation,
@code{flymake-compile}:
@lisp
(defun flymake-compile ()
"Kill all flymake syntax checks then start compilation."
(interactive)
(flymake-stop-all-syntax-checks)
(call-interactively 'compile))
@end lisp
It just kills all the active syntax check processes before calling
@code{compile}.
The Proc backend also provides an alternative command for starting
compilation, @code{flymake-proc-compile}. It just kills all the active
syntax check processes before calling @code{compile}.
@node GNU Free Documentation License
@appendix GNU Free Documentation License

19
doc/misc/org.texi
View file

@ -4,7 +4,7 @@
@settitle The Org Manual
@include docstyle.texi
@set VERSION 9.1.1
@set VERSION 9.1.2
@set DATE 2017-09-17
@c Version and Contact Info
@ -1257,13 +1257,8 @@ Org uses just two commands, bound to @key{TAB} and
@end example
@vindex org-cycle-emulate-tab
@vindex org-cycle-global-at-bob
The cursor must be on a headline for this to work@footnote{see, however,
the option @code{org-cycle-emulate-tab}.}. When the cursor is at the
beginning of the buffer and the first line is not a headline, then
@key{TAB} actually runs global cycling (see below)@footnote{see the
option @code{org-cycle-global-at-bob}.}. Also when called with a prefix
argument (@kbd{C-u @key{TAB}}), global cycling is invoked.
the option @code{org-cycle-emulate-tab}.}.
@cindex global visibility states
@cindex global cycling
@ -1283,6 +1278,11 @@ When @kbd{S-@key{TAB}} is called with a numeric prefix argument N, the
CONTENTS view up to headlines of level N will be shown. Note that inside
tables, @kbd{S-@key{TAB}} jumps to the previous field.
@vindex org-cycle-global-at-bob
You can run global cycling using @key{TAB} only if point is at the very
beginning of the buffer, but not on a headline, and
@code{org-cycle-global-at-bob} is set to a non-@code{nil} value.
@cindex set startup visibility, command
@orgcmd{C-u C-u @key{TAB},org-set-startup-visibility}
Switch back to the startup visibility of the buffer (@pxref{Initial visibility}).
@ -1659,11 +1659,9 @@ line. In particular, if an ordered list reaches number @samp{10.}, then the
list. An item ends before the next line that is less or equally indented
than its bullet/number.
@vindex org-list-empty-line-terminates-plain-lists
A list ends whenever every item has ended, which means before any line less
or equally indented than items at top level. It also ends before two blank
lines@footnote{See also @code{org-list-empty-line-terminates-plain-lists}.}.
In that case, all items are closed. Here is an example:
lines. In that case, all items are closed. Here is an example:
@example
@group
@ -14991,6 +14989,7 @@ directory on the local machine.
'(("org"
:base-directory "~/org/"
:publishing-directory "~/public_html"
:publishing-function org-html-publish-to-html
:section-numbers nil
:with-toc nil
:html-head "<link rel=\"stylesheet\"

14
etc/NEWS.26
View file

@ -35,8 +35,9 @@ GNU Mailutils to retrieve email. It is recommended, and is the
default if GNU Mailutils is installed. When --with-mailutils is not
in effect, the Emacs build procedure by default continues to build and
install a limited 'movemail' substitute that retrieves POP3 email only
via insecure channels; to avoid this problem, use either
--with-mailutils or --without-pop when configuring.
via insecure channels. To avoid this problem, use either
--with-mailutils or --without-pop when configuring; --without-pop
is the default on platforms other than native MS-Windows.
** The new option 'configure --enable-gcc-warnings=warn-only' causes
GCC to issue warnings without stopping the build. This behavior is
@ -1111,7 +1112,7 @@ See the 'vc-faces' customization group.
*** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various
branch-related commands on a keymap bound to 'B'.
---
+++
*** 'vc-region-history' is now bound to 'C-x v h', replacing the older
'vc-insert-headers' binding.
@ -1555,6 +1556,13 @@ Emacs integers with %e, %f, or %g conversions. For example, on these
hosts (eql N (string-to-number (format "%.0f" N))) now returns t for
all Emacs integers N.
+++
** 'format' is no longer documented to return a newly-allocated string.
This documentation was not correct, as (eq x (format x)) returned t
when x was the empty string. 'format' now takes advantage of the doc
change to avoid making copies of strings in common cases like (format
"foo") and (format "%s" "foo").
---
** Calls that accept floating-point integers (for use on hosts with
limited integer range) now signal an error if arguments are not

13
etc/PROBLEMS
View file

@ -2029,6 +2029,19 @@ Definitions" to make them defined.
We list bugs in current versions here. See also the section on legacy
systems.
*** On Solaris 10, Emacs crashes during the build process.
This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun
Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C
5.15), and intermittently for sparc-sun-solaris2.10 with Oracle
Developer Studio 12.5 (Sun C 5.14). Disabling compiler optimization
seems to fix the bug, as does upgrading the Solaris 10 operating
system to Update 11. The cause of the bug is unknown: it may be that
Emacs's archaic memory-allocation scheme is not compatible with
slightly-older versions of Solaris and/or Oracle Studio, or it may be
something else. Since the cause is not known, possibly the bug is
still present in newer versions of Emacs, Oracle Studio, and/or
Solaris. See Bug#26638.
*** On Solaris, C-x doesn't get through to Emacs when you use the console.
This is a Solaris feature (at least on Intel x86 cpus). Type C-r

2
etc/refcards/orgcard.tex
View file

@ -1,5 +1,5 @@
% Reference Card for Org Mode
\def\orgversionnumber{9.1.1}
\def\orgversionnumber{9.1.2}
\def\versionyear{2017} % latest update
\input emacsver.tex

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

@ -1183,7 +1183,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(compilation-forget-errors)
pt))))
(defvar byte-compile-log-warning-function
#'byte-compile--log-warning-for-byte-compile
"Function called when encountering a warning or error.
Called with arguments (STRING POSITION FILL LEVEL). STRING is a
message describing the problem. POSITION is a buffer position
where the problem was detected. FILL is a prefix as in
`warning-fill-prefix'. LEVEL is the level of the
problem (`:warning' or `:error'). POSITION, FILL and LEVEL may be
nil.")
(defun byte-compile-log-warning (string &optional fill level)
"Log a byte-compilation warning.
STRING, FILL and LEVEL are as described in
`byte-compile-log-warning-function', which see."
(funcall byte-compile-log-warning-function
string byte-compile-last-position
fill
level))
(defun byte-compile--log-warning-for-byte-compile (string &optional
_position
fill
level)
"Log a message STRING in `byte-compile-log-buffer'.
Also log the current function and file if not already done. If
FILL is non-nil, set `warning-fill-prefix' to four spaces. LEVEL

19
lisp/emacs-lisp/checkdoc.el
View file

@ -1147,14 +1147,27 @@ Prefix argument is the same as for `checkdoc-defun'"
;; features and behaviors, so we need some ways of specifying
;; them, and making them easier to use in the wacked-out interfaces
;; people are requesting
(defun checkdoc-create-error (text start end &optional unfixable)
"Used to create the return error text returned from all engines.
(defvar checkdoc-create-error-function #'checkdoc--create-error-for-checkdoc
"Function called when Checkdoc encounters an error.
Should accept as arguments (TEXT START END &optional UNFIXABLE).
TEXT is the descriptive text of the error. START and END define the region
it is sensible to highlight when describing the problem.
Optional argument UNFIXABLE means that the error has no auto-fix available.
A list of the form (TEXT START END UNFIXABLE) is returned if we are not
generating a buffered list of errors."
generating a buffered list of errors.")
(defun checkdoc-create-error (text start end &optional unfixable)
"Used to create the return error text returned from all engines.
TEXT, START, END and UNFIXABLE conform to
`checkdoc-create-error-function', which see."
(funcall checkdoc-create-error-function text start end unfixable))
(defun checkdoc--create-error-for-checkdoc (text start end &optional unfixable)
"Create an error for Checkdoc.
TEXT, START, END and UNFIXABLE conform to
`checkdoc-create-error-function', which see."
(if checkdoc-generate-compile-warnings-flag
(progn (checkdoc-error start text)
nil)

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

@ -268,7 +268,7 @@ into a button whose action shows the function's disassembly.")
Output is further controlled by the variables
`cl-print-readably', `cl-print-compiled', along with output
variables for the standard printing functions. See Info
node `(elisp)Output Variables'. "
node `(elisp)Output Variables'."
(cond
(cl-print-readably (prin1 object stream))
((not print-circle) (cl-print-object object stream))

3
lisp/emacs-lisp/generator.el
View file

@ -142,8 +142,7 @@ the CPS state machinery.
`(let ((,dynamic-var ,static-var))
(unwind-protect ; Update the static shadow after evaluation is done
,form
(setf ,static-var ,dynamic-var))
,form)))
(setf ,static-var ,dynamic-var)))))
(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
"Evaluate BODY such that generated atomic evaluations run with

11
lisp/emacs-lisp/tabulated-list.el
View file

@ -329,6 +329,8 @@ Check the current row, the previous one and the next row."
(string-width (if (stringp nt) nt (car nt)))))
tabulated-list--near-rows)))
(defvar tabulated-list-entry-lnum-width nil)
(defun tabulated-list-print (&optional remember-pos update)
"Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
@ -371,6 +373,7 @@ changing `tabulated-list-sort-key'."
(unless tabulated-list-use-header-line
(tabulated-list-print-fake-header)))
;; Finally, print the resulting list.
(setq tabulated-list-entry-lnum-width (tabulated-list-line-number-width))
(while entries
(let* ((elt (car entries))
(tabulated-list--near-rows
@ -383,7 +386,7 @@ changing `tabulated-list-sort-key'."
(equal entry-id id)
(setq entry-id nil
saved-pt (point)))
;; If the buffer this empty, simply print each elt.
;; If the buffer is empty, simply print each elt.
(if (or (not update) (eobp))
(apply tabulated-list-printer elt)
(while (let ((local-id (tabulated-list-get-id)))
@ -424,12 +427,10 @@ of column descriptors."
(let ((beg (point))
(x (max tabulated-list-padding 0))
(ncols (length tabulated-list-format))
(lnum-width (tabulated-list-line-number-width))
(inhibit-read-only t))
(if display-line-numbers
(setq x (+ x lnum-width)))
(setq x (+ x tabulated-list-entry-lnum-width))
(if (> tabulated-list-padding 0)
(insert (make-string (- x lnum-width) ?\s)))
(insert (make-string (- x tabulated-list-entry-lnum-width) ?\s)))
(let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
(or (bound-and-true-p tabulated-list--near-rows)
(list (or (tabulated-list-get-entry (point-at-bol 0))

14
lisp/gnus/ChangeLog.3
View file

@ -9303,7 +9303,7 @@
* mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el:
* mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el:
* nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el:
* rfc1843.el, sieve-manage.el, smime.el, spam.el:
* gnus-rfc1843.el, sieve-manage.el, smime.el, spam.el:
Fix comment for declare-function.
2010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -10470,7 +10470,7 @@
2010-09-25 Julien Danjou <julien@danjou.info>
* rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function
* gnus-rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function
variables.
* nnheader.el: Remove useless variables news-reply-yank-from and
@ -14716,14 +14716,14 @@
* mml2015.el (gnus-buffer-live-p, gnus-get-buffer-create):
* nnfolder.el (gnus-request-group):
* nnheader.el (ietf-drums-unfold-fws):
* rfc1843.el (mail-header-parse-content-type, message-narrow-to-head):
* gnus-rfc1843.el (mail-header-parse-content-type, message-narrow-to-head):
* smime.el (gnus-run-mode-hooks):
* spam-stat.el (gnus-message): Autoload.
* gnus-cache.el, gnus-fun.el, gnus-group.el, gnus.el, mail-source.el:
* mm-bodies.el, mm-decode.el, mm-extern.el, mm-util.el:
* mml-smime.el, mml.el, mml1991.el, mml2015.el, nndb.el, nnfolder.el:
* nnmail.el, nnmaildir.el, nnrss.el, rfc1843.el, spam.el:
* nnmail.el, nnmaildir.el, nnrss.el, gnus-rfc1843.el, spam.el:
Add declare-function compatibility definition.
* gnus-cache.el (nnvirtual-find-group-art):
@ -14753,7 +14753,7 @@
* nnmail.el (gnus-activate-group, gnus-group-mark-article-read):
* nnmaildir.el (gnus-group-mark-article-read):
* nnrss.el (w3-parse-buffer, gnus-group-make-rss-group):
* rfc1843.el (message-fetch-field):
* gnus-rfc1843.el (message-fetch-field):
* spam.el (gnus-extract-address-components):
Declare as functions.
@ -19139,7 +19139,7 @@
(mml-insert-parameter): Fold lines properly even if a parameter is
segmented into two or more lines; change the max column to 76.
* rfc1843.el (rfc1843-decode-article-body): Don't use
* gnus-rfc1843.el (rfc1843-decode-article-body): Don't use
ignore-errors when calling mail-header-parse-content-type.
* rfc2231.el (rfc2231-parse-string): Return at least type if
@ -20525,7 +20525,7 @@
* mml1991.el (mc-pgp-always-sign):
* mml2015.el (mc-pgp-always-sign):
* nnheader.el (nnmail-extra-headers):
* rfc1843.el (gnus-decode-encoded-word-function)
* gnus-rfc1843.el (gnus-decode-encoded-word-function)
(gnus-decode-header-function, gnus-newsgroup-name):
* spam-stat.el (gnus-original-article-buffer): Add defvars.

115
lisp/ldefs-boot.el
View file

@ -13080,23 +13080,7 @@ to get the effect of a C-q.
;;; Generated autoloads from progmodes/flymake.el
(push (purecopy '(flymake 0 3)) package--builtin-versions)
;;;***
;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/flymake-proc.el
(push (purecopy '(flymake-proc 0 3)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-")))
;;;***
;;;### (autoloads nil "flymake-ui" "progmodes/flymake-ui.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from progmodes/flymake-ui.el
(push (purecopy '(flymake-ui 0 3)) package--builtin-versions)
(autoload 'flymake-mode "flymake-ui" "\
(autoload 'flymake-mode "flymake" "\
Toggle Flymake mode on or off.
With a prefix argument ARG, enable Flymake mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
@ -13105,22 +13089,22 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
\(fn &optional ARG)" t nil)
(autoload 'flymake-mode-on "flymake-ui" "\
(autoload 'flymake-mode-on "flymake" "\
Turn flymake mode on.
\(fn)" nil nil)
(autoload 'flymake-mode-off "flymake-ui" "\
(autoload 'flymake-mode-off "flymake" "\
Turn flymake mode off.
\(fn)" nil nil)
(autoload 'flymake-find-file-hook "flymake-ui" "\
(autoload 'flymake-find-file-hook "flymake" "\
\(fn)" nil nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-ui" '("flymake-")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-")))
;;;***
@ -33735,7 +33719,7 @@ Return a string giving the duration of the Emacs initialization.
\(fn)" t nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "zoneinfo-style-world-list")))
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "time--display-world-list" "legacy-style-world-list" "zoneinfo-style-world-list")))
;;;***
@ -34451,7 +34435,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions)
(push (purecopy '(tramp 2 3 3 26 1)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))
@ -38524,53 +38508,44 @@ Zone out, completely.
;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el"
;;;;;; "font-lock.el" "format.el" "frame.el" "help.el" "hfy-cmap.el"
;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charprop.el"
;;;;;; "international/charscript.el" "international/cp51932.el"
;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el"
;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el"
;;;;;; "international/uni-brackets.el" "international/uni-category.el"
;;;;;; "international/uni-combining.el" "international/uni-comment.el"
;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el"
;;;;;; "international/uni-digit.el" "international/uni-lowercase.el"
;;;;;; "international/uni-mirrored.el" "international/uni-name.el"
;;;;;; "international/uni-numeric.el" "international/uni-old-name.el"
;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el"
;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el"
;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el"
;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el"
;;;;;; "language/european.el" "language/georgian.el" "language/greek.el"
;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el"
;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el"
;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el"
;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el"
;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el"
;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el"
;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el"
;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el"
;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el"
;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el"
;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el"
;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el"
;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el"
;;;;;; "leim/quail/czech.el" "leim/quail/georgian.el" "leim/quail/greek.el"
;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el"
;;;;;; "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el"
;;;;;; "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" "leim/quail/latin-pre.el"
;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el"
;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sgml-input.el"
;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el"
;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el"
;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el"
;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el"
;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el"
;;;;;; "obarray.el" "org/ob-core.el" "org/ob-keys.el" "org/ob-lob.el"
;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/org-archive.el"
;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-clock.el"
;;;;;; "org/org-datetree.el" "org/org-element.el" "org/org-feed.el"
;;;;;; "org/org-footnote.el" "org/org-id.el" "org/org-indent.el"
;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charscript.el"
;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el"
;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el"
;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el"
;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el"
;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el"
;;;;;; "language/indian.el" "language/japanese.el" "language/khmer.el"
;;;;;; "language/korean.el" "language/lao.el" "language/misc-lang.el"
;;;;;; "language/romanian.el" "language/sinhala.el" "language/slovak.el"
;;;;;; "language/tai-viet.el" "language/thai.el" "language/tibetan.el"
;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el"
;;;;;; "leim/ja-dic/ja-dic.el" "leim/leim-list.el" "leim/quail/4Corner.el"
;;;;;; "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el"
;;;;;; "leim/quail/CTLau.el" "leim/quail/ECDICT.el" "leim/quail/ETZY.el"
;;;;;; "leim/quail/PY-b5.el" "leim/quail/PY.el" "leim/quail/Punct-b5.el"
;;;;;; "leim/quail/Punct.el" "leim/quail/QJ-b5.el" "leim/quail/QJ.el"
;;;;;; "leim/quail/SW.el" "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el"
;;;;;; "leim/quail/ZOZY.el" "leim/quail/arabic.el" "leim/quail/croatian.el"
;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el"
;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el"
;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el"
;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el"
;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el"
;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el"
;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" "leim/quail/quick-cns.el"
;;;;;; "leim/quail/rfc1345.el" "leim/quail/sgml-input.el" "leim/quail/slovak.el"
;;;;;; "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el"
;;;;;; "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" "leim/quail/vnvni.el"
;;;;;; "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" "mail/rmailedit.el"
;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el"
;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-keys.el"
;;;;;; "org/ob-lob.el" "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el"
;;;;;; "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el"
;;;;;; "org/org-clock.el" "org/org-datetree.el" "org/org-element.el"
;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-id.el" "org/org-indent.el"
;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-mobile.el"
;;;;;; "org/org-plot.el" "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el"
;;;;;; "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el"

27
lisp/net/shr.el
View file

@ -470,6 +470,18 @@ size, and full-buffer size."
(shr-insert sub)
(shr-descend sub))))
(defun shr-indirect-call (tag-name dom &rest args)
(let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray))
;; Allow other packages to override (or provide) rendering
;; of elements.
(external (cdr (assq tag-name shr-external-rendering-functions))))
(cond (external
(apply external dom args))
((fboundp function)
(apply function dom args))
(t
(apply 'shr-generic dom args)))))
(defun shr-descend (dom)
(let ((function
(intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
@ -490,6 +502,11 @@ size, and full-buffer size."
(setq style nil)))
;; If we have a display:none, then just ignore this part of the DOM.
(unless (equal (cdr (assq 'display shr-stylesheet)) "none")
;; We don't use shr-indirect-call here, since shr-descend is
;; the central bit of shr.el, and should be as fast as
;; possible. Having one more level of indirection with its
;; negative effect on performance is deemed unjustified in
;; this case.
(cond (external
(funcall external dom))
((fboundp function)
@ -1404,7 +1421,7 @@ ones, in case fg and bg are nil."
(when url
(cond
(image
(shr-tag-img dom url)
(shr-indirect-call 'img dom url)
(setq dom nil))
(multimedia
(shr-insert " [multimedia] ")
@ -1469,7 +1486,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(unless url
(setq url (car (shr--extract-best-source dom))))
(if (> (length image) 0)
(shr-tag-img nil image)
(shr-indirect-call 'img nil image)
(shr-insert " [video] "))
(shr-urlify start (shr-expand-url url))))
@ -1964,9 +1981,9 @@ flags that control whether to collect or render objects."
do (setq tag (dom-tag child)) and
unless (memq tag '(comment style))
if (eq tag 'img)
do (shr-tag-img child)
do (shr-indirect-call 'img child)
else if (eq tag 'object)
do (shr-tag-object child)
do (shr-indirect-call 'object child)
else
do (setq recurse t) and
if (eq tag 'tr)
@ -1980,7 +1997,7 @@ flags that control whether to collect or render objects."
do (setq flags nil)
else if (car flags)
do (setq recurse nil)
(shr-tag-table child)
(shr-indirect-call 'table child)
end end end end end end end end end end
when recurse
append (shr-collect-extra-strings-in-table child flags)))

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

@ -139,6 +139,7 @@ It is used for TCP/IP devices."
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . ignore)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-adb-handle-file-system-info)
(file-truename . tramp-adb-handle-file-truename)
(file-writable-p . tramp-adb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@ -255,6 +256,30 @@ pass to the OPERATION."
(file-attributes (file-truename filename)))
t))
(defun tramp-adb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-message v 5 "file system info: %s" localname)
(tramp-adb-send-command
v (format "df -k %s" (tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(forward-line)
(when (looking-at
(concat "[[:space:]]*[^[:space:]]+"
"[[:space:]]+\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
(list (* 1024 (string-to-number (concat (match-string 1) "e0")))
;; The second value is the used size. We need the
;; free size.
(* 1024 (- (string-to-number (concat (match-string 1) "e0"))
(string-to-number (concat (match-string 2) "e0"))))
(* 1024 (string-to-number (concat (match-string 3) "e0")))))))))
;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
;; code could be shared?
(defun tramp-adb-handle-file-truename (filename)

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

@ -448,6 +448,18 @@ Every entry is a list (NAME ADDRESS).")
":[[:blank:]]+\\(.*\\)$")
"Regexp to parse GVFS file attributes with `gvfs-info'.")
(defconst tramp-gvfs-file-system-attributes
'("filesystem::free"
"filesystem::size"
"filesystem::used")
"GVFS file system attributes.")
(defconst tramp-gvfs-file-system-attributes-regexp
(concat "^[[:blank:]]*"
(regexp-opt tramp-gvfs-file-system-attributes t)
":[[:blank:]]+\\(.*\\)$")
"Regexp to parse GVFS file system attributes with `gvfs-info'.")
;; New handlers should be added here.
;;;###tramp-autoload
@ -494,6 +506,7 @@ Every entry is a list (NAME ADDRESS).")
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . ignore)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-gvfs-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-gvfs-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@ -825,7 +838,7 @@ file names."
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name directory nil
(with-tramp-file-property v localname "directory-gvfs-attributes"
(with-tramp-file-property v localname "directory-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
@ -860,23 +873,34 @@ file names."
(forward-line)))
result)))))
(defun tramp-gvfs-get-root-attributes (filename)
"Return GVFS attributes association list of FILENAME."
(defun tramp-gvfs-get-root-attributes (filename &optional file-system)
"Return GVFS attributes association list of FILENAME.
If FILE-SYSTEM is non-nil, return file system attributes."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-gvfs-attributes"
(tramp-message v 5 "file gvfs attributes: %s" localname)
(with-tramp-file-property
v localname
(if file-system "file-system-attributes" "file-attributes")
(tramp-message
v 5 "file%s gvfs attributes: %s"
(if file-system " system" "") localname)
;; Send command.
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename))
(if file-system
(tramp-gvfs-send-command
v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename)))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (re-search-forward
tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
(if file-system
tramp-gvfs-file-system-attributes-regexp
tramp-gvfs-file-attributes-with-gvfs-info-regexp)
nil t)
(push (cons (match-string 1) (match-string 2)) result))
result))))))
@ -1127,6 +1151,22 @@ file-notify events."
(with-tramp-file-property v localname "file-readable-p"
(tramp-check-cached-permissions v ?r))))
(defun tramp-gvfs-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
;; We don't use cached values.
(tramp-set-file-property v localname "file-system-attributes" 'undef)
(let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system))
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
(when (and (stringp size) (stringp used) (stringp free))
(list (string-to-number (concat size "e0"))
(- (string-to-number (concat size "e0"))
(string-to-number (concat used "e0")))
(string-to-number (concat free "e0")))))))
(defun tramp-gvfs-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil

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

@ -1020,6 +1020,7 @@ of command line.")
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-sh-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-sh-handle-file-system-info)
(file-truename . tramp-sh-handle-file-truename)
(file-writable-p . tramp-sh-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@ -2739,6 +2740,17 @@ The method used must be an out-of-band method."
beg 'noerror)
(replace-match (file-relative-name filename) t))
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
(when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
(let ((available (get-free-disk-space ".")))
(when available
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
(insert " available " available))))
(goto-char (point-max)))))))
;; Canonicalization of file names.
@ -3701,6 +3713,30 @@ file-notify events."
'file-notify-handle-event
`(file-notify ,object file-notify-callback)))))))
(defun tramp-sh-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
(with-parsed-tramp-file-name (expand-file-name filename) nil
(when (tramp-get-remote-df v)
(tramp-message v 5 "file system info: %s" localname)
(tramp-send-command
v (format
"%s --block-size=1 --output=size,used,avail %s"
(tramp-get-remote-df v) (tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(forward-line)
(when (looking-at
(concat "[[:space:]]*\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"))
(list (string-to-number (concat (match-string 1) "e0"))
;; The second value is the used size. We need the
;; free size.
(- (string-to-number (concat (match-string 1) "e0"))
(string-to-number (concat (match-string 2) "e0")))
(string-to-number (concat (match-string 3) "e0")))))))))
;;; Internal Functions:
(defun tramp-maybe-send-script (vec script name)
@ -5404,6 +5440,17 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(delete-file tmpfile))
result)))
(defun tramp-get-remote-df (vec)
"Determine remote `df' command."
(with-tramp-connection-property vec "df"
(tramp-message vec 5 "Finding a suitable `df' command")
(let ((result (tramp-find-executable vec "df" (tramp-get-remote-path vec))))
(and
result
(tramp-send-command-and-check
vec (format "%s --block-size=1 --output=size,used,avail /" result))
result))))
(defun tramp-get-remote-gvfs-monitor-dir (vec)
"Determine remote `gvfs-monitor-dir' command."
(with-tramp-connection-property vec "gvfs-monitor-dir"

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

@ -255,6 +255,7 @@ See `tramp-actions-before-shell' for more info.")
(file-remote-p . tramp-handle-file-remote-p)
;; `file-selinux-context' performed by default handler.
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-smb-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-smb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@ -954,6 +955,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(nth 0 x))))
(tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
(unless (file-directory-p filename)
(setq filename (file-name-directory filename)))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
(forward-line)
(when (looking-at
(concat "[[:space:]]*\\([[:digit:]]+\\)"
" blocks of size \\([[:digit:]]+\\)"
"\\. \\([[:digit:]]+\\) blocks available"))
(setq blocksize (string-to-number (concat (match-string 2) "e0"))
total (* blocksize
(string-to-number (concat (match-string 1) "e0")))
avail (* blocksize
(string-to-number (concat (match-string 3) "e0")))))
(forward-line)
(when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
;; The used number of bytes is not part of the result. As
;; side effect, we store it as file property.
(tramp-set-file-property
v localname "used-bytes"
(string-to-number (concat (match-string 1) "e0"))))
;; Result.
(when (and total avail)
(list total (- total avail) avail)))))))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
@ -984,7 +1017,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; We should not destroy the cache entry.
(entries (copy-sequence
(tramp-smb-get-file-entries
(file-name-directory filename)))))
(file-name-directory filename))))
(avail (get-free-disk-space filename))
;; `get-free-disk-space' calls `file-system-info', which
;; sets file property "used-bytes" as side effect.
(used
(format
"%.0f"
(/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
(when wildcard
(string-match "\\." base)
@ -1032,6 +1072,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar x (concat (car x) "*"))))))
entries))
;; Insert size information.
(insert
(if avail
(format "total used in directory %s available %s\n" used avail)
(format "total %s\n" used)))
;; Print entries.
(mapc
(lambda (x)

20
lisp/net/tramp.el
View file

@ -1269,14 +1269,14 @@ entry does not exist, return nil."
;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(save-match-data
(and (stringp name)
;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
(not (string-match
(if (memq system-type '(cygwin windows-nt))
"^/[[:alpha:]]?:" "^/:")
name))
(string-match tramp-file-name-regexp name))))
(and (stringp name)
;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
(not (string-match-p
(if (memq system-type '(cygwin windows-nt))
"^/[[:alpha:]]?:" "^/:")
name))
(string-match-p tramp-file-name-regexp name)
t))
(defun tramp-find-method (method user host)
"Return the right method string to use.
@ -2079,7 +2079,9 @@ ARGS are the arguments OPERATION has been called with."
substitute-in-file-name unhandled-file-name-directory
vc-registered
;; Emacs 26+ only.
file-name-case-insensitive-p))
file-name-case-insensitive-p
;; Emacs 27+ only.
file-system-info))
(if (file-name-absolute-p (nth 0 args))
(nth 0 args)
default-directory))

2
lisp/org/ob-hledger.el
View file

@ -1,4 +1,4 @@
;; ob-ledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.

14
lisp/org/ob-lob.el
View file

@ -53,11 +53,15 @@ should not be inherited from a source block.")
(let* ((info (org-babel-get-src-block-info 'light))
(source-name (nth 4 info)))
(when source-name
(setq source-name (intern source-name)
org-babel-library-of-babel
(cons (cons source-name info)
(assq-delete-all source-name org-babel-library-of-babel))
lob-ingest-count (1+ lob-ingest-count)))))
(setf (nth 1 info)
(if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references info)
(nth 1 info)))
(let ((source (intern source-name)))
(setq org-babel-library-of-babel
(cons (cons source info)
(assq-delete-all source org-babel-library-of-babel))))
(cl-incf lob-ingest-count))))
(message "%d src block%s added to Library of Babel"
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))

1
lisp/org/org-clock.el
View file

@ -2984,6 +2984,7 @@ The details of what will be saved are regulated by the variable
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; coding: utf-8
;; End:
;;; org-clock.el ends here

3
lisp/org/org-colview.el
View file

@ -464,7 +464,8 @@ for the duration of the command.")
(kill-local-variable 'org-previous-header-line-format)
(remove-hook 'post-command-hook 'org-columns-hscroll-title 'local))
(set-marker org-columns-begin-marker nil)
(set-marker org-columns-top-level-marker nil)
(when (markerp org-columns-top-level-marker)
(set-marker org-columns-top-level-marker nil))
(org-with-silent-modifications
(mapc #'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)

8
lisp/org/org-table.el
View file

@ -1646,12 +1646,14 @@ In particular, this does handle wide and invisible characters."
(if (not (org-at-table-p))
(user-error "Not at a table"))
(let ((col (current-column))
(dline (org-table-current-dline)))
(dline (and (not (org-match-line org-table-hline-regexp))
(org-table-current-dline))))
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
(if (not (org-at-table-p)) (beginning-of-line 0))
(org-move-to-column col)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(when (and dline
(or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? ")))
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline))))

4
lisp/org/org-version.el
View file

@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
(let ((org-release "9.1.1"))
(let ((org-release "9.1.2"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
Inserted by installing Org or when a release is made."
(let ((org-git-version "release_9.1.1-37-gb1e8b5"))
(let ((org-git-version "release_9.1.2-40-g6ca906"))
org-git-version))
(provide 'org-version)

28
lisp/org/org.el
View file

@ -16071,7 +16071,9 @@ automatically performed, such drawers will be silently ignored."
(when (memq (org-element-type element) '(keyword node-property))
(let ((value (org-element-property :value element))
(start 0))
(while (string-match "%[0-9]*\\(\\S-+\\)" value start)
(while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\
\\(?:{[^}]+}\\)?"
value start)
(setq start (match-end 0))
(let ((p (match-string-no-properties 1 value)))
(unless (member-ignore-case p org-special-properties)
@ -19481,7 +19483,6 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
(org-defkey org-mode-map [(meta return)] 'org-meta-return)
(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
;; Cursor keys with modifiers
@ -24204,16 +24205,25 @@ convenience:
- On an affiliated keyword, jump to the first one.
- On a table or a property drawer, move to its beginning.
- On a verse or source block, stop before blank lines."
- On comment, example, export, src and verse blocks, stop
before blank lines."
(interactive)
(unless (bobp)
(let* ((deactivate-mark nil)
(element (org-element-at-point))
(type (org-element-type element))
(contents-begin (org-element-property :contents-begin element))
(contents-end (org-element-property :contents-end element))
(post-affiliated (org-element-property :post-affiliated element))
(begin (org-element-property :begin element)))
(begin (org-element-property :begin element))
(special? ;blocks handled specially
(memq type '(comment-block example-block export-block src-block
verse-block)))
(contents-begin
(if special?
;; These types have no proper contents. Fake line
;; below the block opening line as contents beginning.
(save-excursion (goto-char begin) (line-beginning-position 2))
(org-element-property :contents-begin element))))
(cond
((not element) (goto-char (point-min)))
((= (point) begin)
@ -24224,11 +24234,8 @@ convenience:
(goto-char (org-element-property
:post-affiliated (org-element-property :parent element))))
((memq type '(property-drawer table)) (goto-char begin))
((memq type '(src-block verse-block))
(when (eq type 'src-block)
(setq contents-begin
(save-excursion (goto-char begin) (forward-line) (point))))
(if (= (point) contents-begin) (goto-char post-affiliated)
(special?
(if (<= (point) contents-begin) (goto-char post-affiliated)
;; Inside a verse block, see blank lines as paragraph
;; separators.
(let ((origin (point)))
@ -24237,7 +24244,6 @@ convenience:
(skip-chars-forward " \r\t\n" origin)
(if (= (point) origin) (goto-char contents-begin)
(beginning-of-line))))))
((not contents-begin) (goto-char (or post-affiliated begin)))
((eq type 'paragraph)
(goto-char contents-begin)
;; When at first paragraph in an item or a footnote definition,

23
lisp/org/ox-html.el
View file

@ -174,7 +174,6 @@
(:html-klipsify-src nil nil org-html-klipsify-src)
(:html-klipse-css nil nil org-html-klipse-css)
(:html-klipse-js nil nil org-html-klipse-js)
(:html-klipse-keep-old-src nil nil org-html-keep-old-src)
(:html-klipse-selection-script nil nil org-html-klipse-selection-script)
(:infojs-opt "INFOJS_OPT" nil nil)
;; Redefine regular options.
@ -1572,12 +1571,6 @@ https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag"
:package-version '(Org . "9.1")
:type 'string)
(defcustom org-html-keep-old-src nil
"When non-nil, use <pre class=\"\"> instead of <pre><code class=\"\">."
:group 'org-export-html
:package-version '(Org . "9.1")
:type 'boolean)
;;;; Todos
@ -3402,12 +3395,16 @@ contextual information."
listing-number
(org-trim (org-export-data caption info))))))
;; Contents.
(let ((open (if org-html-keep-old-src "<pre" "<pre><code"))
(close (if org-html-keep-old-src "</pre>" "</code></pre>")))
(format "%s class=\"src src-%s\"%s%s>%s%s"
open lang label (if (and klipsify (string= lang "html"))
" data-editor-type=\"html\"" "")
code close)))))))
(if klipsify
(format "<pre><code class=\"src src-%s\"%s%s>%s</code></pre>"
lang
label
(if (string= lang "html")
" data-editor-type=\"html\""
"")
code)
(format "<pre class=\"src src-%s\"%s>%s</pre>"
lang label code)))))))
;;;; Statistics Cookie

4
lisp/org/ox-publish.el
View file

@ -435,8 +435,8 @@ This splices all the components into the list."
(let* ((base-dir (file-name-as-directory
(org-publish-property :base-directory project)))
(extension (or (org-publish-property :base-extension project) "org"))
(match (and (not (eq extension 'any))
(concat "^[^\\.].*\\.\\(" extension "\\)$")))
(match (if (eq extension 'any) ""
(format "^[^\\.].*\\.\\(%s\\)$" extension)))
(base-files
(cl-remove-if #'file-directory-p
(if (org-publish-property :recursive project)

54
lisp/progmodes/cc-engine.el
View file

@ -132,7 +132,7 @@
;;
;; 'c-not-decl
;; Put on the brace which introduces a brace list and on the commas
;; which separate the element within it.
;; which separate the elements within it.
;;
;; 'c-awk-NL-prop
;; Used in AWK mode to mark the various kinds of newlines. See
@ -5403,15 +5403,14 @@ comment at the start of cc-engine.el for more info."
(min c-bs-cache-limit pos)))
(defun c-update-brace-stack (stack from to)
;; Give a brace-stack which has the value STACK at position FROM, update it
;; to it's value at position TO, where TO is after (or equal to) FROM.
;; Given a brace-stack which has the value STACK at position FROM, update it
;; to its value at position TO, where TO is after (or equal to) FROM.
;; Return a cons of either TO (if it is outside a literal) and this new
;; value, or of the next position after TO outside a literal and the new
;; value.
(let (match kwd-sym (prev-match-pos 1)
(s (cdr stack))
(bound-<> (car stack))
)
(bound-<> (car stack)))
(save-excursion
(cond
((and bound-<> (<= to bound-<>))
@ -5472,6 +5471,9 @@ comment at the start of cc-engine.el for more info."
(setq s (cdr s))))
((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
(push 0 s))))
;; The failing `c-syntactic-re-search-forward' may have left us in the
;; middle of a token, which might be a significant token. Fix this!
(c-beginning-of-current-token)
(cons (point)
(cons bound-<> s)))))
@ -5647,11 +5649,13 @@ comment at the start of cc-engine.el for more info."
;; Call CFD-FUN for each possible spot for a declaration, cast or
;; label from the point to CFD-LIMIT.
;;
;; CFD-FUN is called with point at the start of the spot. It's passed two
;; CFD-FUN is called with point at the start of the spot. It's passed three
;; arguments: The first is the end position of the token preceding the spot,
;; or 0 for the implicit match at bob. The second is a flag that is t when
;; the match is inside a macro. Point should be moved forward by at least
;; one token.
;; the match is inside a macro. The third is a flag that is t when the
;; match is at "top level", i.e. outside any brace block, or directly inside
;; a class or namespace, etc. Point should be moved forward by at least one
;; token.
;;
;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot,
;; it should return non-nil to ensure that the next search will find them.
@ -6038,6 +6042,8 @@ comment at the start of cc-engine.el for more info."
(setq cfd-macro-end 0)
nil)))) ; end of when condition
(when (> cfd-macro-end 0)
(setq cfd-top-level nil)) ; In a macro is "never" at top level.
(c-debug-put-decl-spot-faces cfd-match-pos (point))
(if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0) cfd-top-level)
(setq cfd-prop-match nil))
@ -8575,7 +8581,13 @@ comment at the start of cc-engine.el for more info."
(looking-at c-noise-macro-with-parens-name-re))
(c-forward-noise-clause))
((looking-at c-type-decl-suffix-key)
((and (looking-at c-type-decl-suffix-key)
;; We avoid recognizing foo(bar) or foo() at top level as a
;; construct here in C, since we want to recognize this as a
;; typeless function declaration.
(not (and (c-major-mode-is 'c-mode)
(eq context 'top)
(eq (char-after) ?\)))))
(if (eq (char-after) ?\))
(when (> paren-depth 0)
(setq paren-depth (1- paren-depth))
@ -8618,7 +8630,12 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char after-paren-pos)
(c-forward-syntactic-ws)
(c-forward-type)))))
(or (c-forward-type)
;; Recognize a top-level typeless
;; function declaration in C.
(and (c-major-mode-is 'c-mode)
(eq context 'top)
(eq (char-after) ?\))))))))
(setq pos (c-up-list-forward (point)))
(eq (char-before pos) ?\)))
(c-fdoc-shift-type-backward)
@ -9035,9 +9052,12 @@ comment at the start of cc-engine.el for more info."
;; (in at least C++) that anything that can be parsed as a declaration
;; is a declaration. Now we're being more defensive and prefer to
;; highlight things like "foo (bar);" as a declaration only if we're
;; inside an arglist that contains declarations.
;; CASE 19
(eq context 'decl))))
;; inside an arglist that contains declarations. Update (2017-09): We
;; now recognize a top-level "foo(bar);" as a declaration in C.
;; CASE 19
(or (eq context 'decl)
(and (c-major-mode-is 'c-mode)
(eq context 'top))))))
;; The point is now after the type decl expression.
@ -9545,6 +9565,7 @@ Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
;; Note to maintainers: this function consumes a great mass of CPU cycles.
;; Its use should thus be minimized as far as possible.
;; Consider instead using `c-bs-at-toplevel-p'.
(let ((paren-state (c-parse-state)))
(or (not (c-most-enclosing-brace paren-state))
(c-search-uplist-for-classkey paren-state))))
@ -9574,8 +9595,15 @@ comment at the start of cc-engine.el for more info."
(not (and (c-major-mode-is 'objc-mode)
(c-forward-objc-directive)))
;; Don't confuse #if .... defined(foo) for a function arglist.
(not (and (looking-at c-cpp-expr-functions-key)
(save-excursion
(save-restriction
(widen)
(c-beginning-of-macro lim)))))
(setq id-start
(car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)))
(numberp id-start)
(< id-start beg)
;; There should not be a '=' or ',' between beg and the

5
lisp/progmodes/cc-langs.el
View file

@ -952,6 +952,11 @@ expression, or nil if there aren't any in the language."
'("defined"))
pike '("defined" "efun" "constant"))
(c-lang-defconst c-cpp-expr-functions-key
;; Matches a function in a cpp expression.
t (c-make-keywords-re t (c-lang-const c-cpp-expr-functions)))
(c-lang-defvar c-cpp-expr-functions-key (c-lang-const c-cpp-expr-functions-key))
(c-lang-defconst c-assignment-operators
"List of all assignment operators."
t '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|=")

4
lisp/progmodes/cc-mode.el
View file

@ -1571,6 +1571,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(and (c-beginning-of-macro)
(progn (c-end-of-macro) (point))))))
(when (and (c-forward-declarator lim)
(or (not (eq (char-after) ?\())
(c-go-list-forward nil lim))
(eq (c-forward-token-2 1 nil lim) 0))
(c-backward-syntactic-ws)
(point))))))
@ -1589,7 +1591,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
(or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
c-new-END
(or (c-fl-decl-end c-new-END)
(c-point 'bonl (max (1- c-new-END) (point-min)))))))
(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

171
lisp/progmodes/elisp-mode.el
View file

@ -243,7 +243,9 @@ Blank lines separate paragraphs. Semicolons start comments.
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local))
#'elisp-completion-at-point nil 'local)
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t))
;; Font-locking support.
@ -810,7 +812,7 @@ non-nil result supercedes the xrefs produced by
(apply #'nconc
(let (lst)
(dolist (sym (apropos-internal regexp))
(push (elisp--xref-find-definitions sym) lst))
(push (elisp--xref-find-definitions sym) lst))
(nreverse lst))))
(defvar elisp--xref-identifier-completion-table
@ -1109,7 +1111,7 @@ If CHAR is not a character, return nil."
;; interactive call would use it.
;; FIXME: Is it really the right place for this?
(when (eq (car-safe expr) 'interactive)
(setq expr
(setq expr
`(call-interactively
(lambda (&rest args) ,expr args))))
expr)))))
@ -1174,7 +1176,7 @@ POS specifies the starting position where EXP was found and defaults to point."
(and (not (special-variable-p var))
(save-excursion
(zerop (car (syntax-ppss (match-beginning 0)))))
(push var vars))))
(push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
(defun eval-last-sexp (eval-last-sexp-arg-internal)
@ -1379,7 +1381,7 @@ or elsewhere, return a 1-line docstring."
(t (help-function-arglist sym)))))
;; Stringify, and store before highlighting, downcasing, etc.
(elisp--last-data-store sym (elisp-function-argstring args)
'function))))))
'function))))))
;; Highlight, truncate.
(if argstring
(elisp--highlight-function-argument
@ -1588,5 +1590,164 @@ ARGLIST is either a string, or a list of strings or symbols."
(replace-match "(" t t str)
str)))
;;; Flymake support
;; Don't require checkdoc, but forward declare these checkdoc special
;; variables. Autoloading them on `checkdoc-current-buffer' is too
;; late, they won't be bound dynamically.
(defvar checkdoc-create-error-function)
(defvar checkdoc-autofix-flag)
(defvar checkdoc-generate-compile-warnings-flag)
(defvar checkdoc-diagnostic-buffer)
(defun elisp-flymake--checkdoc-1 ()
"Do actual work for `elisp-flymake-checkdoc'."
(let (collected)
(let* ((checkdoc-create-error-function
(lambda (text start end &optional unfixable)
(push (list text start end unfixable) collected)
nil))
(checkdoc-autofix-flag nil)
(checkdoc-generate-compile-warnings-flag nil)
(buf (generate-new-buffer " *checkdoc-temp*"))
(checkdoc-diagnostic-buffer buf))
(unwind-protect
(save-excursion
(checkdoc-current-buffer t))
(kill-buffer buf)))
collected))
;;;###autoload
(defun elisp-flymake-checkdoc (report-fn &rest _args)
"A Flymake backend for `checkdoc'.
Calls REPORT-FN directly."
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(funcall report-fn
(cl-loop for (text start end _unfixable) in
(elisp-flymake--checkdoc-1)
collect
(flymake-make-diagnostic
(current-buffer)
start end :note text))))
(defun elisp-flymake--byte-compile-done (report-fn
origin-buffer
output-buffer
temp-file)
(unwind-protect
(with-current-buffer
origin-buffer
(save-excursion
(save-restriction
(widen)
(funcall
report-fn
(cl-loop with data =
(with-current-buffer output-buffer
(goto-char (point-min))
(search-forward ":elisp-flymake-output-start")
(read (point-marker)))
for (string pos _fill level) in data
do (goto-char pos)
for beg = (if (< (point) (point-max))
(point)
(line-beginning-position))
for end = (min
(line-end-position)
(or (cdr
(bounds-of-thing-at-point 'sexp))
(point-max)))
collect (flymake-make-diagnostic
(current-buffer)
(if (= beg end) (1- beg) beg)
end
level
string))))))
(kill-buffer output-buffer)
(ignore-errors (delete-file temp-file))))
(defvar-local elisp-flymake--byte-compile-process nil
"Buffer-local process started for byte-compiling the buffer.")
;;;###autoload
(defun elisp-flymake-byte-compile (report-fn &rest _args)
"A Flymake backend for elisp byte compilation.
Spawn an Emacs process that byte-compiles a file representing the
current buffer state and calls REPORT-FN when done."
(interactive (list (lambda (stuff)
(message "aha %s" stuff))))
(unless (derived-mode-p 'emacs-lisp-mode)
(error "Can only work on `emacs-lisp-mode' buffers"))
(when elisp-flymake--byte-compile-process
(process-put elisp-flymake--byte-compile-process 'elisp-flymake--obsolete t)
(when (process-live-p elisp-flymake--byte-compile-process)
(kill-process elisp-flymake--byte-compile-process)))
(let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
(origin-buffer (current-buffer)))
(save-restriction
(widen)
(write-region (point-min) (point-max) temp-file nil 'nomessage))
(let* ((output-buffer (generate-new-buffer " *elisp-flymake-byte-compile*")))
(setq
elisp-flymake--byte-compile-process
(make-process
:name "elisp-flymake-byte-compile"
:buffer output-buffer
:command (list (expand-file-name invocation-name invocation-directory)
"-Q"
"--batch"
;; "--eval" "(setq load-prefer-newer t)" ; for testing
"-L" default-directory
"-f" "elisp-flymake--batch-compile-for-flymake"
temp-file)
:connection-type 'pipe
:sentinel
(lambda (proc _event)
(unless (process-live-p proc)
(unwind-protect
(cond
((zerop (process-exit-status proc))
(elisp-flymake--byte-compile-done report-fn
origin-buffer
output-buffer
temp-file))
((process-get proc 'elisp-flymake--obsolete)
(flymake-log :warning "byte-compile process %s obsolete" proc))
(t
(funcall report-fn
:panic
:explanation
(format "byte-compile process %s died" proc)))))))))
:stderr null-device
:noquery t)))
(defun elisp-flymake--batch-compile-for-flymake (&optional file)
"Helper for `elisp-flymake-byte-compile'.
Runs in a batch-mode Emacs. Interactively use variable
`buffer-file-name' for FILE."
(interactive (list buffer-file-name))
(let* ((file (or file
(car command-line-args-left)))
(dummy-elc-file)
(byte-compile-log-buffer
(generate-new-buffer " *dummy-byte-compile-log-buffer*"))
(byte-compile-dest-file-function
(lambda (source)
(setq dummy-elc-file (make-temp-file (file-name-nondirectory source)))))
(collected)
(byte-compile-log-warning-function
(lambda (string &optional position fill level)
(push (list string position fill level)
collected)
t)))
(unwind-protect
(byte-compile-file file)
(ignore-errors
(delete-file dummy-elc-file)
(kill-buffer byte-compile-log-buffer)))
(prin1 :elisp-flymake-output-start)
(terpri)
(pp collected)))
(provide 'elisp-mode)
;;; elisp-mode.el ends here

1161
lisp/progmodes/flymake-proc.el
View file

File diff suppressed because it is too large Load diff

634
lisp/progmodes/flymake-ui.el
View file

@ -1,634 +0,0 @@
;;; flymake-ui.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: Leo Liu <sdl.web@gmail.com>
;; Version: 0.3
;; Keywords: c languages tools
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.xo
;;
;; This file contains the UI for displaying and interacting with the
;; results of such checks, as well as entry points for backends to
;; hook on to. Backends are sources of diagnostic info.
;;
;;; Code:
(eval-when-compile (require 'cl-lib))
(defgroup flymake nil
"Universal on-the-fly syntax checker."
:version "23.1"
:link '(custom-manual "(flymake) Top")
:group 'tools)
(defcustom flymake-error-bitmap '(exclamation-mark error)
"Bitmap (a symbol) used in the fringe for indicating errors.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
:group 'flymake
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
(defcustom flymake-warning-bitmap 'question-mark
"Bitmap (a symbol) used in the fringe for indicating warnings.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
:group 'flymake
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
(defcustom flymake-fringe-indicator-position 'left-fringe
"The position to put flymake fringe indicator.
The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
See `flymake-error-bitmap' and `flymake-warning-bitmap'."
:group 'flymake
:version "24.3"
:type '(choice (const left-fringe)
(const right-fringe)
(const :tag "No fringe indicators" nil)))
(defcustom flymake-start-syntax-check-on-newline t
"Start syntax check if newline char was added/removed from the buffer."
:group 'flymake
:type 'boolean)
(defcustom flymake-no-changes-timeout 0.5
"Time to wait after last change before starting compilation."
:group 'flymake
:type 'number)
(defcustom flymake-gui-warnings-enabled t
"Enables/disables GUI warnings."
:group 'flymake
:type 'boolean)
(make-obsolete-variable 'flymake-gui-warnings-enabled
"it no longer has any effect." "26.1")
(defcustom flymake-start-syntax-check-on-find-file t
"Start syntax check on find file."
:group 'flymake
:type 'boolean)
(defcustom flymake-log-level -1
"Logging level, only messages with level lower or equal will be logged.
-1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG"
:group 'flymake
:type 'integer)
(defcustom flymake-backends '()
"Ordered list of backends providing syntax check information for a buffer.
Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE
and CHECKER are functions called with a single argument, the
buffer in which `flymake-mode' was enabled. PREDICATE is expected
to (quickly) return t or nil if the buffer can be syntax checked
by CHECKER, which in can performs more morose operations,
possibly asynchronously."
:group 'flymake
:type 'alist)
(defvar-local flymake-timer nil
"Timer for starting syntax check.")
(defvar-local flymake-last-change-time nil
"Time of last buffer change.")
(defvar-local flymake-check-start-time nil
"Time at which syntax check was started.")
(defvar-local flymake-check-was-interrupted nil
"Non-nil if syntax check was killed by `flymake-compile'.")
(defvar-local flymake-err-info nil
"Sorted list of line numbers and lists of err info in the form (file, err-text).")
(defvar-local flymake-new-err-info nil
"Same as `flymake-err-info', effective when a syntax check is in progress.")
(defun flymake-log (level text &rest args)
"Log a message at level LEVEL.
If LEVEL is higher than `flymake-log-level', the message is
ignored. Otherwise, it is printed using `message'.
TEXT is a format control string, and the remaining arguments ARGS
are the string substitutions (see the function `format')."
(if (<= level flymake-log-level)
(let* ((msg (apply #'format-message text args)))
(message "%s" msg))))
(defun flymake-ins-after (list pos val)
"Insert VAL into LIST after position POS.
POS counts from zero."
(let ((tmp (copy-sequence list)))
(setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
tmp))
(defun flymake-set-at (list pos val)
"Set VAL at position POS in LIST.
POS counts from zero."
(let ((tmp (copy-sequence list)))
(setcar (nthcdr pos tmp) val)
tmp))
(defun flymake-er-make-er (line-no line-err-info-list)
(list line-no line-err-info-list))
(defun flymake-er-get-line (err-info)
(nth 0 err-info))
(defun flymake-er-get-line-err-info-list (err-info)
(nth 1 err-info))
(cl-defstruct (flymake-ler
(:constructor nil)
(:constructor flymake-ler-make-ler (file line type text &optional full-file)))
file line type text full-file)
(defun flymake-ler-set-file (line-err-info file)
(flymake-ler-make-ler file
(flymake-ler-line line-err-info)
(flymake-ler-type line-err-info)
(flymake-ler-text line-err-info)
(flymake-ler-full-file line-err-info)))
(defun flymake-ler-set-full-file (line-err-info full-file)
(flymake-ler-make-ler (flymake-ler-file line-err-info)
(flymake-ler-line line-err-info)
(flymake-ler-type line-err-info)
(flymake-ler-text line-err-info)
full-file))
(defun flymake-ler-set-line (line-err-info line)
(flymake-ler-make-ler (flymake-ler-file line-err-info)
line
(flymake-ler-type line-err-info)
(flymake-ler-text line-err-info)
(flymake-ler-full-file line-err-info)))
(defun flymake-get-line-err-count (line-err-info-list type)
"Return number of errors of specified TYPE.
Value of TYPE is either \"e\" or \"w\"."
(let* ((idx 0)
(count (length line-err-info-list))
(err-count 0))
(while (< idx count)
(when (equal type (flymake-ler-type (nth idx line-err-info-list)))
(setq err-count (1+ err-count)))
(setq idx (1+ idx)))
err-count))
(defun flymake-get-err-count (err-info-list type)
"Return number of errors of specified TYPE for ERR-INFO-LIST."
(let* ((idx 0)
(count (length err-info-list))
(err-count 0))
(while (< idx count)
(setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type)))
(setq idx (1+ idx)))
err-count))
(defun flymake-highlight-err-lines (err-info-list)
"Highlight error lines in BUFFER using info from ERR-INFO-LIST."
(save-excursion
(dolist (err err-info-list)
(flymake-highlight-line (car err) (nth 1 err)))))
(defun flymake-overlay-p (ov)
"Determine whether overlay OV was created by flymake."
(and (overlayp ov) (overlay-get ov 'flymake-overlay)))
(defun flymake-make-overlay (beg end tooltip-text face bitmap)
"Allocate a flymake overlay in range BEG and END."
(when (not (flymake-region-has-flymake-overlays beg end))
(let ((ov (make-overlay beg end nil t))
(fringe (and flymake-fringe-indicator-position
(propertize "!" 'display
(cons flymake-fringe-indicator-position
(if (listp bitmap)
bitmap
(list bitmap)))))))
(overlay-put ov 'face face)
(overlay-put ov 'help-echo tooltip-text)
(overlay-put ov 'flymake-overlay t)
(overlay-put ov 'priority 100)
(overlay-put ov 'evaporate t)
(overlay-put ov 'before-string fringe)
;;+(flymake-log 3 "created overlay %s" ov)
ov)
(flymake-log 3 "created an overlay at (%d-%d)" beg end)))
(defun flymake-delete-own-overlays ()
"Delete all flymake overlays in BUFFER."
(dolist (ol (overlays-in (point-min) (point-max)))
(when (flymake-overlay-p ol)
(delete-overlay ol)
;;+(flymake-log 3 "deleted overlay %s" ol)
)))
(defun flymake-region-has-flymake-overlays (beg end)
"Check if region specified by BEG and END has overlay.
Return t if it has at least one flymake overlay, nil if no overlay."
(let ((ov (overlays-in beg end))
(has-flymake-overlays nil))
(while (consp ov)
(when (flymake-overlay-p (car ov))
(setq has-flymake-overlays t))
(setq ov (cdr ov)))
has-flymake-overlays))
(defface flymake-errline
'((((supports :underline (:style wave)))
:underline (:style wave :color "Red1"))
(t
:inherit error))
"Face used for marking error lines."
:version "24.4"
:group 'flymake)
(defface flymake-warnline
'((((supports :underline (:style wave)))
:underline (:style wave :color "DarkOrange"))
(t
:inherit warning))
"Face used for marking warning lines."
:version "24.4"
:group 'flymake)
(defun flymake-highlight-line (line-no line-err-info-list)
"Highlight line LINE-NO in current buffer.
Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
(goto-char (point-min))
(forward-line (1- line-no))
(pcase-let* ((beg (progn (back-to-indentation) (point)))
(end (progn
(end-of-line)
(skip-chars-backward " \t\f\t\n" beg)
(if (eq (point) beg)
(line-beginning-position 2)
(point))))
(tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n"))
(`(,face ,bitmap)
(if (> (flymake-get-line-err-count line-err-info-list "e") 0)
(list 'flymake-errline flymake-error-bitmap)
(list 'flymake-warnline flymake-warning-bitmap))))
(flymake-make-overlay beg end tooltip-text face bitmap)))
(defun flymake-find-err-info (err-info-list line-no)
"Find (line-err-info-list pos) for specified LINE-NO."
(if err-info-list
(let* ((line-err-info-list nil)
(pos 0)
(count (length err-info-list)))
(while (and (< pos count) (< (car (nth pos err-info-list)) line-no))
(setq pos (1+ pos)))
(when (and (< pos count) (equal (car (nth pos err-info-list)) line-no))
(setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list))))
(list line-err-info-list pos))
'(nil 0)))
(defun flymake-line-err-info-is-less-or-equal (line-one line-two)
(or (string< (flymake-ler-type line-one) (flymake-ler-type line-two))
(and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
(not (flymake-ler-file line-one)) (flymake-ler-file line-two))
(and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
(or (and (flymake-ler-file line-one) (flymake-ler-file line-two))
(and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two)))))))
(defun flymake-add-line-err-info (line-err-info-list line-err-info)
"Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO.
For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'.
The new element is inserted in the proper position, according to
the predicate `flymake-line-err-info-is-less-or-equal'.
The updated value of LINE-ERR-INFO-LIST is returned."
(if (not line-err-info-list)
(list line-err-info)
(let* ((count (length line-err-info-list))
(idx 0))
(while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info))
(setq idx (1+ idx)))
(cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list)))
(t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info))))
line-err-info-list)))
(defun flymake-add-err-info (err-info-list line-err-info)
"Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order.
Returns the updated value of ERR-INFO-LIST.
For the format of ERR-INFO-LIST, see `flymake-err-info'.
For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info)))
(info-and-pos (flymake-find-err-info err-info-list line-no))
(exists (car info-and-pos))
(pos (nth 1 info-and-pos))
(line-err-info-list nil)
(err-info nil))
(if exists
(setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list)))))
(setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info))
(setq err-info (flymake-er-make-er line-no line-err-info-list))
(cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info)))
((equal 0 pos) (setq err-info-list (cons err-info err-info-list)))
(t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info))))
err-info-list))
(defvar-local flymake-is-running nil
"If t, flymake syntax check process is running for the current buffer.")
(defun flymake-on-timer-event (buffer)
"Start a syntax check for buffer BUFFER if necessary."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and (not flymake-is-running)
flymake-last-change-time
(> (- (float-time) flymake-last-change-time)
flymake-no-changes-timeout))
(setq flymake-last-change-time nil)
(flymake-log 3 "starting syntax check as more than 1 second passed since last change")
(flymake--start-syntax-check)))))
(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line
'flymake-popup-current-error-menu "24.4")
(defun flymake-popup-current-error-menu (&optional event)
"Pop up a menu with errors/warnings for current line."
(interactive (list last-nonmenu-event))
(let* ((line-no (line-number-at-pos))
(errors (or (car (flymake-find-err-info flymake-err-info line-no))
(user-error "No errors for current line")))
(menu (mapcar (lambda (x)
(if (flymake-ler-file x)
(cons (format "%s - %s(%d)"
(flymake-ler-text x)
(flymake-ler-file x)
(flymake-ler-line x))
x)
(list (flymake-ler-text x))))
errors))
(event (if (mouse-event-p event)
event
(list 'mouse-1 (posn-at-point))))
(title (format "Line %d: %d error(s), %d warning(s)"
line-no
(flymake-get-line-err-count errors "e")
(flymake-get-line-err-count errors "w")))
(choice (x-popup-menu event (list title (cons "" menu)))))
(flymake-log 3 "choice=%s" choice)
(when choice
(flymake-goto-file-and-line (flymake-ler-full-file choice)
(flymake-ler-line choice)))))
(defun flymake-goto-file-and-line (file line)
"Try to get buffer for FILE and goto line LINE in it."
(if (not (file-exists-p file))
(flymake-log 1 "File %s does not exist" file)
(find-file file)
(goto-char (point-min))
(forward-line (1- line))))
;; flymake minor mode declarations
(defvar-local flymake-mode-line nil)
(defvar-local flymake-mode-line-e-w nil)
(defvar-local flymake-mode-line-status nil)
(defun flymake-report-status (e-w &optional status)
"Show status in mode line."
(when e-w
(setq flymake-mode-line-e-w e-w))
(when status
(setq flymake-mode-line-status status))
(let* ((mode-line " Flymake"))
(when (> (length flymake-mode-line-e-w) 0)
(setq mode-line (concat mode-line ":" flymake-mode-line-e-w)))
(setq mode-line (concat mode-line flymake-mode-line-status))
(setq flymake-mode-line mode-line)
(force-mode-line-update)))
;; Nothing in flymake uses this at all any more, so this is just for
;; third-party compatibility.
(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
(defun flymake-report-fatal-status (status warning)
"Display a warning and switch flymake mode off."
;; This first message was always shown by default, and flymake-log
;; does nothing by default, hence the use of message.
;; Another option is display-warning.
(if (< flymake-log-level 0)
(message "Flymake: %s. Flymake will be switched OFF" warning))
(flymake-mode 0)
(flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s"
(buffer-name) status warning))
(defvar-local flymake--backend nil
"The currently active backend selected by `flymake-mode'")
(defun flymake--can-syntax-check-buffer (buffer)
(let ((all flymake-backends)
(candidate))
(catch 'done
(while (setq candidate (pop all))
(when (with-current-buffer buffer (funcall (car candidate)))
(throw 'done (cdr candidate)))))))
(defun flymake--start-syntax-check ()
(funcall flymake--backend))
;;;###autoload
(define-minor-mode flymake-mode nil
:group 'flymake :lighter flymake-mode-line
(cond
;; Turning the mode ON.
(flymake-mode
(let* ((backend (flymake--can-syntax-check-buffer (current-buffer))))
(cond
((not backend)
(flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)))
(t
(setq flymake--backend backend)
(add-hook 'after-change-functions 'flymake-after-change-function nil t)
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
;;+(add-hook 'find-file-hook 'flymake-find-file-hook)
(flymake-report-status "" "")
(setq flymake-timer
(run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
(when (and flymake-start-syntax-check-on-find-file
;; Since we write temp files in current dir, there's no point
;; trying if the directory is read-only (bug#8954).
(file-writable-p (file-name-directory buffer-file-name)))
(with-demoted-errors
(flymake--start-syntax-check)))))
)
)
;; Turning the mode OFF.
(t
(setq flymake--backend nil)
(remove-hook 'after-change-functions 'flymake-after-change-function t)
(remove-hook 'after-save-hook 'flymake-after-save-hook t)
(remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
(flymake-delete-own-overlays)
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil))
(setq flymake-is-running nil))))
;; disabling flymake-mode is safe, enabling - not necessarily so
(put 'flymake-mode 'safe-local-variable 'null)
;;;###autoload
(defun flymake-mode-on ()
"Turn flymake mode on."
(flymake-mode 1)
(flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name)))
;;;###autoload
(defun flymake-mode-off ()
"Turn flymake mode off."
(flymake-mode 0)
(flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name)))
(defun flymake-after-change-function (start stop _len)
"Start syntax check for current buffer if it isn't already running."
;;+(flymake-log 0 "setting change time to %s" (float-time))
(let((new-text (buffer-substring start stop)))
(when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
(flymake-log 3 "starting syntax check as new-line has been seen")
(flymake--start-syntax-check))
(setq flymake-last-change-time (float-time))))
(defun flymake-after-save-hook ()
(if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved?
(progn
(flymake-log 3 "starting syntax check as buffer was saved")
(flymake--start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???)
(defun flymake-kill-buffer-hook ()
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil)))
;;;###autoload
(defun flymake-find-file-hook ()
;;+(when flymake-start-syntax-check-on-find-file
;;+ (flymake-log 3 "starting syntax check on file open")
;;+ (flymake--start-syntax-check)
;;+)
(when (and (not (local-variable-p 'flymake-mode (current-buffer)))
(flymake--can-syntax-check-buffer (current-buffer)))
(flymake-mode)
(flymake-log 3 "automatically turned ON flymake mode")))
(defun flymake-get-first-err-line-no (err-info-list)
"Return first line with error."
(when err-info-list
(flymake-er-get-line (car err-info-list))))
(defun flymake-get-last-err-line-no (err-info-list)
"Return last line with error."
(when err-info-list
(flymake-er-get-line (nth (1- (length err-info-list)) err-info-list))))
(defun flymake-get-next-err-line-no (err-info-list line-no)
"Return next line with error."
(when err-info-list
(let* ((count (length err-info-list))
(idx 0))
(while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list))))
(setq idx (1+ idx)))
(if (< idx count)
(flymake-er-get-line (nth idx err-info-list))))))
(defun flymake-get-prev-err-line-no (err-info-list line-no)
"Return previous line with error."
(when err-info-list
(let* ((count (length err-info-list)))
(while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list))))
(setq count (1- count)))
(if (> count 0)
(flymake-er-get-line (nth (1- count) err-info-list))))))
(defun flymake-skip-whitespace ()
"Move forward until non-whitespace is reached."
(while (looking-at "[ \t]")
(forward-char)))
(defun flymake-goto-line (line-no)
"Go to line LINE-NO, then skip whitespace."
(goto-char (point-min))
(forward-line (1- line-no))
(flymake-skip-whitespace))
(defun flymake-goto-next-error ()
"Go to next error in err ring."
(interactive)
(let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos))))
(when (not line-no)
(setq line-no (flymake-get-first-err-line-no flymake-err-info))
(flymake-log 1 "passed end of file"))
(if line-no
(flymake-goto-line line-no)
(flymake-log 1 "no errors in current buffer"))))
(defun flymake-goto-prev-error ()
"Go to previous error in err ring."
(interactive)
(let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos))))
(when (not line-no)
(setq line-no (flymake-get-last-err-line-no flymake-err-info))
(flymake-log 1 "passed beginning of file"))
(if line-no
(flymake-goto-line line-no)
(flymake-log 1 "no errors in current buffer"))))
(defun flymake-patch-err-text (string)
(if (string-match "^[\n\t :0-9]*\\(.*\\)$" string)
(match-string 1 string)
string))
(provide 'flymake-ui)
;;; flymake-ui.el ends here

960
lisp/progmodes/flymake.el
View file

@ -1,4 +1,4 @@
;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*-
;;; flymake.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
@ -20,22 +20,964 @@
;; 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 <https://www.gnu.org/licenses/>.
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.
;;
;; It collects diagnostic information for multiple sources and
;; visually annotates the relevant lines in the buffer.
;; Flymake collects diagnostic information for multiple sources,
;; called backends, and visually annotates the relevant portions in
;; the buffer.
;;
;; This file contains the UI for displaying and interacting with the
;; results produced by these backends, as well as entry points for
;; backends to hook on to.
;;
;; The main entry points are `flymake-mode' and `flymake-start'
;;
;; The docstrings of these variables are relevant to understanding how
;; Flymake works for both the user and the backend programmer:
;;
;; * `flymake-diagnostic-functions'
;; * `flymake-diagnostic-types-alist'
;;
;; This file is just a stub for that loads the UI and backends, which
;; could also be loaded separately.
;;; Code:
(require 'flymake-ui)
(require 'flymake-proc)
(require 'cl-lib)
(require 'thingatpt) ; end-of-thing
(require 'warnings) ; warning-numeric-level, display-warning
(require 'compile) ; for some faces
(require 'subr-x) ; when-let*, if-let*, hash-table-keys, hash-table-values
(defgroup flymake nil
"Universal on-the-fly syntax checker."
:version "23.1"
:link '(custom-manual "(flymake) Top")
:group 'tools)
(defcustom flymake-error-bitmap '(flymake-double-exclamation-mark
compilation-error)
"Bitmap (a symbol) used in the fringe for indicating errors.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
(defcustom flymake-warning-bitmap '(exclamation-mark compilation-warning)
"Bitmap (a symbol) used in the fringe for indicating warnings.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
(defcustom flymake-note-bitmap '(exclamation-mark compilation-info)
"Bitmap (a symbol) used in the fringe for indicating info notes.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
:version "26.1"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
(defcustom flymake-fringe-indicator-position 'left-fringe
"The position to put Flymake fringe indicator.
The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
See `flymake-error-bitmap' and `flymake-warning-bitmap'."
:version "24.3"
:type '(choice (const left-fringe)
(const right-fringe)
(const :tag "No fringe indicators" nil)))
(defcustom flymake-start-syntax-check-on-newline t
"Start syntax check if newline char was added/removed from the buffer."
:type 'boolean)
(defcustom flymake-no-changes-timeout 0.5
"Time to wait after last change before automatically checking buffer.
If nil, never start checking buffer automatically like this."
:type 'number)
(defcustom flymake-gui-warnings-enabled t
"Enables/disables GUI warnings."
:type 'boolean)
(make-obsolete-variable 'flymake-gui-warnings-enabled
"it no longer has any effect." "26.1")
(defcustom flymake-start-syntax-check-on-find-file t
"Start syntax check on find file."
:type 'boolean)
(defcustom flymake-log-level -1
"Obsolete and ignored variable."
:type 'integer)
(make-obsolete-variable 'flymake-log-level
"it is superseded by `warning-minimum-log-level.'"
"26.1")
(defcustom flymake-wrap-around t
"If non-nil, moving to errors wraps around buffer boundaries."
:type 'boolean)
(define-fringe-bitmap 'flymake-double-exclamation-mark
(vector #b00000000
#b00000000
#b00000000
#b00000000
#b01100110
#b01100110
#b01100110
#b01100110
#b01100110
#b01100110
#b01100110
#b01100110
#b00000000
#b01100110
#b00000000
#b00000000
#b00000000))
(defvar-local flymake-timer nil
"Timer for starting syntax check.")
(defvar-local flymake-check-start-time nil
"Time at which syntax check was started.")
(defun flymake--log-1 (level sublog msg &rest args)
"Do actual work for `flymake-log'."
(let (;; never popup the log buffer
(warning-minimum-level :emergency)
(warning-type-format
(format " [%s %s]"
(or sublog 'flymake)
(current-buffer))))
(display-warning (list 'flymake sublog)
(apply #'format-message msg args)
(if (numberp level)
(or (nth level
'(:emergency :error :warning :debug :debug) )
:error)
level)
"*Flymake log*")))
(defun flymake-switch-to-log-buffer ()
"Go to the *Flymake log* buffer."
(interactive)
(switch-to-buffer "*Flymake log*"))
;;;###autoload
(defmacro flymake-log (level msg &rest args)
"Log, at level LEVEL, the message MSG formatted with ARGS.
LEVEL is passed to `display-warning', which is used to display
the warning. If this form is included in a byte-compiled file,
the generated warning contains an indication of the file that
generated it."
(let* ((compile-file (and (boundp 'byte-compile-current-file)
(symbol-value 'byte-compile-current-file)))
(sublog (if (and
compile-file
(not load-file-name))
(intern
(file-name-nondirectory
(file-name-sans-extension compile-file))))))
`(flymake--log-1 ,level ',sublog ,msg ,@args)))
(defun flymake-error (text &rest args)
"Format TEXT with ARGS and signal an error for Flymake."
(let ((msg (apply #'format-message text args)))
(flymake-log :error msg)
(error (concat "[Flymake] " msg))))
(cl-defstruct (flymake--diag
(:constructor flymake--diag-make))
buffer beg end type text backend)
;;;###autoload
(defun flymake-make-diagnostic (buffer
beg
end
type
text)
"Make a Flymake diagnostic for BUFFER's region from BEG to END.
TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a
description of the problem detected in this region."
(flymake--diag-make :buffer buffer :beg beg :end end :type type :text text))
(cl-defun flymake--overlays (&key beg end filter compare key)
"Get flymake-related overlays.
If BEG is non-nil and END is nil, consider only `overlays-at'
BEG. Otherwise consider `overlays-in' the region comprised by BEG
and END, defaulting to the whole buffer. Remove all that do not
verify FILTER, a function, and sort them by COMPARE (using KEY)."
(save-restriction
(widen)
(let ((ovs (cl-remove-if-not
(lambda (ov)
(and (overlay-get ov 'flymake)
(or (not filter)
(funcall filter ov))))
(if (and beg (null end))
(overlays-at beg t)
(overlays-in (or beg (point-min))
(or end (point-max)))))))
(if compare
(cl-sort ovs compare :key (or key
#'identity))
ovs))))
(defun flymake-delete-own-overlays (&optional filter)
"Delete all Flymake overlays in BUFFER."
(mapc #'delete-overlay (flymake--overlays :filter filter)))
(defface flymake-error
'((((supports :underline (:style wave)))
:underline (:style wave :color "Red1"))
(t
:inherit error))
"Face used for marking error regions."
:version "24.4")
(defface flymake-warning
'((((supports :underline (:style wave)))
:underline (:style wave :color "deep sky blue"))
(t
:inherit warning))
"Face used for marking warning regions."
:version "24.4")
(defface flymake-note
'((((supports :underline (:style wave)))
:underline (:style wave :color "yellow green"))
(t
:inherit warning))
"Face used for marking note regions."
:version "26.1")
(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1")
(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1")
;;;###autoload
(defun flymake-diag-region (buffer line &optional col)
"Compute BUFFER's region (BEG . END) corresponding to LINE and COL.
If COL is nil, return a region just for LINE. Return nil if the
region is invalid."
(condition-case-unless-debug _err
(with-current-buffer buffer
(let ((line (min (max line 1)
(line-number-at-pos (point-max) 'absolute))))
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(cl-flet ((fallback-bol
() (progn (back-to-indentation) (point)))
(fallback-eol
(beg)
(progn
(end-of-line)
(skip-chars-backward " \t\f\t\n" beg)
(if (eq (point) beg)
(line-beginning-position 2)
(point)))))
(if (and col (cl-plusp col))
(let* ((beg (progn (forward-char (1- col))
(point)))
(sexp-end (ignore-errors (end-of-thing 'sexp)))
(end (or (and sexp-end
(not (= sexp-end beg))
sexp-end)
(ignore-errors (goto-char (1+ beg)))))
(safe-end (or end
(fallback-eol beg))))
(cons (if end beg (fallback-bol))
safe-end))
(let* ((beg (fallback-bol))
(end (fallback-eol beg)))
(cons beg end)))))))
(error (flymake-error "Invalid region line=%s col=%s" line col))))
(defvar flymake-diagnostic-functions nil
"Special hook of Flymake backends that check a buffer.
The functions in this hook diagnose problems in a buffer’s
contents and provide information to the Flymake user interface
about where and how to annotate problems diagnosed in a buffer.
Whenever Flymake or the user decides to re-check the buffer, each
function is called with an arbitrary number of arguments:
* the first argument is always REPORT-FN, a callback function
detailed below;
* the remaining arguments are keyword-value pairs in the
form (:KEY VALUE :KEY2 VALUE2...). Currently, Flymake provides
no such arguments, but backend functions must be prepared to
accept and possibly ignore any number of them.
Backend functions are expected to initiate the buffer check, but
aren't required to complete it check before exiting: if the
computation involved is expensive, especially for large buffers,
that task can be scheduled for the future using asynchronous
processes or other asynchronous mechanisms.
In any case, backend functions are expected to return quickly or
signal an error, in which case the backend is disabled. Flymake
will not try disabled backends again for any future checks of
this buffer. Certain commands, like turning `flymake-mode' off
and on again, reset the list of disabled backends.
If the function returns, Flymake considers the backend to be
\"running\". If it has not done so already, the backend is
expected to call the function REPORT-FN with a single argument
REPORT-ACTION also followed by an optional list of keyword-value
pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...).
Currently accepted values for REPORT-ACTION are:
* A (possibly empty) list of diagnostic objects created with
`flymake-make-diagnostic', causing Flymake to annotate the
buffer with this information.
A backend may call REPORT-FN repeatedly in this manner, but
only until Flymake considers that the most recently requested
buffer check is now obsolete because, say, buffer contents have
changed in the meantime. The backend is only given notice of
this via a renewed call to the backend function. Thus, to
prevent making obsolete reports and wasting resources, backend
functions should first cancel any ongoing processing from
previous calls.
* The symbol `:panic', signaling that the backend has encountered
an exceptional situation and should be disabled.
Currently accepted REPORT-KEY arguments are:
* ‘:explanation’: value should give user-readable details of
the situation encountered, if any.
* ‘:force’: value should be a boolean suggesting that Flymake
consider the report even if it was somehow unexpected.")
(defvar flymake-diagnostic-types-alist
`((:error
. ((flymake-category . flymake-error)))
(:warning
. ((flymake-category . flymake-warning)))
(:note
. ((flymake-category . flymake-note))))
"Alist ((KEY . PROPS)*) of properties of Flymake diagnostic types.
KEY designates a kind of diagnostic can be anything passed as
`:type' to `flymake-make-diagnostic'.
PROPS is an alist of properties that are applied, in order, to
the diagnostics of the type designated by KEY. The recognized
properties are:
* Every property pertaining to overlays, except `category' and
`evaporate' (see Info Node `(elisp)Overlay Properties'), used
to affect the appearance of Flymake annotations.
* `bitmap', an image displayed in the fringe according to
`flymake-fringe-indicator-position'. The value actually
follows the syntax of `flymake-error-bitmap' (which see). It
is overridden by any `before-string' overlay property.
* `severity', a non-negative integer specifying the diagnostic's
severity. The higher, the more serious. If the overlay
priority `priority' is not specified, `severity' is used to set
it and help sort overlapping overlays.
* `flymake-category', a symbol whose property list is considered
as a default for missing values of any other properties. This
is useful to backend authors when creating new diagnostic types
that differ from an existing type by only a few properties.")
(put 'flymake-error 'face 'flymake-error)
(put 'flymake-error 'bitmap 'flymake-error-bitmap)
(put 'flymake-error 'severity (warning-numeric-level :error))
(put 'flymake-error 'mode-line-face 'compilation-error)
(put 'flymake-warning 'face 'flymake-warning)
(put 'flymake-warning 'bitmap 'flymake-warning-bitmap)
(put 'flymake-warning 'severity (warning-numeric-level :warning))
(put 'flymake-warning 'mode-line-face 'compilation-warning)
(put 'flymake-note 'face 'flymake-note)
(put 'flymake-note 'bitmap 'flymake-note-bitmap)
(put 'flymake-note 'severity (warning-numeric-level :debug))
(put 'flymake-note 'mode-line-face 'compilation-info)
(defun flymake--lookup-type-property (type prop &optional default)
"Look up PROP for TYPE in `flymake-diagnostic-types-alist'.
If TYPE doesn't declare PROP in either
`flymake-diagnostic-types-alist' or in the symbol of its
associated `flymake-category' return DEFAULT."
(let ((alist-probe (assoc type flymake-diagnostic-types-alist)))
(cond (alist-probe
(let* ((alist (cdr alist-probe))
(prop-probe (assoc prop alist)))
(if prop-probe
(cdr prop-probe)
(if-let* ((cat (assoc-default 'flymake-category alist))
(plist (and (symbolp cat)
(symbol-plist cat)))
(cat-probe (plist-member plist prop)))
(cadr cat-probe)
default))))
(t
default))))
(defun flymake--fringe-overlay-spec (bitmap &optional recursed)
(if (and (symbolp bitmap)
(boundp bitmap)
(not recursed))
(flymake--fringe-overlay-spec
(symbol-value bitmap) t)
(and flymake-fringe-indicator-position
bitmap
(propertize "!" 'display
(cons flymake-fringe-indicator-position
(if (listp bitmap)
bitmap
(list bitmap)))))))
(defun flymake--highlight-line (diagnostic)
"Highlight buffer with info in DIAGNOSTIC."
(when-let* ((ov (make-overlay
(flymake--diag-beg diagnostic)
(flymake--diag-end diagnostic))))
;; First set `category' in the overlay, then copy over every other
;; property.
;;
(let ((alist (assoc-default (flymake--diag-type diagnostic)
flymake-diagnostic-types-alist)))
(overlay-put ov 'category (assoc-default 'flymake-category alist))
(cl-loop for (k . v) in alist
unless (eq k 'category)
do (overlay-put ov k v)))
;; Now ensure some essential defaults are set
;;
(cl-flet ((default-maybe
(prop value)
(unless (or (plist-member (overlay-properties ov) prop)
(let ((cat (overlay-get ov
'flymake-category)))
(and cat
(plist-member (symbol-plist cat) prop))))
(overlay-put ov prop value))))
(default-maybe 'bitmap 'flymake-error-bitmap)
(default-maybe 'face 'flymake-error)
(default-maybe 'before-string
(flymake--fringe-overlay-spec
(overlay-get ov 'bitmap)))
(default-maybe 'help-echo
(lambda (_window _ov pos)
(mapconcat
(lambda (ov)
(let ((diag (overlay-get ov 'flymake--diagnostic)))
(flymake--diag-text diag)))
(flymake--overlays :beg pos)
"\n")))
(default-maybe 'severity (warning-numeric-level :error))
(default-maybe 'priority (+ 100 (overlay-get ov 'severity))))
;; Some properties can't be overridden.
;;
(overlay-put ov 'evaporate t)
(overlay-put ov 'flymake t)
(overlay-put ov 'flymake--diagnostic diagnostic)))
;; Nothing in Flymake uses this at all any more, so this is just for
;; third-party compatibility.
(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
(defvar-local flymake--backend-state nil
"Buffer-local hash table of a Flymake backend's state.
The keys to this hash table are functions as found in
`flymake-diagnostic-functions'. The values are structures
of the type `flymake--backend-state', with these slots:
`running', a symbol to keep track of a backend's replies via its
REPORT-FN argument. A backend is running if this key is
present. If nil, Flymake isn't expecting any replies from the
backend.
`diags', a (possibly empty) list of recent diagnostic objects
created by the backend with `flymake-make-diagnostic'.
`reported-p', a boolean indicating if the backend has replied
since it last was contacted.
`disabled', a string with the explanation for a previous
exceptional situation reported by the backend, nil if the
backend is operating normally.")
(cl-defstruct (flymake--backend-state
(:constructor flymake--make-backend-state))
running reported-p disabled diags)
(defmacro flymake--with-backend-state (backend state-var &rest body)
"Bind BACKEND's STATE-VAR to its state, run BODY."
(declare (indent 2) (debug (sexp sexp &rest form)))
(let ((b (make-symbol "b")))
`(let* ((,b ,backend)
(,state-var
(or (gethash ,b flymake--backend-state)
(puthash ,b (flymake--make-backend-state)
flymake--backend-state))))
,@body)))
(defun flymake-is-running ()
"Tell if Flymake has running backends in this buffer"
(flymake-running-backends))
(cl-defun flymake--handle-report (backend token report-action
&key explanation force
&allow-other-keys)
"Handle reports from BACKEND identified by TOKEN.
BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the calling
convention described in `flymake-diagnostic-functions' (which
see). Optional FORCE says to handle a report even if TOKEN was
not expected."
(let* ((state (gethash backend flymake--backend-state))
(first-report (not (flymake--backend-state-reported-p state))))
(setf (flymake--backend-state-reported-p state) t)
(let (expected-token
new-diags)
(cond
((null state)
(flymake-error
"Unexpected report from unknown backend %s" backend))
((flymake--backend-state-disabled state)
(flymake-error
"Unexpected report from disabled backend %s" backend))
((progn
(setq expected-token (flymake--backend-state-running state))
(null expected-token))
;; should never happen
(flymake-error "Unexpected report from stopped backend %s" backend))
((and (not (eq expected-token token))
(not force))
(flymake-error "Obsolete report from backend %s with explanation %s"
backend explanation))
((eq :panic report-action)
(flymake--disable-backend backend explanation))
((not (listp report-action))
(flymake--disable-backend backend
(format "Unknown action %S" report-action))
(flymake-error "Expected report, but got unknown key %s" report-action))
(t
(setq new-diags report-action)
(save-restriction
(widen)
;; only delete overlays if this is the first report
(when first-report
(flymake-delete-own-overlays
(lambda (ov)
(eq backend
(flymake--diag-backend
(overlay-get ov 'flymake--diagnostic))))))
(mapc (lambda (diag)
(flymake--highlight-line diag)
(setf (flymake--diag-backend diag) backend))
new-diags)
(setf (flymake--backend-state-diags state)
(append new-diags (flymake--backend-state-diags state)))
(when flymake-check-start-time
(flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)"
backend
(length new-diags)
(- (float-time) flymake-check-start-time)))))))))
(defun flymake-make-report-fn (backend &optional token)
"Make a suitable anonymous report function for BACKEND.
BACKEND is used to help Flymake distinguish different diagnostic
sources. If provided, TOKEN helps Flymake distinguish between
different runs of the same backend."
(let ((buffer (current-buffer)))
(lambda (&rest args)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(apply #'flymake--handle-report backend token args))))))
(defun flymake--collect (fn)
(let (retval)
(maphash (lambda (backend state)
(when (funcall fn state) (push backend retval)))
flymake--backend-state)
retval))
(defun flymake-running-backends ()
"Compute running Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-running))
(defun flymake-disabled-backends ()
"Compute disabled Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-disabled))
(defun flymake-reporting-backends ()
"Compute reporting Flymake backends in current buffer."
(flymake--collect #'flymake--backend-state-reported-p))
(defun flymake--disable-backend (backend &optional explanation)
"Disable BACKEND because EXPLANATION.
If it is running also stop it."
(flymake-log :warning "Disabling backend %s because %s" backend explanation)
(flymake--with-backend-state backend state
(setf (flymake--backend-state-running state) nil
(flymake--backend-state-disabled state) explanation
(flymake--backend-state-reported-p state) t)))
(defun flymake--run-backend (backend)
"Run the backend BACKEND, reenabling if necessary."
(flymake-log :debug "Running backend %s" backend)
(let ((run-token (cl-gensym "backend-token")))
(flymake--with-backend-state backend state
(setf (flymake--backend-state-running state) run-token
(flymake--backend-state-disabled state) nil
(flymake--backend-state-diags state) nil
(flymake--backend-state-reported-p state) nil))
;; FIXME: Should use `condition-case-unless-debug' here, but don't
;; for two reasons: (1) that won't let me catch errors from inside
;; `ert-deftest' where `debug-on-error' appears to be always
;; t. (2) In cases where the user is debugging elisp somewhere
;; else, and using flymake, the presence of a frequently
;; misbehaving backend in the global hook (most likely the legacy
;; backend) will trigger an annoying backtrace.
;;
(condition-case err
(funcall backend
(flymake-make-report-fn backend run-token))
(error
(flymake--disable-backend backend err)))))
(defun flymake-start (&optional deferred force)
"Start a syntax check.
Start it immediately, or after current command if DEFERRED is
non-nil. With optional FORCE run even disabled backends.
Interactively, with a prefix arg, FORCE is t."
(interactive (list nil current-prefix-arg))
(cl-labels
((start
()
(remove-hook 'post-command-hook #'start 'local)
(setq flymake-check-start-time (float-time))
(run-hook-wrapped
'flymake-diagnostic-functions
(lambda (backend)
(cond
((and (not force)
(flymake--with-backend-state backend state
(flymake--backend-state-disabled state)))
(flymake-log :debug "Backend %s is disabled, not starting"
backend))
(t
(flymake--run-backend backend)))
nil))))
(if (and deferred
this-command)
(add-hook 'post-command-hook #'start 'append 'local)
(start))))
(defvar flymake-mode-map
(let ((map (make-sparse-keymap))) map)
"Keymap for `flymake-mode'")
;;;###autoload
(define-minor-mode flymake-mode nil
:group 'flymake :lighter flymake--mode-line-format :keymap flymake-mode-map
(cond
;; Turning the mode ON.
(flymake-mode
(add-hook 'after-change-functions 'flymake-after-change-function nil t)
(add-hook 'after-save-hook 'flymake-after-save-hook nil t)
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(setq flymake--backend-state (make-hash-table))
(when flymake-start-syntax-check-on-find-file
(flymake-start)))
;; Turning the mode OFF.
(t
(remove-hook 'after-change-functions 'flymake-after-change-function t)
(remove-hook 'after-save-hook 'flymake-after-save-hook t)
(remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
(flymake-delete-own-overlays)
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil)))))
(defun flymake--schedule-timer-maybe ()
"(Re)schedule an idle timer for checking the buffer.
Do it only if `flymake-no-changes-timeout' is non-nil."
(when flymake-timer (cancel-timer flymake-timer))
(when flymake-no-changes-timeout
(setq
flymake-timer
(run-with-idle-timer
(seconds-to-time flymake-no-changes-timeout)
nil
(lambda (buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and flymake-mode
flymake-no-changes-timeout)
(flymake-log
:debug "starting syntax check after idle for %s seconds"
flymake-no-changes-timeout)
(flymake-start))
(setq flymake-timer nil))))
(current-buffer)))))
;;;###autoload
(defun flymake-mode-on ()
"Turn Flymake mode on."
(flymake-mode 1))
;;;###autoload
(defun flymake-mode-off ()
"Turn Flymake mode off."
(flymake-mode 0))
(make-obsolete 'flymake-mode-on 'flymake-mode "26.1")
(make-obsolete 'flymake-mode-off 'flymake-mode "26.1")
(defun flymake-after-change-function (start stop _len)
"Start syntax check for current buffer if it isn't already running."
(let((new-text (buffer-substring start stop)))
(when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
(flymake-log :debug "starting syntax check as new-line has been seen")
(flymake-start 'deferred))
(flymake--schedule-timer-maybe)))
(defun flymake-after-save-hook ()
(when flymake-mode
(flymake-log :debug "starting syntax check as buffer was saved")
(flymake-start)))
(defun flymake-kill-buffer-hook ()
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil)))
(defun flymake-find-file-hook ()
(unless (or flymake-mode
(null flymake-diagnostic-functions))
(flymake-mode)
(flymake-log :warning "Turned on in `flymake-find-file-hook'")))
(defun flymake-goto-next-error (&optional n filter interactive)
"Go to Nth next Flymake error in buffer matching FILTER.
Interactively, always move to the next error. With a prefix arg,
skip any diagnostics with a severity less than ‘:warning’.
If ‘flymake-wrap-around’ is non-nil and no more next errors,
resumes search from top
FILTER is a list of diagnostic types found in
`flymake-diagnostic-types-alist', or nil, if no filter is to be
applied."
;; TODO: let filter be a number, a severity below which diags are
;; skipped.
(interactive (list 1
(if current-prefix-arg
'(:error :warning))
t))
(let* ((n (or n 1))
(ovs (flymake--overlays :filter
(lambda (ov)
(let ((diag (overlay-get
ov
'flymake--diagnostic)))
(and diag
(or (not filter)
(memq (flymake--diag-type diag)
filter)))))
:compare (if (cl-plusp n) #'< #'>)
:key #'overlay-start))
(tail (cl-member-if (lambda (ov)
(if (cl-plusp n)
(> (overlay-start ov)
(point))
(< (overlay-start ov)
(point))))
ovs))
(chain (if flymake-wrap-around
(if tail
(progn (setcdr (last tail) ovs) tail)
(and ovs (setcdr (last ovs) ovs)))
tail))
(target (nth (1- n) chain)))
(cond (target
(goto-char (overlay-start target))
(when interactive
(message
(funcall (overlay-get target 'help-echo)
nil nil (point)))))
(interactive
(user-error "No more Flymake errors%s"
(if filter
(format " of types %s" filter)
""))))))
(defun flymake-goto-prev-error (&optional n filter interactive)
"Go to Nth previous Flymake error in buffer matching FILTER.
Interactively, always move to the previous error. With a prefix
arg, skip any diagnostics with a severity less than ‘:warning’.
If ‘flymake-wrap-around’ is non-nil and no more previous errors,
resumes search from bottom.
FILTER is a list of diagnostic types found in
`flymake-diagnostic-types-alist', or nil, if no filter is to be
applied."
(interactive (list 1 (if current-prefix-arg
'(:error :warning))
t))
(flymake-goto-next-error (- (or n 1)) filter interactive))
;;; Mode-line and menu
;;;
(easy-menu-define flymake-menu flymake-mode-map "Flymake"
`("Flymake"
[ "Go to next error" flymake-goto-next-error t ]
[ "Go to previous error" flymake-goto-prev-error t ]
[ "Check now" flymake-start t ]
[ "Go to log buffer" flymake-switch-to-log-buffer t ]
"--"
[ "Turn off Flymake" flymake-mode t ]))
(defvar flymake--mode-line-format `(:eval (flymake--mode-line-format)))
(put 'flymake--mode-line-format 'risky-local-variable t)
(defun flymake--mode-line-format ()
"Produce a pretty minor mode indicator."
(let* ((known (hash-table-keys flymake--backend-state))
(running (flymake-running-backends))
(disabled (flymake-disabled-backends))
(reported (flymake-reporting-backends))
(diags-by-type (make-hash-table))
(all-disabled (and disabled (null running)))
(some-waiting (cl-set-difference running reported)))
(maphash (lambda (_b state)
(mapc (lambda (diag)
(push diag
(gethash (flymake--diag-type diag)
diags-by-type)))
(flymake--backend-state-diags state)))
flymake--backend-state)
`((:propertize " Flymake"
mouse-face mode-line-highlight
help-echo
,(concat (format "%s known backends\n" (length known))
(format "%s running\n" (length running))
(format "%s disabled\n" (length disabled))
"mouse-1: go to log buffer ")
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
flymake-menu)
map))
,@(pcase-let ((`(,ind ,face ,explain)
(cond ((null known)
`("?" mode-line "No known backends"))
(some-waiting
`("Wait" compilation-mode-line-run
,(format "Waiting for %s running backend(s)"
(length some-waiting))))
(all-disabled
`("!" compilation-mode-line-run
"All backends disabled"))
(t
`(nil nil nil)))))
(when ind
`((":"
(:propertize ,ind
face ,face
help-echo ,explain
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line mouse-1]
'flymake-switch-to-log-buffer)
map))))))
,@(unless (or all-disabled
(null known))
(cl-loop
for (type . severity)
in (cl-sort (mapcar (lambda (type)
(cons type (flymake--lookup-type-property
type
'severity
(warning-numeric-level :error))))
(cl-union (hash-table-keys diags-by-type)
'(:error :warning)))
#'>
:key #'cdr)
for diags = (gethash type diags-by-type)
for face = (flymake--lookup-type-property type
'mode-line-face
'compilation-error)
when (or diags
(>= severity (warning-numeric-level :warning)))
collect `(:propertize
,(format "%d" (length diags))
face ,face
mouse-face mode-line-highlight
keymap
,(let ((map (make-sparse-keymap))
(type type))
(define-key map [mode-line mouse-4]
(lambda (_event)
(interactive "e")
(flymake-goto-prev-error 1 (list type) t)))
(define-key map [mode-line mouse-5]
(lambda (_event)
(interactive "e")
(flymake-goto-next-error 1 (list type) t)))
map)
help-echo
,(concat (format "%s diagnostics of type %s\n"
(propertize (format "%d"
(length diags))
'face face)
(propertize (format "%s" type)
'face face))
"mouse-4/mouse-5: previous/next of this type\n"))
into forms
finally return
`((:propertize "[")
,@(cl-loop for (a . rest) on forms by #'cdr
collect a when rest collect
'(:propertize " "))
(:propertize "]")))))))
(provide 'flymake)
(require 'flymake-proc)
;;; flymake.el ends here

6
lisp/progmodes/python.el
View file

@ -3442,6 +3442,8 @@ def __PYTHON_EL_native_completion_setup():
instance.rlcomplete = new_completer
if readline.__doc__ and 'libedit' in readline.__doc__:
raise Exception('''libedit based readline is known not to work,
see etc/PROBLEMS under \"In Inferior Python mode, input is echoed\".''')
readline.parse_and_bind('bind ^I rl_complete')
else:
readline.parse_and_bind('tab: complete')
@ -3450,7 +3452,9 @@ def __PYTHON_EL_native_completion_setup():
print ('python.el: native completion setup loaded')
except:
print ('python.el: native completion setup failed')
import sys
print ('python.el: native completion setup failed, %s: %s'
% sys.exc_info()[:2])
__PYTHON_EL_native_completion_setup()" process)
(when (and

3
lisp/ses.el
View file

@ -1254,8 +1254,7 @@ preceding cell has spilled over."
((< len width)
;; Fill field to length with spaces.
(setq len (make-string (- width len) ?\s)
text (if (or (stringp value)
(eq ses-call-printer-return t))
text (if (eq ses-call-printer-return t)
(concat text len)
(concat len text))))
((> len width)

31
lisp/time.el
View file

@ -160,24 +160,33 @@ LABEL is a string to display as the label of that TIMEZONE's time."
:type '(repeat (list string string))
:version "23.1")
(defcustom display-time-world-list
;; Determine if zoneinfo style timezones are supported by testing that
;; America/New York and Europe/London return different timezones.
(let ((nyt (format-time-string "%z" nil "America/New_York"))
(gmt (format-time-string "%z" nil "Europe/London")))
(if (string-equal nyt gmt)
legacy-style-world-list
zoneinfo-style-world-list))
(defcustom display-time-world-list t
"Alist of time zones and places for `display-time-world' to display.
Each element has the form (TIMEZONE LABEL).
TIMEZONE should be in a format supported by your system. See the
documentation of `zoneinfo-style-world-list' and
`legacy-style-world-list' for two widely used formats. LABEL is
a string to display as the label of that TIMEZONE's time."
a string to display as the label of that TIMEZONE's time.
If the value is t instead of an alist, use the value of
`zoneinfo-style-world-list' if it works on this platform, and of
`legacy-style-world-list' otherwise."
:group 'display-time
:type '(repeat (list string string))
:version "23.1")
(defun time--display-world-list ()
(if (listp display-time-world-list)
display-time-world-list
;; Determine if zoneinfo style timezones are supported by testing that
;; America/New York and Europe/London return different timezones.
(let ((nyt (format-time-string "%z" nil "America/New_York"))
(gmt (format-time-string "%z" nil "Europe/London")))
(if (string-equal nyt gmt)
legacy-style-world-list
zoneinfo-style-world-list))))
(defcustom display-time-world-time-format "%A %d %B %R %Z"
"Format of the time displayed, see `format-time-string'."
:group 'display-time
@ -548,7 +557,7 @@ To turn off the world time display, go to that window and type `q'."
(not (get-buffer display-time-world-buffer-name)))
(run-at-time t display-time-world-timer-second 'display-time-world-timer))
(with-current-buffer (get-buffer-create display-time-world-buffer-name)
(display-time-world-display display-time-world-list)
(display-time-world-display (time--display-world-list))
(display-buffer display-time-world-buffer-name
(cons nil '((window-height . fit-window-to-buffer))))
(display-time-world-mode)))
@ -556,7 +565,7 @@ To turn off the world time display, go to that window and type `q'."
(defun display-time-world-timer ()
(if (get-buffer display-time-world-buffer-name)
(with-current-buffer (get-buffer display-time-world-buffer-name)
(display-time-world-display display-time-world-list))
(display-time-world-display (time--display-world-list)))
;; cancel timer
(let ((list timer-list))
(while list

6
lisp/xt-mouse.el
View file

@ -288,8 +288,10 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(string-match "down-" last-name)
(equal name (replace-match "" t t last-name)))
(xterm-mouse--set-click-count event click-count)))
((not last-time) nil)
((and (> double-click-time (* 1000 (- this-time last-time)))
((and last-time
double-click-time
(or (eq double-click-time t)
(> double-click-time (* 1000 (- this-time last-time))))
(equal last-name (replace-match "" t t name)))
(setq click-count (1+ click-count))
(xterm-mouse--set-click-count event click-count))

4
src/callint.c
View file

@ -272,7 +272,7 @@ invoke it. If KEYS is omitted or nil, the return value of
{
/* `args' will contain the array of arguments to pass to the function.
`visargs' will contain the same list but in a nicer form, so that if we
pass it to styled_format it will be understandable to a human. */
pass it to Fformat_message it will be understandable to a human. */
Lisp_Object *args, *visargs;
Lisp_Object specs;
Lisp_Object filter_specs;
@ -502,7 +502,7 @@ invoke it. If KEYS is omitted or nil, the return value of
for (i = 2; *tem; i++)
{
visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
callint_message = styled_format (i - 1, visargs + 1, true, false);
callint_message = Fformat_message (i - 1, visargs + 1);
switch (*tem)
{

3
src/dbusbind.c
View file

@ -237,8 +237,7 @@ static char *
XD_OBJECT_TO_STRING (Lisp_Object object)
{
AUTO_STRING (format, "%s");
Lisp_Object args[] = { format, object };
return SSDATA (styled_format (ARRAYELTS (args), args, false, false));
return SSDATA (CALLN (Fformat, format, object));
}
#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \

28
src/editfns.c
View file

@ -74,6 +74,7 @@ static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
static long int tm_gmtoff (struct tm *);
static int tm_diff (struct tm *, struct tm *);
static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
#ifndef HAVE_TM_GMTOFF
# define HAVE_TM_GMTOFF false
@ -3958,7 +3959,7 @@ usage: (message FORMAT-STRING &rest ARGS) */)
}
else
{
Lisp_Object val = styled_format (nargs, args, true, false);
Lisp_Object val = Fformat_message (nargs, args);
message3 (val);
return val;
}
@ -3984,7 +3985,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
}
else
{
Lisp_Object val = styled_format (nargs, args, true, false);
Lisp_Object val = Fformat_message (nargs, args);
Lisp_Object pane, menu;
pane = list1 (Fcons (build_string ("OK"), Qt));
@ -4140,7 +4141,7 @@ produced text.
usage: (format STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
return styled_format (nargs, args, false, true);
return styled_format (nargs, args, false);
}
DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0,
@ -4156,16 +4157,13 @@ and right quote replacement characters are specified by
usage: (format-message STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
return styled_format (nargs, args, true, true);
return styled_format (nargs, args, true);
}
/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise.
If NEW_RESULT, the result is a new string; otherwise, the result
may be one of the arguments. */
/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */
Lisp_Object
styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
bool new_result)
static Lisp_Object
styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
{
ptrdiff_t n; /* The number of the next arg to substitute. */
char initial_buffer[4000];
@ -4195,9 +4193,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
/* The start and end bytepos in the output string. */
ptrdiff_t start, end;
/* Whether the argument is a newly created string. */
bool_bf new_string : 1;
/* Whether the argument is a string with intervals. */
bool_bf intervals : 1;
} *info;
@ -4241,6 +4236,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
ptrdiff_t ispec;
ptrdiff_t nspec = 0;
/* True if a string needs to be allocated to hold the result. */
bool new_result = false;
/* If we start out planning a unibyte result,
then discover it has to be multibyte, we jump back to retry. */
retry:
@ -4360,7 +4358,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
if (nspec < ispec)
{
spec->argument = args[n];
spec->new_string = false;
spec->intervals = false;
nspec = ispec;
}
@ -4378,7 +4375,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
{
Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
spec->argument = arg = Fprin1_to_string (arg, noescape);
spec->new_string = true;
if (STRING_MULTIBYTE (arg) && ! multibyte)
{
multibyte = true;
@ -4397,7 +4393,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
goto retry;
}
spec->argument = arg = Fchar_to_string (arg);
spec->new_string = true;
}
if (!EQ (arg, args[n]))
@ -4421,7 +4416,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
if (conversion == 's')
{
if (format == end && format - format_start == 2
&& (!new_result || spec->new_string)
&& ! string_intervals (args[0]))
return arg;

2
src/frame.c
View file

@ -2542,6 +2542,7 @@ for how to proceed. */)
(Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object parent = f->parent_frame;
if (!NILP (parent))
@ -2562,6 +2563,7 @@ for how to proceed. */)
return Qnil;
}
}
#endif /* HAVE_WINDOW_SYSTEM */
/* Don't allow minibuf_window to remain on an iconified frame. */
check_minibuf_window (frame, EQ (minibuf_window, selected_window));

17
src/gtkutil.c
View file

@ -577,11 +577,18 @@ xg_check_special_colors (struct frame *f,
if (get_fg)
gtk_style_context_get_color (gsty, state, &col);
else
/* FIXME: gtk_style_context_get_background_color is deprecated
in GTK+ 3.16. New versions of GTK+ don’t use the concept of
a single background color any more, so we shouldn’t query for
it. */
gtk_style_context_get_background_color (gsty, state, &col);
{
GdkRGBA *c;
/* FIXME: Retrieving the background color is deprecated in
GTK+ 3.16. New versions of GTK+ don’t use the concept of a
single background color any more, so we shouldn’t query for
it. */
gtk_style_context_get (gsty, state,
GTK_STYLE_PROPERTY_BACKGROUND_COLOR, &c,
NULL);
col = *c;
gdk_rgba_free (c);
}
unsigned short
r = col.red * 65535,

14
src/keyboard.c
View file

@ -145,10 +145,6 @@ static Lisp_Object recover_top_level_message;
/* Message normally displayed by Vtop_level. */
static Lisp_Object regular_top_level_message;
/* For longjmp to where kbd input is being done. */
static sys_jmp_buf getcjmp;
/* True while displaying for echoing. Delays C-g throwing. */
static bool echoing;
@ -2570,9 +2566,6 @@ read_char (int commandflag, Lisp_Object map,
so restore it now. */
restore_getcjmp (save_jump);
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
#if THREADS_ENABLED
maybe_reacquire_global_lock ();
#endif
unbind_to (jmpcount, Qnil);
XSETINT (c, quit_char);
internal_last_event_frame = selected_frame;
@ -10508,6 +10501,13 @@ handle_interrupt (bool in_signal_handler)
outside of polling since we don't get SIGIO like X and we don't have a
separate event loop thread like W32. */
#ifndef HAVE_NS
#ifdef THREADS_ENABLED
/* If we were called from a signal handler, we must be in the main
thread, see deliver_process_signal. So we must make sure the
main thread holds the global lock. */
if (in_signal_handler)
maybe_reacquire_global_lock ();
#endif
if (waiting_for_input && !echoing)
quit_throw_to_read_char (in_signal_handler);
#endif

40
src/lisp.h
View file

@ -1865,6 +1865,26 @@ verify (offsetof (struct Lisp_Sub_Char_Table, contents)
== (offsetof (struct Lisp_Vector, contents)
+ SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)));
/* Save and restore the instruction and environment pointers,
without affecting the signal mask. */
#ifdef HAVE__SETJMP
typedef jmp_buf sys_jmp_buf;
# define sys_setjmp(j) _setjmp (j)
# define sys_longjmp(j, v) _longjmp (j, v)
#elif defined HAVE_SIGSETJMP
typedef sigjmp_buf sys_jmp_buf;
# define sys_setjmp(j) sigsetjmp (j, 0)
# define sys_longjmp(j, v) siglongjmp (j, v)
#else
/* A platform that uses neither _longjmp nor siglongjmp; assume
longjmp does not affect the sigmask. */
typedef jmp_buf sys_jmp_buf;
# define sys_setjmp(j) setjmp (j)
# define sys_longjmp(j, v) longjmp (j, v)
#endif
#include "thread.h"
/***********************************************************************
@ -3003,25 +3023,6 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
} while (false)
/* Save and restore the instruction and environment pointers,
without affecting the signal mask. */
#ifdef HAVE__SETJMP
typedef jmp_buf sys_jmp_buf;
# define sys_setjmp(j) _setjmp (j)
# define sys_longjmp(j, v) _longjmp (j, v)
#elif defined HAVE_SIGSETJMP
typedef sigjmp_buf sys_jmp_buf;
# define sys_setjmp(j) sigsetjmp (j, 0)
# define sys_longjmp(j, v) siglongjmp (j, v)
#else
/* A platform that uses neither _longjmp nor siglongjmp; assume
longjmp does not affect the sigmask. */
typedef jmp_buf sys_jmp_buf;
# define sys_setjmp(j) setjmp (j)
# define sys_longjmp(j, v) longjmp (j, v)
#endif
/* Elisp uses several stacks:
@ -3969,7 +3970,6 @@ extern _Noreturn void time_overflow (void);
extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
ptrdiff_t, bool);
extern Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool, bool);
extern void init_editfns (bool);
extern void syms_of_editfns (void);

13
src/sysdep.c
View file

@ -232,7 +232,18 @@ emacs_get_current_dir_name (void)
bool use_libc = true;
# endif
if (use_libc)
return get_current_dir_name ();
{
/* GNU/Linux get_current_dir_name can return a string starting
with "(unreachable)" (Bug#27871). */
char *wd = get_current_dir_name ();
if (wd && ! (IS_DIRECTORY_SEP (*wd) || (*wd && IS_DEVICE_SEP (wd[1]))))
{
free (wd);
errno = ENOENT;
return NULL;
}
return wd;
}
# endif
char *buf;

16
src/thread.c
View file

@ -101,14 +101,20 @@ acquire_global_lock (struct thread_state *self)
post_acquire_global_lock (self);
}
/* This is called from keyboard.c when it detects that SIGINT
interrupted thread_select before the current thread could acquire
the lock. We must acquire the lock to prevent a thread from
running without holding the global lock, and to avoid repeated
calls to sys_mutex_unlock, which invokes undefined behavior. */
/* This is called from keyboard.c when it detects that SIGINT was
delivered to the main thread and interrupted thread_select before
the main thread could acquire the lock. We must acquire the lock
to prevent a thread from running without holding the global lock,
and to avoid repeated calls to sys_mutex_unlock, which invokes
undefined behavior. */
void
maybe_reacquire_global_lock (void)
{
/* SIGINT handler is always run on the main thread, see
deliver_process_signal, so reflect that in our thread-tracking
variables. */
current_thread = &main_thread;
if (current_thread->not_holding_lock)
{
struct thread_state *self = current_thread;

7
src/thread.h
View file

@ -158,6 +158,13 @@ struct thread_state
bool m_waiting_for_input;
#define waiting_for_input (current_thread->m_waiting_for_input)
/* For longjmp to where kbd input is being done. This is per-thread
so that if more than one thread calls read_char, they don't
clobber each other's getcjmp, which will cause
quit_throw_to_read_char crash due to using a wrong stack. */
sys_jmp_buf m_getcjmp;
#define getcjmp (current_thread->m_getcjmp)
/* The OS identifier for this thread. */
sys_thread_t thread_id;

4
src/xdisp.c
View file

@ -10194,7 +10194,7 @@ vadd_to_log (char const *format, va_list ap)
for (ptrdiff_t i = 1; i <= nargs; i++)
args[i] = va_arg (ap, Lisp_Object);
Lisp_Object msg = Qnil;
msg = styled_format (nargs, args, true, false);
msg = Fformat_message (nargs, args);
ptrdiff_t len = SBYTES (msg) + 1;
USE_SAFE_ALLOCA;
@ -19525,7 +19525,7 @@ DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "",
usage: (trace-to-stderr STRING &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object s = styled_format (nargs, args, false, false);
Lisp_Object s = Fformat (nargs, args);
fwrite (SDATA (s), 1, SBYTES (s), stderr);
return Qnil;
}

7
src/xrdb.c
View file

@ -345,6 +345,7 @@ get_user_db (Display *display)
db = XrmGetStringDatabase (xdefs);
else
{
/* Use ~/.Xdefaults. */
char *home = gethomedir ();
ptrdiff_t homelen = strlen (home);
char *filename = xrealloc (home, homelen + sizeof xdefaults);
@ -375,13 +376,15 @@ get_environ_db (void)
if (!p)
{
/* Use ~/.Xdefaults-HOSTNAME. */
char *home = gethomedir ();
ptrdiff_t homelen = strlen (home);
Lisp_Object system_name = Fsystem_name ();
ptrdiff_t filenamesize = (homelen + sizeof xdefaults
+ SBYTES (system_name));
+ 1 + SBYTES (system_name));
p = filename = xrealloc (home, filenamesize);
lispstpcpy (stpcpy (filename + homelen, xdefaults), system_name);
lispstpcpy (stpcpy (stpcpy (filename + homelen, xdefaults), "-"),
system_name);
}
db = XrmGetFileDatabase (p);

10
test/lisp/emacs-lisp/generator-tests.el
View file

@ -282,3 +282,13 @@ identical output.
(ert-deftest cps-test-declarations-preserved ()
(should (equal (documentation 'generator-with-docstring) "Documentation!"))
(should (equal (get 'generator-with-docstring 'lisp-indent-function) 5)))
(ert-deftest cps-iter-lambda-with-dynamic-binding ()
"`iter-lambda' with dynamic binding produces correct result (bug#25965)."
(should (= 1
(iter-next
(funcall (iter-lambda ()
(let* ((fill-column 10) ;;any special variable will do
(i 0)
(j (setq i (1+ i))))
(iter-yield i))))))))

29
test/lisp/net/tramp-tests.el
View file

@ -3438,7 +3438,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(fboundp 'connection-local-set-profiles)))
;; `connection-local-set-profile-variables' and
;; `connection-local-set-profiles' exists since Emacs 26. We don't
;; `connection-local-set-profiles' exist since Emacs 26. We don't
;; want to see compiler warnings for older Emacsen.
(let ((default-directory tramp-test-temporary-file-directory)
explicit-shell-file-name kill-buffer-query-functions)
@ -4108,12 +4108,29 @@ Use the `ls' command."
tramp-connection-properties)))
(tramp--test-utf8)))
(ert-deftest tramp-test37-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
;; Since Emacs 27.1.
(skip-unless (fboundp 'file-system-info))
;; `file-system-info' exists since Emacs 27. We don't
;; want to see compiler warnings for older Emacsen.
(let ((fsi (with-no-warnings
(file-system-info tramp-test-temporary-file-directory))))
(skip-unless fsi)
(should (and (consp fsi)
(= (length fsi) 3)
(numberp (nth 0 fsi))
(numberp (nth 1 fsi))
(numberp (nth 2 fsi))))))
(defun tramp--test-timeout-handler ()
(interactive)
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test37-asynchronous-requests ()
(ert-deftest tramp-test38-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@ -4270,7 +4287,7 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive)))))))
(ert-deftest tramp-test38-recursive-load ()
(ert-deftest tramp-test39-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@ -4293,7 +4310,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
(ert-deftest tramp-test39-remote-load-path ()
(ert-deftest tramp-test40-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
@ -4316,7 +4333,7 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test40-unload ()
(ert-deftest tramp-test41-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@ -4374,7 +4391,7 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'.
;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'.
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."

4
test/lisp/progmodes/flymake-resources/Makefile
View file

@ -1,6 +1,6 @@
# Makefile for flymake tests
CC_OPTS = -Wall
CC_OPTS = -Wall -Wextra
## Recent gcc (e.g. 4.8.2 on RHEL7) can automatically colorize their output,
## which can confuse flymake. Set GCC_COLORS to disable that.
@ -8,6 +8,6 @@ CC_OPTS = -Wall
## normally use flymake, so it seems like just avoiding the issue
## in this test is fine. Set flymake-log-level to 3 to investigate.
check-syntax:
GCC_COLORS= $(CC) $(CC_OPTS) ${CHK_SOURCES}
GCC_COLORS= $(CC) $(CC_OPTS) ${CHK_SOURCES} || true
# eof

13
test/lisp/progmodes/flymake-resources/errors-and-warnings.c Normal file
View file

@ -0,0 +1,13 @@
/* Flymake should notice an error on the next line, since
that file has at least one warning.*/
#include "some-problems.h"
/* But not this one */
#include "no-problems.h"
int main()
{
char c = 1000; /* a note and a warning */
int bla;
char c; if (bla == (void*)3); /* an error, and two warnings */
return c;
}

1
test/lisp/progmodes/flymake-resources/no-problems.h Normal file
View file

@ -0,0 +1 @@
typedef int no_problems;

5
test/lisp/progmodes/flymake-resources/some-problems.h Normal file
View file

@ -0,0 +1,5 @@
#include <stdio.h>
strange;
sint main();

297
test/lisp/progmodes/flymake-tests.el
View file

@ -1,4 +1,4 @@
;;; flymake-tests.el --- Test suite for flymake
;;; flymake-tests.el --- Test suite for flymake -*- lexical-binding: t -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@ -26,54 +26,295 @@
(require 'flymake)
(defvar flymake-tests-data-directory
(expand-file-name "lisp/progmodes/flymake-resources" (getenv "EMACS_TEST_DIRECTORY"))
(expand-file-name "lisp/progmodes/flymake-resources"
(or (getenv "EMACS_TEST_DIRECTORY")
(expand-file-name "../../.."
(or load-file-name
buffer-file-name))))
"Directory containing flymake test data.")
;; Warning predicate
(defun flymake-tests--current-face (file predicate)
(let ((buffer (find-file-noselect
(expand-file-name file flymake-tests-data-directory)))
(process-environment (cons "LC_ALL=C" process-environment))
(i 0))
;;
;;
(defun flymake-tests--wait-for-backends ()
;; Weirdness here... http://debbugs.gnu.org/17647#25
;; ... meaning `sleep-for', and even
;; `accept-process-output', won't suffice as ways to get
;; process filters and sentinels to run, though they do work
;; fine in a non-interactive batch session. The only thing
;; that will indeed unblock pending process output is
;; reading an input event, so, as a workaround, use a dummy
;; `read-event' with a very short timeout.
(unless noninteractive (read-event "" nil 0.1))
(cl-loop repeat 5
for notdone = (cl-set-difference (flymake-running-backends)
(flymake-reporting-backends))
while notdone
unless noninteractive do (read-event "" nil 0.1)
do (sleep-for (+ 0.5 flymake-no-changes-timeout))
finally (when notdone (ert-fail
(format "Some backends not reporting yet %s"
notdone)))))
(cl-defun flymake-tests--call-with-fixture (fn file
&key (severity-predicate
nil sev-pred-supplied-p))
"Call FN after flymake setup in FILE, using `flymake-proc`.
SEVERITY-PREDICATE is used to setup
`flymake-proc-diagnostic-type-pred'"
(let* ((file (expand-file-name file flymake-tests-data-directory))
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file)))
(process-environment (cons "LC_ALL=C" process-environment))
(warning-minimum-log-level :error))
(unwind-protect
(with-current-buffer buffer
(setq-local flymake-warning-predicate predicate)
(goto-char (point-min))
(flymake-mode 1)
;; Weirdness here... https://debbugs.gnu.org/17647#25
(while (and flymake-is-running (< (setq i (1+ i)) 10))
(sleep-for (+ 0.5 flymake-no-changes-timeout)))
(flymake-goto-next-error)
(face-at-point))
(and buffer (let (kill-buffer-query-functions) (kill-buffer buffer))))))
(save-excursion
(when sev-pred-supplied-p
(setq-local flymake-proc-diagnostic-type-pred severity-predicate))
(goto-char (point-min))
(unless flymake-mode (flymake-mode 1))
(flymake-tests--wait-for-backends)
(funcall fn)))
(and buffer
(not visiting)
(let (kill-buffer-query-functions) (kill-buffer buffer))))))
(cl-defmacro flymake-tests--with-flymake ((file &rest args)
&body body)
(declare (indent 1)
(debug (sexp &rest form)))
`(flymake-tests--call-with-fixture (lambda () ,@body) ,file ,@args))
(ert-deftest warning-predicate-rx-gcc ()
"Test GCC warning via regexp predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(should (eq 'flymake-warnline
(flymake-tests--current-face "test.c" "^[Ww]arning"))))
(flymake-tests--with-flymake
("test.c" :severity-predicate "^[Ww]arning")
(flymake-goto-next-error)
(should (eq 'flymake-warning
(face-at-point)))))
(ert-deftest warning-predicate-function-gcc ()
"Test GCC warning via function predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(should (eq 'flymake-warnline
(flymake-tests--current-face "test.c"
(lambda (msg) (string-match "^[Ww]arning" msg))))))
(flymake-tests--with-flymake
("test.c" :severity-predicate
(lambda (msg) (string-match "^[Ww]arning" msg)))
(flymake-goto-next-error)
(should (eq 'flymake-warning
(face-at-point)))))
(ert-deftest warning-predicate-rx-perl ()
"Test perl warning via regular expression predicate."
(skip-unless (executable-find "perl"))
(should (eq 'flymake-warnline
(flymake-tests--current-face "test.pl" "^Scalar value"))))
(flymake-tests--with-flymake
("test.pl" :severity-predicate "^Scalar value")
(flymake-goto-next-error)
(should (eq 'flymake-warning
(face-at-point)))))
(ert-deftest warning-predicate-function-perl ()
"Test perl warning via function predicate."
(skip-unless (executable-find "perl"))
(should (eq 'flymake-warnline
(flymake-tests--current-face
"test.pl"
(lambda (msg) (string-match "^Scalar value" msg))))))
(flymake-tests--with-flymake
("test.pl" :severity-predicate
(lambda (msg) (string-match "^Scalar value" msg)))
(flymake-goto-next-error)
(should (eq 'flymake-warning
(face-at-point)))))
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("errors-and-warnings.c")
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-note (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(should-error (flymake-goto-next-error nil nil t)))))
(ert-deftest included-c-header-files ()
"Test inclusion of .h header files."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
(let ((flymake-wrap-around nil))
(flymake-tests--with-flymake
("some-problems.h")
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point)))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point)))
(should-error (flymake-goto-next-error nil nil t)))
(flymake-tests--with-flymake
("no-problems.h")
(should-error (flymake-goto-next-error nil nil t)))))
(defmacro flymake-tests--assert-set (set
should
should-not)
(declare (indent 1))
`(progn
,@(cl-loop
for s in should
collect `(should (memq (quote ,s) ,set)))
,@(cl-loop
for s in should-not
collect `(should-not (memq (quote ,s) ,set)))))
(defun flymake-tests--diagnose-words
(report-fn type words)
"Helper. Call REPORT-FN with diagnostics for WORDS in buffer."
(funcall report-fn
(cl-loop
for word in words
append
(save-excursion
(goto-char (point-min))
(cl-loop while (word-search-forward word nil t)
collect (flymake-make-diagnostic
(current-buffer)
(match-beginning 0)
(match-end 0)
type
(concat word " is wrong")))))))
(ert-deftest dummy-backends ()
"Test many different kinds of backends."
(with-temp-buffer
(cl-letf
(((symbol-function 'error-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
#'flymake-tests--diagnose-words report-fn :error '("manha" "prognata"))))
((symbol-function 'warning-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
#'flymake-tests--diagnose-words report-fn :warning '("ut" "dolor"))))
((symbol-function 'sync-backend)
(lambda (report-fn)
(flymake-tests--diagnose-words report-fn :note '("quis" "commodo"))))
((symbol-function 'panicking-backend)
(lambda (report-fn)
(run-with-timer
0.5 nil
report-fn :panic :explanation "The spanish inquisition!")))
((symbol-function 'crashing-backend)
(lambda (_report-fn)
;; HACK: Shoosh log during tests
(setq-local warning-minimum-log-level :emergency)
(error "crashed"))))
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing
elit, sed do eiusmod tempor incididunt ut labore et dolore
manha aliqua. Ut enim ad minim veniam, quis nostrud
exercitation ullamco laboris nisi ut aliquip ex ea commodo
consequat. Duis aute irure dolor in reprehenderit in
voluptate velit esse cillum dolore eu fugiat nulla
pariatur. Excepteur sint occaecat cupidatat non prognata
sunt in culpa qui officia deserunt mollit anim id est
laborum.")
(let ((flymake-diagnostic-functions
(list 'error-backend 'warning-backend 'sync-backend
'panicking-backend
'crashing-backend
))
(flymake-wrap-around nil))
(flymake-mode)
(flymake-tests--assert-set (flymake-running-backends)
(error-backend warning-backend panicking-backend)
(crashing-backend))
(flymake-tests--assert-set (flymake-disabled-backends)
(crashing-backend)
(error-backend warning-backend sync-backend
panicking-backend))
(flymake-tests--wait-for-backends)
(flymake-tests--assert-set (flymake-disabled-backends)
(crashing-backend panicking-backend)
(error-backend warning-backend sync-backend))
(goto-char (point-min))
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; dolor
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; ut
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; manha
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; Ut
(flymake-goto-next-error)
(should (eq 'flymake-note (face-at-point))) ; quis
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; ut
(flymake-goto-next-error)
(should (eq 'flymake-note (face-at-point))) ; commodo
(flymake-goto-next-error)
(should (eq 'flymake-warning (face-at-point))) ; dolor
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; prognata
(should-error (flymake-goto-next-error nil nil t))))))
(ert-deftest recurrent-backend ()
"Test a backend that calls REPORT-FN multiple times"
(with-temp-buffer
(let (tick)
(cl-letf
(((symbol-function 'eager-backend)
(lambda (report-fn)
(funcall report-fn nil :explanation "very eager but no diagnostics")
(display-buffer (current-buffer))
(run-with-timer
0.5 nil
(lambda ()
(flymake-tests--diagnose-words report-fn :warning '("consectetur"))
(setq tick t)
(run-with-timer
0.5 nil
(lambda ()
(flymake-tests--diagnose-words report-fn :error '("fugiat"))
(setq tick t))))))))
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing
elit, sed do eiusmod tempor incididunt ut labore et dolore
manha aliqua. Ut enim ad minim veniam, quis nostrud
exercitation ullamco laboris nisi ut aliquip ex ea commodo
consequat. Duis aute irure dolor in reprehenderit in
voluptate velit esse cillum dolore eu fugiat nulla
pariatur. Excepteur sint occaecat cupidatat non prognata
sunt in culpa qui officia deserunt mollit anim id est
laborum.")
(let ((flymake-diagnostic-functions
(list 'eager-backend))
(flymake-wrap-around nil))
(flymake-mode)
(flymake-tests--assert-set (flymake-running-backends)
(eager-backend) ())
(cl-loop until tick repeat 4 do (sleep-for 0.2))
(setq tick nil)
(goto-char (point-max))
(flymake-goto-prev-error)
(should (eq 'flymake-warning (face-at-point))) ; consectetur
(should-error (flymake-goto-prev-error nil nil t))
(cl-loop until tick repeat 4 do (sleep-for 0.2))
(flymake-goto-next-error)
(should (eq 'flymake-error (face-at-point))) ; fugiat
(flymake-goto-prev-error)
(should (eq 'flymake-warning (face-at-point))) ; back at consectetur
(should-error (flymake-goto-prev-error nil nil t))
)))))
(provide 'flymake-tests)