Merge remote-tracking branch 'savannah/master' into HEAD

This commit is contained in:
Andrea Corallo 2020-05-17 22:49:02 +01:00
commit cd4ef52c86
73 changed files with 705 additions and 1942 deletions

View file

@ -365,7 +365,7 @@ Changes to files matching one of the regexps in this list are not listed.")
"lib/stdarg.in.h" "lib/stdbool.in.h"
"unidata/bidimirror.awk" "unidata/biditype.awk"
"split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
"gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
"gnu-hp300" "refcard.bit" "forms.README" "forms-d2.dat"
"CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
"CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit"
"copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6"
@ -609,7 +609,7 @@ Changes to files in this list are not listed.")
;; No longer distributed: lselect.el.
("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el"
"bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el"
"lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
"mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
;; MCC. No longer distributed: emacsserver.c.
("Microelectronics and Computer Technology Corporation"
:changed "etags.c" "emacsclient.c" "movemail.c"
@ -773,7 +773,7 @@ Changes to files in this list are not listed.")
"erc-hecomplete.el"
"eshell/esh-maint.el"
"language/persian.el"
"ledit.el" "meese.el" "iswitchb.el" "longlines.el"
"meese.el" "iswitchb.el" "longlines.el"
"mh-exec.el" "mh-init.el" "mh-customize.el"
"net/zone-mode.el" "xesam.el"
"term/mac-win.el" "sup-mouse.el"

View file

@ -43,11 +43,12 @@ BEGIN {
END {
print ")))";
print " (mapc #'(lambda (x)";
print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
print " map)";
print " (setq map (mapcar (lambda (x)";
print " (cons (decode-char 'japanese-jisx0208 (car x))";
print " (cdr x)))";
print " map))";
print " (define-translation-table 'cp51932-decode map)";
print " (mapc #'(lambda (x)";
print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";

View file

@ -93,15 +93,17 @@ function write_entry (unicode) {
END {
print ")))";
print " (mapc #'(lambda (x)";
print " (setq map";
print " (mapcar";
print " (lambda (x)";
print " (let ((code (logand (car x) #x7F7F)))";
print " (if (integerp (cdr x))";
print " (setcar x (decode-char 'japanese-jisx0208 code))";
print " (setcar x (decode-char 'japanese-jisx0212 code))";
print " (setcdr x (cadr x)))))";
print " map)";
print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
print " (cons (decode-char 'japanese-jisx0212 code)"
print " (cadr x)))))";
print " map))";
print " (define-translation-table 'eucjp-ms-decode map)";
print " (mapc #'(lambda (x)";
print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";

View file

@ -1541,6 +1541,11 @@ putting a line like this in your init file (@pxref{Init File}):
(add-to-list 'load-path "/path/to/my/lisp/library")
@end example
It is customary to put locally installed libraries in the
@file{site-lisp} directory that is already in the default value of
@code{load-path}, or in some subdirectory of @file{site-lisp}. This
way, you don't need to modify the default value of @code{load-path}.
@cindex autoload
Some commands are @dfn{autoloaded}; when you run them, Emacs
automatically loads the associated library first. For instance, the
@ -1563,6 +1568,33 @@ Automatic loading also occurs when completing names for
prefix being completed. To disable this feature, change the variable
@code{help-enable-completion-autoload} to @code{nil}.
Once you put your library in a directory where Emacs can find and
load it, you may wish to make it available at startup. This is useful
when the library defines features that should be available
automatically on demand, and manually loading the library is thus
inconvenient. In these cases, make sure the library will be loaded by
adding suitable forms to your init file: either @code{load} or
@code{require} (if you always need to load the library at startup), or
@code{autoload} if you need Emacs to load the library when some
command or function is invoked. For example:
@smalllisp
@group
;; Loads @file{my-shining-package.elc} unconditionally.
(require 'my-shining-package)
@end group
@group
;; Will load @file{my-shining-package.elc} when @code{my-func} is invoked.
(autoload 'my-func "my-shining-package")
@end group
@end smalllisp
Note that installing a package using @code{package-install}
(@pxref{Package Installation}) takes care of placing the package's
Lisp files in a directory where Emacs will find it, and also writes
the necessary initialization code into your init files, making the
above manual customizations unnecessary.
@node Lisp Eval
@section Evaluating Emacs Lisp Expressions
@cindex Emacs Lisp mode

View file

@ -532,7 +532,7 @@ holidays centered around a different month, use @kbd{C-u M-x
holidays}, which prompts for the month and year.
The holidays known to Emacs include United States holidays and the
major Bah@'{a}@t{'}@'{i}, Chinese, Christian, Islamic, and Jewish
major Bahá'í, Chinese, Christian, Islamic, and Jewish
holidays; also the solstices and equinoxes.
@findex list-holidays

View file

@ -5,23 +5,37 @@
@node Packages
@chapter Emacs Lisp Packages
@cindex Package
@cindex Emacs Lisp package archive
@cindex Package archive
Emacs includes a facility that lets you easily download and install
@dfn{packages} that implement additional features. Each package is a
separate Emacs Lisp program, sometimes including other components such
as an Info manual.
Emacs is extended by implementing additional features in
@dfn{packages}, which are Emacs Lisp libraries. These could be
written by you or provided by someone else. If you want to install
such a package so it is available in your future Emacs session, you
need to compile it and put it in a directory where Emacs looks for
Lisp libraries. @xref{Lisp Libraries}, for more details about this
manual installation method. Many packages provide installation and
usage instructions in the large commentary near the beginning of the
Lisp file; you can use those instructions for installing and
fine-tuning your use of the package.
@kbd{M-x list-packages} brings up a buffer named @file{*Packages*}
with a list of all packages. You can install or uninstall packages
via this buffer. @xref{Package Menu}.
@cindex Emacs Lisp package archive
Packages can also be provided by @dfn{package archives}, which are
large collections of Emacs Lisp packages. Each package is a separate
Emacs Lisp program, sometimes including other components such as an
Info manual. Emacs includes a facility that lets you easily download
and install packages from such archives. The rest of this chapter
describes this facility.
To list the packages available for installation from package
archives, type @w{@kbd{M-x list-packages @key{RET}}}. It brings up a
buffer named @file{*Packages*} with a list of all packages. You can
install or uninstall packages via this buffer. @xref{Package Menu}.
The command @kbd{C-h P} (@code{describe-package}) prompts for the
name of a package, and displays a help buffer describing the
attributes of the package and the features that it implements.
By default, Emacs downloads packages from a @dfn{package archive}
By default, Emacs downloads packages from a package archive
maintained by the Emacs developers and hosted by the GNU project.
Optionally, you can also download packages from archives maintained by
third parties. @xref{Package Installation}.

View file

@ -1909,6 +1909,11 @@ omitted or @code{nil}, it defaults to 0, i.e., no access rights at
all.
@end defun
@defun file-modes-number-to-symbolic modes
This function converts a numeric file mode specification in
@var{modes} into the equivalent symbolic form.
@end defun
@defun set-file-times filename &optional time flag
This function sets the access and modification times of @var{filename}
to @var{time}. The return value is @code{t} if the times are successfully

View file

@ -613,7 +613,7 @@ The elements of the @code{command-switch-alist} look like this:
@end example
The @sc{car}, @var{option}, is a string, the name of a command-line
option (not including the initial hyphen). The @var{handler-function}
option (including the initial hyphen). The @var{handler-function}
is called to handle @var{option}, and receives the option name as its
sole argument.
@ -623,6 +623,14 @@ remaining command-line arguments in the variable
@code{command-line-args-left} (see below). (The entire list of
command-line arguments is in @code{command-line-args}.)
Note that the handling of @code{command-switch-alist} doesn't treat
equals signs in @var{option} specially. That is, if there's an option
like @code{--name=value} on the command line, then only a
@code{command-switch-alist} member whose @code{car} is literally
@code{--name=value} will match this option. If you want to parse such
options, you need to use @code{command-line-functions} instead (see
below).
The command-line arguments are parsed by the @code{command-line-1}
function in the @file{startup.el} file. See also @ref{Emacs
Invocation, , Command Line Arguments for Emacs Invocation, emacs, The

View file

@ -477,6 +477,22 @@ You should only ever change this variable with a let-binding; never
with @code{setq}.
@end defvar
@defopt process-file-return-signal-string
This user option indicates whether a call of @code{process-file}
returns a string describing the signal interrupting a remote process.
When a process returns an exit code greater than 128, it is
interpreted as a signal. @code{process-file} requires to return a
string describing this signal.
Since there are processes violating this rule, returning exit codes
greater than 128 which are not bound to a signal, @code{process-file}
returns always the exit code as natural number for remote processes.
Setting this user option to non-nil forces @code{process-file} to
interpret such exit codes as signals, and to return a corresponding
string.
@end defopt
@defun call-process-region start end program &optional delete destination display &rest args
This function sends the text from @var{start} to @var{end} as
standard input to a process running @var{program}. It deletes the text

View file

@ -3463,22 +3463,16 @@ see @ref{Packages that do not come with Emacs}.
@cindex Emacs Lisp List
@cindex Emacs Lisp Archive
The easiest way to add more features to your Emacs is to use the
command @kbd{M-x list-packages}. This contacts the
@uref{https://elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'')
server and fetches the list of additional packages that it offers.
These are GNU packages that are available for use with Emacs, but are
distributed separately from Emacs itself, for reasons of space, etc.
You can browse the resulting @file{*Packages*} buffer to see what is
available, and then Emacs can automatically download and install the
packages that you select. @xref{Packages,,, emacs, The GNU Emacs Manual}.
There are other, non-GNU, Emacs Lisp package servers, including:
@uref{https://melpa.org, MELPA}; and
@uref{https://marmalade-repo.org, Marmalade}. To use additional
package servers, customize the @code{package-archives} variable. Be
aware that installing a package can run arbitrary code, so only add
sources that you trust.
We distribute many packages that extend Emacs, in the
@uref{https://elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package
Archive''). The command @kbd{M-x list-packages} contacts the GNU ELPA
server and fetches the list of packages that it distributes. These
GNU packages are designed for use with Emacs, but we distribute them
separately from Emacs itself, for reasons of space, and convenience of
development. You can browse the resulting @file{*Packages*} buffer to
see what is available, and then Emacs can automatically download and
install the packages that you select. @xref{Packages,,, emacs, The
GNU Emacs Manual}.
The @uref{https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources,
GNU Emacs sources mailing list}, which is gatewayed to the

View file

@ -917,7 +917,7 @@ Here's an example:
@lisp
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
(setq gnus-parameters
(nconc
(append
;; Some charsets are just examples!
'(("^cn\\." ;; Chinese
(mm-coding-system-priorities

View file

@ -158,6 +158,9 @@ this package.
The following persons have made contributions to Eshell.
@itemize @bullet
@item
John Wiegley is the original author of Eshell.
@item
Eli Zaretskii made it possible for Eshell to run without requiring
asynchronous subprocess support. This is important for MS-DOS, which

View file

@ -318,14 +318,14 @@ behind the scenes when you open a file with @value{tramp}.
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@value{tramp} can be obtained by the variable @code{tramp-version}.
For released @value{tramp} versions, this is a three-number string
like ``2.4.2''.
like ``2.4.3''.
A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
as suffix, like ``2.3.5.26.3''. This means @w{@value{tramp} 2.3.5} as
integrated in @w{Emacs 26.3}. A complete list of @value{tramp}
as suffix, like ``2.4.3.27.1''. This means @w{@value{tramp} 2.4.3} as
integrated in @w{Emacs 27.1}. A complete list of @value{tramp}
versions packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@ -337,12 +337,12 @@ versions packaged with Emacs can be retrieved by
ELPA} package. Besides the standalone releases, further minor version
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
``2.4.2.1''.
``2.4.3.1''.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
development version of @value{tramp} is always the version number of
the next release, plus the suffix ``-pre'', like ``2.4.3-pre''.
the next release, plus the suffix ``-pre'', like ``2.4.4-pre''.
One way to obtain @value{tramp} from Git server is to visit the
Savannah project page at the following URL and then clicking on the
@ -2315,7 +2315,7 @@ string of that environment variable looks always like
@example
@group
echo $INSIDE_EMACS
@result{} 26.2,tramp:2.3.4
@result{} 27.1,tramp:2.4.3
@end group
@end example
@ -3050,6 +3050,17 @@ host when the variable @code{default-directory} is remote:
@end group
@end lisp
@vindex process-file-return-signal-string
@code{process-file} shall return either the exit code of the process,
or a string describing the signal, when the process has been
interrupted. Since it cannot be determined reliably whether a remote
process has been interrupted, @code{process-file} returns always the
exit code. When the user option
@code{process-file-return-signal-string} is non-nil,
@code{process-file} regards all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
respective string.
Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
methods}) because the remote file system is mounted on the local host
and @value{tramp} just accesses by changing the
@ -3057,9 +3068,17 @@ and @value{tramp} just accesses by changing the
@value{tramp} starts a remote process when a command is executed in a
remote file or directory buffer. As of now, these packages have been
integrated to work with @value{tramp}: @file{compile.el} (commands
like @code{compile} and @code{grep}) and @file{gud.el} (@code{gdb} or
@code{perldb}).
integrated to work with @value{tramp}: @file{shell.el},
@file{eshell.el}, @file{compile.el} (commands like @code{compile} and
@code{grep}) and @file{gud.el} (@code{gdb} or @code{perldb}).
@vindex INSIDE_EMACS@r{, environment variable}
@value{tramp} always modifies the @env{INSIDE_EMACS} environment
variable for remote processes. Per default, this environment variable
shows the Emacs version. @value{tramp} adds its own version string,
so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages
might also add their name to this environment variable, like
@samp{27.1,comint,tramp:2.4.3.1}.
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
@ -3254,7 +3273,7 @@ variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
If Emacs supports the variable @code{async-shell-command-width} (since
@w{Emacs 27.1}), @value{tramp} cares about its value for asynchronous
@w{Emacs 27}), @value{tramp} cares about its value for asynchronous
shell commands. It specifies the number of display columns for
command output. For synchronous shell commands, a similar effect can
be achieved by adding the environment variable @env{COLUMNS} to
@ -3741,7 +3760,7 @@ row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}.
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
@ -3752,7 +3771,7 @@ the similar @samp{/scp:user@@host:...}. See the constant
If @code{url-handler-mode} is enabled, archives could be visited via
URLs, like
@file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. This
@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This
allows complex file operations like
@lisp
@ -3760,8 +3779,8 @@ allows complex file operations like
(progn
(url-handler-mode 1)
(ediff-directories
"https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1"
"https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" ""))
"https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2"
"https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3" ""))
@end group
@end lisp

107
etc/NEWS
View file

@ -101,19 +101,23 @@ horizontal movements now stop at the edge of the board.
* Changes in Specialized Modes and Packages in Emacs 28.1
** EIEIO: 'oset' and 'oset-default' are declared obsolete
** EIEIO: 'oset' and 'oset-default' are declared obsolete.
** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'
** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
** archive-mode
*** Can now modify members of 'ar' archives.
*** Display of summaries unified between backends
*** New var 'archive-hidden-columns' and cmd 'archive-hideshow-column'
These let you control which columns are displayed and which are kept hidden
** Archive mode
** Emacs-Lisp mode
*** Can now modify members of 'ar' archives.
*** Display of summaries unified between backends.
*** New user option 'archive-hidden-columns' and command
'archive-hideshow-column'. These let you control which columns are
displayed and which are kept hidden.
** Emacs Lisp mode
*** The mode-line now indicates whether we're using lexical or dynamic scoping.
@ -158,7 +162,7 @@ this user option.
This file was a compatibility kludge which is no longer needed.
---
** 'lisp-mode' now uses 'common-lisp-indent-function'.
** Lisp mode now uses 'common-lisp-indent-function'.
To revert to the previous behaviour,
'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
@ -184,7 +188,7 @@ their backends.
** Eshell
---
*** Environment variable INSIDE_EMACS is now copied to subprocesses.
*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
** Tramp
@ -240,7 +244,7 @@ it after GDB quits. A toggle button is also provided under 'Gud --
GDB-Windows'.
+++
*** gdb-mi now has a better logic for displaying source buffers
*** gdb-mi now has a better logic for displaying source buffers.
Now GDB only uses one source window to display source file by default.
Customize 'gdb-max-source-window-count' to use more than one window.
Control source file display by 'gdb-display-source-buffer-action'.
@ -259,11 +263,11 @@ case-insensitive matching of messages when the old behaviour is
required, but the recommended solution is to use a correctly matching
regexp instead.
** Hi-Lock
** Hi Lock mode
---
*** Matching in 'hi-lock-mode' is case-sensitive when regexp contains
upper case characters and `search-upper-case' is non-nil.
upper case characters and 'search-upper-case' is non-nil.
'highlight-phrase' also uses 'search-whitespace-regexp'
to substitute spaces in regexp search.
@ -274,13 +278,13 @@ The new default value is 2000000 (2 megabytes).
** Texinfo
---
*** New customizable option 'texinfo-texi2dvi-options'.
*** New user option 'texinfo-texi2dvi-options'.
This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'.
** Rmail
---
*** New customizable option 'rmail-re-abbrevs'.
*** New user option 'rmail-re-abbrevs'.
Its default value matches localized abbreviations of the "reply"
prefix on the Subject line in various languages.
@ -290,13 +294,13 @@ prefix on the Subject line in various languages.
These new navigation commands are bound to 'n' and 'p' in
'apropos-mode'.
** cc-mode
** CC mode
*** Added support for Doxygen documentation style.
doxygen is now valid c-doc-comment-style which recognises all
comment styles supported by Doxygen (namely ///, //!, /** … */
and /*! … */. gtkdoc remains the default for C and C++ modes; to
use doxygen by default one might evaluate:
'doxygen' is now a valid 'c-doc-comment-style' which recognises all
comment styles supported by Doxygen (namely '///', '//!', '/** … */'
and '/*! … */'. 'gtkdoc' remains the default for C and C++ modes; to
use 'doxygen' by default one might evaluate:
(setq-default c-doc-comment-style
'((java-mode . javadoc)
@ -304,17 +308,17 @@ use doxygen by default one might evaluate:
(c-mode . doxygen)
(c++-mode . doxygen)))
or use it in a custom c-style.
or use it in a custom 'c-style'.
*** Added support to line up ? and : of a ternary operator.
The new c-lineup-ternary-bodies function can be used as a lineup
*** Added support to line up '?' and ':' of a ternary operator.
The new 'c-lineup-ternary-bodies' function can be used as a lineup
function to align question mark and colon which are part of a ternary
operator (?:). For example:
operator ('?:'). For example:
return arg % 2 == 0 ? arg / 2
: (3 * arg + 1);
To enable, add it to appropriate entries in c-offsets-alist, e.g.:
To enable, add it to appropriate entries in 'c-offsets-alist', e.g.:
(c-set-offset 'arglist-cont '(c-lineup-ternary-bodies
c-lineup-gcc-asm-reg))
@ -325,20 +329,21 @@ To enable, add it to appropriate entries in c-offsets-alist, e.g.:
** browse-url
*** Added support for custom URL handlers
*** Added support for custom URL handlers.
There is a new defvar 'browse-url-default-handlers' and a defcustom
'browse-url-handlers' being alists with (REGEXP-OR-PREDICATE
. FUNCTION) entries allowing to define different browsing FUNCTIONs
depending on the URL to be browsed. The defvar is for default
handlers provided by Emacs itself or external packages, the defcustom
is for the user (and allows for overriding the default handlers).
There is a new variable 'browse-url-default-handlers' and a user
option 'browse-url-handlers' being alists with '(REGEXP-OR-PREDICATE
. FUNCTION)' entries allowing to define different browsing FUNCTIONs
depending on the URL to be browsed. The variable is for default
handlers provided by Emacs itself or external packages, the user
option is for the user (and allows for overriding the default
handlers).
Formerly, one could do the same by setting
'browse-url-browser-function' to such an alist. This usage is still
supported but deprecated.
*** Categorization of browsing functions in internal vs. external
*** Categorization of browsing functions in internal vs. external.
All standard browsing functions such as 'browse-url-firefox',
'browse-url-mail', or 'eww' have been categorized into internal (URL
@ -351,10 +356,11 @@ either an internal or external browser.
* New Modes and Packages in Emacs 28.1
*** Lisp Data mode
** Lisp Data mode
The new command 'lisp-data-mode' enables a major mode for buffers
composed of Lisp symbolic expressions that do not form a computer
program. The '.dir-locals.el' file is automatically set to use this
program. The ".dir-locals.el" file is automatically set to use this
mode, as are other data files produced by Emacs.
@ -397,9 +403,17 @@ This is no longer supported, and setting this variable has no effect.
** The macro 'with-displayed-buffer-window' is now obsolete.
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
---
** Some libraries obsolete since Emacs 23 have been removed:
'ledit.el', 'lmenu.el', 'lucid.el and 'old-whitespace.el'.
* Lisp Changes in Emacs 28.1
+++
** New function 'file-modes-number-to-symbolic' to convert a numeric
file mode specification into symbolic form.
** New macro 'dlet' to dynamically bind variables.
** The variable 'force-new-style-backquotes' has been removed.
@ -428,23 +442,28 @@ such as "2020-01-15T16:12:21-08:00".
** The new function 'dom-remove-attribute' has been added.
---
** 'make-network-process', 'make-serial-process' :coding behavior change.
Previously, passing ":coding nil" to either of these functions would
** 'make-network-process', 'make-serial-process' ':coding' behavior change.
Previously, passing ':coding nil' to either of these functions would
override any non-nil binding for 'coding-system-for-read' and
'coding-system-for-write'. For consistency with 'make-process' and
'make-pipe-process', passing ":coding nil" is now ignored. No code in
'make-pipe-process', passing ':coding nil' is now ignored. No code in
Emacs depended on the previous behavior; if you really want the
process' coding-system to be nil, use 'set-process-coding-system'
after the process has been created, or pass in ":coding '(nil nil)".
after the process has been created, or pass in ':coding '(nil nil)'.
+++
** 'open-network-stream' now accepts a :coding argument.
** 'open-network-stream' now accepts a ':coding' argument.
This allows specifying the coding systems used by a network process
for encoding and decoding without having to bind
coding-system-for-{read,write} or call 'set-process-coding-system'.
'coding-system-for-{read,write}' or call 'set-process-coding-system'.
+++
** 'open-gnutls-stream' now also accepts a :coding argument.
** 'open-gnutls-stream' now also accepts a ':coding' argument.
+++
** New user option 'process-file-return-signal-string'.
It controls, whether 'process-file' returns a string when a remote
process is interrupted by a signal.
* Changes in Emacs 28.1 on Non-Free Operating Systems
@ -465,12 +484,12 @@ current IME activation status.
** On MS-Windows, Emacs can now use the native image API to display images.
Emacs can now use the MS-Windows GDI+ library to load and display
images in JPEG, PNG, GIF and TIFF formats. This support is enabled
unless Emacs was configured --without-native-image-api.
unless Emacs was configured '--without-native-image-api'.
This feature is experimental, and needs to be turned on to be used.
To turn this on, set the variable 'w32-use-native-image-API' to a
non-nil value. Please report any bugs you find while using the native
image API via "M-x report-emacs-bug".
image API via 'M-x report-emacs-bug'.
----------------------------------------------------------------------

View file

@ -63,6 +63,13 @@
`(button ((,class (:underline t))))
`(link ((,class (:foreground "#59e9ff" :underline t))))
`(link-visited ((,class (:foreground "#ed74cd" :underline t))))
;; Ediff
`(ediff-even-diff-A ((,class (:background "#1d2430"))))
`(ediff-even-diff-B ((,class (:background "#1d2430"))))
`(ediff-even-diff-C ((,class (:background "#1d2430"))))
`(ediff-odd-diff-A ((,class (:background "#415160"))))
`(ediff-odd-diff-B ((,class (:background "#415160"))))
`(ediff-odd-diff-C ((,class (:background "#415160"))))
;; Gnus faces
`(gnus-group-news-1 ((,class (:foreground "#ff4242" :weight bold))))
`(gnus-group-news-1-low ((,class (:foreground "#ff4242"))))

View file

@ -255,11 +255,7 @@ have been saved."
(if (abbrev--table-symbols table)
(insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
(setq coding-system-for-write
(if (> emacs-major-version 24)
'utf-8-emacs
;; For compatibility with Emacs 22 (See Bug#8308)
'emacs-mule)))
(setq coding-system-for-write 'utf-8-emacs))
(goto-char (point-min))
(insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
(write-region nil nil file nil (and (not verbose) 0)))))

View file

@ -563,28 +563,8 @@ in which case a second argument, length LEN, should be supplied."
(aref str (- len i)))))
result))
(defun archive-int-to-mode (mode)
"Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
;; FIXME: merge with tar-grind-file-mode.
(if (null mode)
"??????????"
(string
(if (zerop (logand 8192 mode))
(if (zerop (logand 16384 mode)) ?- ?d)
?c) ; completeness
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
(if (zerop (logand 2048 mode)) ?- ?S)
(if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
(if (zerop (logand 1024 mode)) ?- ?S)
(if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 1 mode)) ?- ?x))))
(define-obsolete-function-alias 'archive-int-to-mode
'file-modes-number-to-symbolic "28.1")
(defun archive-calc-mode (oldmode newmode)
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
@ -1526,7 +1506,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(timelen (length (archive--file-desc-time sample)))
(samplemode (and (archive--enabled-p 'Mode)
(archive--file-desc-mode sample)))
(modelen (length (if samplemode (archive-int-to-mode samplemode)))))
(modelen (length (if samplemode (file-modes-number-to-symbolic samplemode)))))
(dolist (desc descs)
(when ids
(let* ((uid (archive--file-desc-uid desc))
@ -1573,7 +1553,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(text
(concat " "
(when (> modelen 0)
(concat (archive-int-to-mode
(concat (file-modes-number-to-symbolic
(archive--file-desc-mode desc))
" "))
(when ids

View file

@ -1723,7 +1723,7 @@ deletion, or > if it is flagged for displaying."
;; according to `bookmark-bookmarks-timestamp'.
(defun bookmark-bmenu-set-header ()
"Set the immutable header line."
(let ((header (concat "%% " "Bookmark")))
(let ((header (copy-sequence "%% Bookmark")))
(when bookmark-bmenu-toggle-filenames
(setq header (concat header
(make-string (- bookmark-bmenu-file-column

View file

@ -349,7 +349,7 @@ Also see `insert-text-button'."
(or (plist-member properties 'type)
(plist-member properties :type))))
(when (stringp beg)
(setq object beg beg 0 end (length object)))
(setq object (copy-sequence beg) beg 0 end (length object)))
;; Disallow setting the `category' property directly.
(when (plist-get properties 'category)
(error "Button `category' property may not be set directly"))

View file

@ -241,8 +241,8 @@
(calcFunc-gcd (math-neg a) b))
((Math-looks-negp b)
(calcFunc-gcd a (math-neg b)))
((Math-zerop a) b)
((Math-zerop b) a)
((Math-zerop a) (math-abs b))
((Math-zerop b) (math-abs a))
((and (Math-ratp a)
(Math-ratp b))
(math-make-frac (math-gcd (if (eq (car-safe a) 'frac) (nth 1 a) a)

View file

@ -275,7 +275,7 @@ in LUD decomposition."
k (1+ k)))
(setcar (nthcdr j (nth i lu)) sum)
(let ((dum (math-lud-pivot-check sum)))
(if (Math-lessp big dum)
(if (or (math-zerop big) (Math-lessp big dum))
(setq big dum
imax i)))
(setq i (1+ i)))

View file

@ -49,9 +49,9 @@
;;; Compatibility
;;
(defalias 'data-debug-overlay-properties 'overlay-properties)
(defalias 'data-debug-overlay-p 'overlayp)
(defalias 'dd-propertize 'propertize)
(define-obsolete-function-alias 'data-debug-overlay-properties 'overlay-properties "28.1")
(define-obsolete-function-alias 'data-debug-overlay-p 'overlayp "28.1")
(define-obsolete-function-alias 'dd-propertize 'propertize "28.1")
;;; GENERIC STUFF
;;
@ -73,7 +73,7 @@ The attributes belong to the tag PARENT."
"Insert all the parts of OVERLAY.
PREFIX specifies what to insert at the start of each line."
(let ((attrprefix (concat (make-string (length prefix) ? ) "# "))
(proplist (data-debug-overlay-properties overlay)))
(proplist (overlay-properties overlay)))
(data-debug-insert-property-list
proplist attrprefix)
)
@ -393,10 +393,10 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(lambda (key value)
(data-debug-insert-thing
key prefix
(dd-propertize "key " 'face font-lock-comment-face))
(propertize "key " 'face font-lock-comment-face))
(data-debug-insert-thing
value prefix
(dd-propertize "val " 'face font-lock-comment-face)))
(propertize "val " 'face font-lock-comment-face)))
hash-table))
(defun data-debug-insert-hash-table-from-point (point)
@ -415,9 +415,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(defun data-debug-insert-hash-table-button (hash-table prefix prebuttontext)
"Insert HASH-TABLE as expandable button with recursive prefix PREFIX and PREBUTTONTEXT in front of the button text."
(let ((string (dd-propertize (format "%s" hash-table)
(let ((string (propertize (format "%s" hash-table)
'face 'font-lock-keyword-face)))
(insert (dd-propertize
(insert (propertize
(concat prefix prebuttontext string)
'ddebug hash-table
'ddebug-indent (length prefix)
@ -444,7 +444,7 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(data-debug-insert-thing (car (cdr rest))
prefix
(concat
(dd-propertize (format "%s" (car rest))
(propertize (format "%s" (car rest))
'face font-lock-comment-face)
" : "))
(setq rest (cdr (cdr rest))))
@ -468,9 +468,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
(let ((string (dd-propertize (format "#<WIDGET %s>" (car widget))
(let ((string (propertize (format "#<WIDGET %s>" (car widget))
'face 'font-lock-keyword-face)))
(insert (dd-propertize
(insert (propertize
(concat prefix prebuttontext string)
'ddebug widget
'ddebug-indent (length prefix)
@ -613,7 +613,7 @@ PREBUTTONTEXT is some text between prefix and the stuff vector button."
(symbol-value symbol)
(concat (make-string indent ? ) "> ")
(concat
(dd-propertize "value"
(propertize "value"
'face 'font-lock-comment-face)
" ")))
(data-debug-insert-property-list
@ -628,13 +628,13 @@ PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the symbol button."
(let ((string
(cond ((fboundp symbol)
(dd-propertize (concat "#'" (symbol-name symbol))
(propertize (concat "#'" (symbol-name symbol))
'face 'font-lock-function-name-face))
((boundp symbol)
(dd-propertize (concat "'" (symbol-name symbol))
(propertize (concat "'" (symbol-name symbol))
'face 'font-lock-variable-name-face))
(t (format "'%s" symbol)))))
(insert (dd-propertize
(insert (propertize
(concat prefix prebuttontext string)
'ddebug symbol
'ddebug-indent (length prefix)
@ -657,7 +657,7 @@ PREBUTTONTEXT is some text between prefix and the thing."
(while (string-match "\t" newstr)
(setq newstr (replace-match "\\t" t t newstr)))
(insert prefix prebuttontext
(dd-propertize (format "\"%s\"" newstr)
(propertize (format "\"%s\"" newstr)
'face font-lock-string-face)
"\n" )))
@ -668,7 +668,7 @@ A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
(insert prefix prebuttontext
(dd-propertize (format "%S" thing)
(propertize (format "%S" thing)
'face font-lock-string-face)
"\n"))
@ -737,10 +737,10 @@ FACE is the face to use."
(null . data-debug-insert-nil)
;; Overlay
(data-debug-overlay-p . data-debug-insert-overlay-button)
(overlayp . data-debug-insert-overlay-button)
;; Overlay list
((lambda (thing) (and (consp thing) (data-debug-overlay-p (car thing)))) .
((lambda (thing) (and (consp thing) (overlayp (car thing)))) .
data-debug-insert-overlay-list-button)
;; Buffer

View file

@ -3053,7 +3053,7 @@ one.")
(defsubst wisent-ISVALID-TOKEN (x)
"Return non-nil if X is a character or an allowed symbol."
(or (wisent-char-p x)
(or (characterp x)
(wisent-ISVALID-VAR x)))
(defun wisent-push-token (symbol &optional nocheck)
@ -3143,7 +3143,7 @@ the rule."
(cond
((or (memq item token-list) (memq item var-list)))
;; Create new literal character token
((wisent-char-p item) (wisent-push-token item t))
((characterp item) (wisent-push-token item t))
((error "Symbol `%s' is used, but is not defined as a token and has no rules"
item))))
(setq rhl (1+ rhl)

View file

@ -55,11 +55,8 @@
;;;; Runtime stuff
;;;; -------------
;;; Compatibility
(eval-and-compile
(if (fboundp 'char-valid-p)
(defalias 'wisent-char-p 'char-valid-p)
(defalias 'wisent-char-p 'char-or-char-int-p)))
(define-obsolete-function-alias 'wisent-char-p
#'characterp "28.1")
;;; Printed representation of terminals and nonterminals
(defconst wisent-escape-sequence-strings
@ -80,7 +77,7 @@
(defsubst wisent-item-to-string (item)
"Return a printed representation of ITEM.
ITEM can be a nonterminal or terminal symbol, or a character literal."
(if (wisent-char-p item)
(if (characterp item)
(or (cdr (assq item wisent-escape-sequence-strings))
(format "'%c'" item))
(symbol-name item)))

View file

@ -2006,10 +2006,9 @@ Optional arg HOW-TO determines how to treat the target.
(format prompt (dired-mark-prompt arg files)) dir default))
(defun dired-dwim-target-directories ()
(cond ((functionp dired-dwim-target)
(funcall dired-dwim-target))
(dired-dwim-target
(dired-dwim-target-next))))
(if (functionp dired-dwim-target)
(funcall dired-dwim-target)
(dired-dwim-target-next)))
(defun dired-dwim-target-next (&optional all-frames)
;; Return directories from all next windows with dired-mode buffers.

View file

@ -3717,8 +3717,8 @@ in the active region."
(defun dired-toggle-marks ()
"Toggle marks: marked files become unmarked, and vice versa.
Files marked with other flags (such as `D') are not affected.
`.' and `..' are never toggled.
Flagged files (indicated with flags such as `C' and `D', not
with `*') are not affected, and `.' and `..' are never toggled.
As always, hidden subdirs are not affected."
(interactive)
(save-excursion

View file

@ -1509,7 +1509,7 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
(nconc
(append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate

View file

@ -1221,7 +1221,6 @@ These two lines must come in the order given."))
(viper-harness-minor-mode "outline")
(viper-harness-minor-mode "allout")
(viper-harness-minor-mode "xref")
(viper-harness-minor-mode "lmenu")
(viper-harness-minor-mode "vc")
(viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which
(viper-harness-minor-mode "latex") ; sits in one of these two files

View file

@ -1607,7 +1607,7 @@ Each ALIST entry looks like (STRING . DATA) and defines one choice.
Function CONT is applied to the entry chosen by the user."
;; Note: this function is used with a different continuation
;; by the ffap-url add-on package.
;; Could try rewriting to use easymenu.el or lmenu.el.
;; Could try rewriting to use easymenu.el.
(let (choice)
(cond
;; Emacs mouse:

View file

@ -7552,6 +7552,27 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
(defun file-modes-number-to-symbolic (mode)
(string
(if (zerop (logand 8192 mode))
(if (zerop (logand 16384 mode)) ?- ?d)
?c) ; completeness
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
(if (zerop (logand 2048 mode)) ?- ?S)
(if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
(if (zerop (logand 1024 mode)) ?- ?S)
(if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 512 mode))
(if (zerop (logand 1 mode)) ?- ?x)
(if (zerop (logand 1 mode)) ?T ?t))))
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match

View file

@ -396,7 +396,7 @@ Properties can be set with
;; or, if you're only changing a few items,
;;
;; (defvar my-filter-alist
;; (nconc '((my-param1 . :never)
;; (append '((my-param1 . :never)
;; (my-param2 . my-filtering-function))
;; frameset-filter-alist)
;; "My brief customized parameter filter alist.")
@ -405,7 +405,7 @@ Properties can be set with
;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use
;;
;; (nconc '((my-param1 . :never) ...)
;; (append '((my-param1 . :never) ...)
;; (copy-sequence frameset-filter-alist))
;;
;; One thing you shouldn't forget is that they are alists, so searching
@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
;;;###autoload
(defvar frameset-persistent-filter-alist
(nconc
(append
'((background-color . frameset-filter-sanitize-color)
(buffer-list . :never)
(buffer-predicate . :never)

View file

@ -1501,7 +1501,7 @@ the type of the variable (string, integer, character, etc).")
;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist
(nconc '((?w (gnus-article-wash-status) ?s)
(append '((?w (gnus-article-wash-status) ?s)
(?m (gnus-article-mime-part-status) ?s))
gnus-summary-mode-line-format-alist))

View file

@ -11,9 +11,6 @@
;; Created: 2002-01-05
;; Description: htmlize a buffer/source tree with optional hyperlinks
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Compatibility: Emacs23, Emacs22
;; Incompatibility: Emacs19, Emacs20, Emacs21
;; Last Updated: Thu 2009-11-19 01:31:21 +0000
;; This file is part of GNU Emacs.

View file

@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
(mapc #'(lambda (x) (let ((tmp (car x)))
(setcar x (cdr x)) (setcdr x tmp)))
map)
(setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
@ -241,8 +239,10 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9])))
table)
(dolist (elt map)
(setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
(setq map
(mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
(cdr x)))
map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213

View file

@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist
(sort '(;; single consonants
(sort
(copy-sequence
'(;; single consonants
("k" . "")
("kh" . "")
("qh" . "")
@ -223,14 +225,16 @@
("hy" . ["ຫຍ"])
("hn" . ["ຫນ"])
("hm" . ["ຫມ"])
)
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
))
(lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist
'(("r" . "")))
(defconst lao-transcription-vowel-alist
(sort '(("a" . "")
(sort
(copy-sequence
'(("a" . "")
("ar" . "")
("i" . "")
("ii" . "")
@ -257,8 +261,8 @@
("ai" . "")
("ei" . "")
("ao" . ["ເົາ"])
("aM" . ""))
(function (lambda (x y) (> (length (car x)) (length (car y)))))))
("aM" . "")))
(lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist

View file

@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist
(sort '(("+k" . "")
(sort
(copy-sequence
'(("+k" . "")
("+kh" . "")
("+g" . "")
("+gh" . "")
@ -371,7 +373,7 @@
("+W" . "") ;; fixed form subscribed WA
("+Y" . "") ;; fixed form subscribed YA
("+R" . "") ;; fixed form subscribed RA
)
))
(lambda (x y) (> (length (car x)) (length (car y))))))
;;;

View file

@ -2556,7 +2556,7 @@ region, text is copied instead of being cut."
(lambda (modifier)
`(const :tag ,(format "Enable, but copy with the %s modifier"
modifier)
modifier))
,modifier))
'(alt super hyper shift control meta))
(other :tag "Enable dragging the region" t))
:version "26.1")
@ -2575,9 +2575,12 @@ as it does when dropping text in the source buffer."
If this option is nil, `mouse-drag-and-drop-region' does not show
tooltips. If this is t, it shows the entire text dragged in a
tooltip. If this is an integer (as with the default value of
256), it will show that many characters of the dragged text in
a tooltip."
:type 'integer
256), it will show up to that many characters of the dragged text
in a tooltip."
:type '(choice
(const :tag "Do not show tooltips" nil)
(const :tag "Show all text" t)
(integer :tag "Show characters (max)" 256))
:version "26.1")
(defcustom mouse-drag-and-drop-region-show-cursor t
@ -2611,6 +2614,7 @@ is copied instead of being cut."
(let* ((mouse-button (event-basic-type last-input-event))
(mouse-drag-and-drop-region-show-tooltip
(when (and mouse-drag-and-drop-region-show-tooltip
(> mouse-drag-and-drop-region-show-tooltip 0)
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))

View file

@ -918,9 +918,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals.
(when (and (natnump ret) (> ret 128))
(setq ret (format "Signal %d" (- ret 128))))
;; Handle signals. `process-file-return-signal-string' exists
;; since Emacs 28.1.
(when (and (bound-and-true-p process-file-return-signal-string)
(natnump ret) (> ret 128))
(setq ret (nth (- ret 128) (tramp-get-signal-strings))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))

View file

@ -3159,9 +3159,11 @@ STDERR can also be a file name."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals.
(when (and (natnump ret) (> ret 128))
(setq ret (format "Signal %d" (- ret 128))))
;; Handle signals. `process-file-return-signal-string' exists
;; since Emacs 28.1.
(when (and (bound-and-true-p process-file-return-signal-string)
(natnump ret) (>= ret 128))
(setq ret (nth (- ret 128) (tramp-get-signal-strings))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))

View file

@ -5047,6 +5047,23 @@ name of a process or buffer, or nil to default to the current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
(defun tramp-get-signal-strings ()
"Strings to return by `process-file' in case of signals."
;; We use key nil for local connection properties.
(with-tramp-connection-property nil "signal-strings"
(let (result)
(if (and (stringp shell-file-name) (executable-find shell-file-name))
(dotimes (i 128)
(push
(if (= i 19) 1 ;; SIGSTOP
(call-process
shell-file-name nil nil nil "-c" (format "kill -%d $$" i)))
result))
(dotimes (i 128)
(push (format "Signal %d" i) result)))
;; Due to Bug#41287, we cannot add this to the `dotimes' clause.
(reverse result))))
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'

View file

@ -1,157 +0,0 @@
;;; ledit.el --- Emacs side of ledit interface
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages
;; Obsolete-since: 24.3
;; 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:
;; This is a major mode for editing Liszt.
;;; Code:
;;; To do:
;;; o lisp -> emacs side of things (grind-definition and find-definition)
(defvar ledit-mode-map nil)
(defconst ledit-zap-file
(expand-file-name (concat (user-login-name) ".l1") temporary-file-directory)
"File name for data sent to Lisp by Ledit.")
(defconst ledit-read-file
(expand-file-name (concat (user-login-name) ".l2") temporary-file-directory)
"File name for data sent to Ledit by Lisp.")
(defconst ledit-compile-file
(expand-file-name (concat (user-login-name) ".l4") temporary-file-directory)
"File name for data sent to Lisp compiler by Ledit.")
(defconst ledit-buffer "*LEDIT*"
"Name of buffer in which Ledit accumulates data to send to Lisp.")
;;;###autoload
(defconst ledit-save-files t "\
*Non-nil means Ledit should save files before transferring to Lisp.")
;;;###autoload
(defconst ledit-go-to-lisp-string "%?lisp" "\
*Shell commands to execute to resume Lisp job.")
;;;###autoload
(defconst ledit-go-to-liszt-string "%?liszt" "\
*Shell commands to execute to resume Lisp compiler job.")
(defun ledit-save-defun ()
"Save the current defun in the ledit buffer."
(interactive)
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(append-to-buffer ledit-buffer (point) end))
(message "Current defun saved for Lisp")))
(defun ledit-save-region (beg end)
"Save the current region in the ledit buffer"
(interactive "r")
(append-to-buffer ledit-buffer beg end)
(message "Region saved for Lisp"))
(defun ledit-zap-defun-to-lisp ()
"Carry the current defun to Lisp."
(interactive)
(ledit-save-defun)
(ledit-go-to-lisp))
(defun ledit-zap-defun-to-liszt ()
"Carry the current defun to liszt."
(interactive)
(ledit-save-defun)
(ledit-go-to-liszt))
(defun ledit-zap-region-to-lisp (beg end)
"Carry the current region to Lisp."
(interactive "r")
(ledit-save-region beg end)
(ledit-go-to-lisp))
(defun ledit-go-to-lisp ()
"Suspend Emacs and restart a waiting Lisp job."
(interactive)
(if ledit-save-files
(save-some-buffers))
(if (get-buffer ledit-buffer)
(with-current-buffer ledit-buffer
(goto-char (point-min))
(write-region (point-min) (point-max) ledit-zap-file)
(erase-buffer)))
(suspend-emacs ledit-go-to-lisp-string)
(load ledit-read-file t t))
(defun ledit-go-to-liszt ()
"Suspend Emacs and restart a waiting Liszt job."
(interactive)
(if ledit-save-files
(save-some-buffers))
(if (get-buffer ledit-buffer)
(with-current-buffer ledit-buffer
(goto-char (point-min))
(insert "(declare (macros t))\n")
(write-region (point-min) (point-max) ledit-compile-file)
(erase-buffer)))
(suspend-emacs ledit-go-to-liszt-string)
(load ledit-read-file t t))
(defun ledit-setup ()
"Set up key bindings for the Lisp/Emacs interface."
(unless ledit-mode-map
(setq ledit-mode-map (make-sparse-keymap))
(set-keymap-parent ledit-mode-map lisp-mode-shared-map))
(define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
(define-key ledit-mode-map "\e\^r" 'ledit-save-region)
(define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
(define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
(ledit-setup)
;;;###autoload
(defun ledit-mode ()
"\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
Like Lisp mode, plus these special commands:
\\[ledit-save-defun] -- record defun at or after point
for later transmission to Lisp job.
\\[ledit-save-region] -- record region for later transmission to Lisp job.
\\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
\\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
and transmit saved text.
\\{ledit-mode-map}
To make Lisp mode automatically change to Ledit mode,
do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
(interactive)
(delay-mode-hooks (lisp-mode))
(ledit-from-lisp-mode))
;;;###autoload
(defun ledit-from-lisp-mode ()
(use-local-map ledit-mode-map)
(setq mode-name "Ledit")
(setq major-mode 'ledit-mode)
(run-mode-hooks 'ledit-mode-hook))
(provide 'ledit)
;;; ledit.el ends here

View file

@ -1,445 +0,0 @@
;;; lmenu.el --- emulate Lucid's menubar support
;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation,
;; Inc.
;; Keywords: emulations obsolete
;; Obsolete-since: 23.3
;; 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:
;; This file has been obsolete since Emacs 23.3.
;;; Code:
;; First, emulate the Lucid menubar support in GNU Emacs 19.
;; Arrange to use current-menubar to set up part of the menu bar.
(defvar current-menubar)
(defvar lucid-menubar-map)
(defvar lucid-failing-menubar)
(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
(defun recompute-lucid-menubar ()
(define-key lucid-menubar-map [menu-bar]
(condition-case nil
(make-lucid-menu-keymap "menu-bar" current-menubar)
(error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
(sit-for 1)
(setq lucid-failing-menubar current-menubar
current-menubar nil))))
(setq lucid-menu-bar-dirty-flag nil))
(defvar lucid-menubar-map (make-sparse-keymap))
(or (assq 'current-menubar minor-mode-map-alist)
(setq minor-mode-map-alist
(cons (cons 'current-menubar lucid-menubar-map)
minor-mode-map-alist)))
;; XEmacs compatibility
(defun set-menubar-dirty-flag ()
(force-mode-line-update)
(setq lucid-menu-bar-dirty-flag t))
(defvar add-menu-item-count 0)
;; This is a variable whose value is always nil.
(defvar make-lucid-menu-keymap-disable nil)
;; Return a menu keymap corresponding to a Lucid-style menu list
;; MENU-ITEMS, and with name MENU-NAME.
(defun make-lucid-menu-keymap (menu-name menu-items)
(let ((menu (make-sparse-keymap menu-name)))
;; Process items in reverse order,
;; since the define-key loop reverses them again.
(setq menu-items (reverse menu-items))
(while menu-items
(let ((item (car menu-items))
command name callback)
(cond ((stringp item)
(setq command nil)
(setq name (if (string-match "^-+$" item) "" item)))
((consp item)
(setq command (make-lucid-menu-keymap (car item) (cdr item)))
(setq name (car item)))
((vectorp item)
(setq command (make-symbol (format "menu-function-%d"
add-menu-item-count))
add-menu-item-count (1+ add-menu-item-count)
name (aref item 0)
callback (aref item 1))
(if (symbolp callback)
(fset command callback)
(fset command (list 'lambda () '(interactive) callback)))
(put command 'menu-alias t)
(let ((i 2))
(while (< i (length item))
(cond
((eq (aref item i) ':active)
(put command 'menu-enable
(or (aref item (1+ i))
'make-lucid-menu-keymap-disable))
(setq i (+ 2 i)))
((eq (aref item i) ':suffix)
;; unimplemented
(setq i (+ 2 i)))
((eq (aref item i) ':keys)
;; unimplemented
(setq i (+ 2 i)))
((eq (aref item i) ':style)
;; unimplemented
(setq i (+ 2 i)))
((eq (aref item i) ':selected)
;; unimplemented
(setq i (+ 2 i)))
((and (symbolp (aref item i))
(= ?: (string-to-char (symbol-name (aref item i)))))
(error "Unrecognized menu item keyword: %S"
(aref item i)))
((= i 2)
;; old-style format: active-p &optional suffix
(put command 'menu-enable
(or (aref item i) 'make-lucid-menu-keymap-disable))
;; suffix is unimplemented
(setq i (length item)))
(t
(error "Unexpected menu item value: %S"
(aref item i))))))))
(if (null command)
;; Handle inactive strings specially--allow any number
;; of identical ones.
(setcdr menu (cons (list nil name) (cdr menu)))
(if name
(define-key menu (vector (intern name)) (cons name command)))))
(setq menu-items (cdr menu-items)))
menu))
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
;; XEmacs compatibility function
(defun popup-dialog-box (data)
"Pop up a dialog box.
A dialog box description is a list.
- The first element of the list is a string to display in the dialog box.
- The rest of the elements are descriptions of the dialog box's buttons.
Each one is a vector of three elements:
- The first element is the text of the button.
- The second element is the `callback'.
- The third element is t or nil, whether this button is selectable.
If the `callback' of a button is a symbol, then it must name a command.
It will be invoked with `call-interactively'. If it is a list, then it is
evaluated with `eval'.
One (and only one) of the buttons may be nil. This marker means that all
following buttons should be flushright instead of flushleft.
The syntax, more precisely:
form := <something to pass to `eval'>
command := <a symbol or string, to pass to `call-interactively'>
callback := command | form
active-p := <t, nil, or a form to evaluate to decide whether this
button should be selectable>
name := <string>
partition := `nil'
button := `[' name callback active-p `]'
dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
(let ((name (car data))
(tail (cdr data))
converted
choice meaning)
(while tail
(if (null (car tail))
(setq converted (cons nil converted))
(let ((item (aref (car tail) 0))
(callback (aref (car tail) 1))
(enable (aref (car tail) 2)))
(setq converted
(cons (if enable (cons item callback) item)
converted))))
(setq tail (cdr tail)))
(setq choice (x-popup-dialog t (cons name (nreverse converted))))
(if choice
(if (symbolp choice)
(call-interactively choice)
(eval choice)))))
;; This is empty because the usual elements of the menu bar
;; are provided by menu-bar.el instead.
;; It would not make sense to duplicate them here.
(defconst default-menubar nil)
;; XEmacs compatibility
(defun set-menubar (menubar)
"Set the default menubar to be menubar."
(setq-default current-menubar (copy-sequence menubar))
(set-menubar-dirty-flag))
;; XEmacs compatibility
(defun set-buffer-menubar (menubar)
"Set the buffer-local menubar to be menubar."
(make-local-variable 'current-menubar)
(setq current-menubar (copy-sequence menubar))
(set-menubar-dirty-flag))
;;; menu manipulation functions
;; XEmacs compatibility
(defun find-menu-item (menubar item-path-list &optional parent)
"Searches MENUBAR for item given by ITEM-PATH-LIST.
Returns (ITEM . PARENT), where PARENT is the immediate parent of
the item found.
Signals an error if the item is not found."
(or parent (setq item-path-list (mapcar 'downcase item-path-list)))
(if (not (consp menubar))
nil
(let ((rest menubar)
result)
(while rest
(if (and (car rest)
(equal (car item-path-list)
(downcase (if (vectorp (car rest))
(aref (car rest) 0)
(if (stringp (car rest))
(car rest)
(car (car rest)))))))
(setq result (car rest) rest nil)
(setq rest (cdr rest))))
(if (cdr item-path-list)
(if (consp result)
(find-menu-item (cdr result) (cdr item-path-list) result)
(if result
(signal 'error (list "not a submenu" result))
(signal 'error (list "no such submenu" (car item-path-list)))))
(cons result parent)))))
;; XEmacs compatibility
(defun disable-menu-item (path)
"Make the named menu item be unselectable.
PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(item (car pair))
(menu (cdr pair)))
(or item
(signal 'error (list (if menu "No such menu item" "No such menu")
path)))
(if (consp item) (error "can't disable menus, only menu items"))
(aset item 2 nil)
(set-menubar-dirty-flag)
item))
;; XEmacs compatibility
(defun enable-menu-item (path)
"Make the named menu item be selectable.
PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(item (car pair))
(menu (cdr pair)))
(or item
(signal 'error (list (if menu "No such menu item" "No such menu")
path)))
(if (consp item) (error "%S is a menu, not a menu item" path))
(aset item 2 t)
(set-menubar-dirty-flag)
item))
(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
(if before (setq before (downcase before)))
(let* ((menubar current-menubar)
(menu (condition-case ()
(car (find-menu-item menubar menu-path))
(error nil)))
(item (if (listp menu)
(car (find-menu-item (cdr menu) (list item-name)))
(signal 'error (list "not a submenu" menu-path)))))
(or menu
(let ((rest menu-path)
(so-far menubar))
(while rest
;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
(setq menu
(if (eq so-far menubar)
(car (find-menu-item so-far (list (car rest))))
(car (find-menu-item (cdr so-far) (list (car rest))))))
(or menu
(let ((rest2 so-far))
(or rest2
(error "Trying to modify a menu that doesn't exist"))
(while (and (cdr rest2) (car (cdr rest2)))
(setq rest2 (cdr rest2)))
(setcdr rest2
(nconc (list (setq menu (list (car rest))))
(cdr rest2)))))
(setq so-far menu)
(setq rest (cdr rest)))))
(or menu (setq menu menubar))
(if item
nil ; it's already there
(if item-p
(setq item (vector item-name item-data enabled-p))
(setq item (cons item-name item-data)))
;; if BEFORE is specified, try to add it there.
(if before
(setq before (car (find-menu-item menu (list before)))))
(let ((rest menu)
(added-before nil))
(while rest
(if (eq before (car (cdr rest)))
(progn
(setcdr rest (cons item (cdr rest)))
(setq rest nil added-before t))
(setq rest (cdr rest))))
(if (not added-before)
;; adding before the first item on the menubar itself is harder
(if (and (eq menu menubar) (eq before (car menu)))
(setq menu (cons item menu)
current-menubar menu)
;; otherwise, add the item to the end.
(nconc menu (list item))))))
(if item-p
(progn
(aset item 1 item-data)
(aset item 2 (not (null enabled-p))))
(setcar item item-name)
(setcdr item item-data))
(set-menubar-dirty-flag)
item))
;; XEmacs compatibility
(defun add-menu-item (menu-path item-name function enabled-p &optional before)
"Add a menu item to some menu, creating the menu first if necessary.
If the named item exists already, it is changed.
MENU-PATH identifies the menu under which the new menu item should be inserted.
It is a list of strings; for example, (\"File\") names the top-level \"File\"
menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
ITEM-NAME is the string naming the menu item to be added.
FUNCTION is the command to invoke when this menu item is selected.
If it is a symbol, then it is invoked with `call-interactively', in the same
way that functions bound to keys are invoked. If it is a list, then the
list is simply evaluated.
ENABLED-P controls whether the item is selectable or not.
BEFORE, if provided, is the name of a menu item before which this item should
be added, if this item is not on the menu already. If the item is already
present, it will not be moved."
(or menu-path (error "must specify a menu path"))
(or item-name (error "must specify an item name"))
(add-menu-item-1 t menu-path item-name function enabled-p before))
;; XEmacs compatibility
(defun delete-menu-item (path)
"Remove the named menu item from the menu hierarchy.
PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(item (car pair))
(menu (or (cdr pair) menubar)))
(if (not item)
nil
;; the menubar is the only special case, because other menus begin
;; with their name.
(if (eq menu current-menubar)
(setq current-menubar (delq item menu))
(delq item menu))
(set-menubar-dirty-flag)
item)))
;; XEmacs compatibility
(defun relabel-menu-item (path new-name)
"Change the string of the specified menu item.
PATH is a list of strings which identify the position of the menu item in
the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
NEW-NAME is the string that the menu item will be printed as from now on."
(or (stringp new-name)
(setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
(let* ((menubar current-menubar)
(pair (find-menu-item menubar path))
(item (car pair))
(menu (cdr pair)))
(or item
(signal 'error (list (if menu "No such menu item" "No such menu")
path)))
(if (and (consp item)
(stringp (car item)))
(setcar item new-name)
(aset item 0 new-name))
(set-menubar-dirty-flag)
item))
;; XEmacs compatibility
(defun add-menu (menu-path menu-name menu-items &optional before)
"Add a menu to the menubar or one of its submenus.
If the named menu exists already, it is changed.
MENU-PATH identifies the menu under which the new menu should be inserted.
It is a list of strings; for example, (\"File\") names the top-level \"File\"
menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
If MENU-PATH is nil, then the menu will be added to the menubar itself.
MENU-NAME is the string naming the menu to be added.
MENU-ITEMS is a list of menu item descriptions.
Each menu item should be a vector of three elements:
- a string, the name of the menu item;
- a symbol naming a command, or a form to evaluate;
- and a form whose value determines whether this item is selectable.
BEFORE, if provided, is the name of a menu before which this menu should
be added, if this menu is not on its parent already. If the menu is already
present, it will not be moved."
(or menu-name (error "must specify a menu name"))
(or menu-items (error "must specify some menu items"))
(add-menu-item-1 nil menu-path menu-name menu-items t before))
(defvar put-buffer-names-in-file-menu t)
;; Don't unconditionally enable menu bars; leave that up to the user.
;;(let ((frames (frame-list)))
;; (while frames
;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
;; (setq frames (cdr frames))))
;;(or (assq 'menu-bar-lines default-frame-alist)
;; (setq default-frame-alist
;; (cons '(menu-bar-lines . 1) default-frame-alist)))
(set-menubar default-menubar)
(provide 'lmenu)
;;; lmenu.el ends here

View file

@ -1,211 +0,0 @@
;;; lucid.el --- emulate some Lucid Emacs functions
;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: emulations
;; Obsolete-since: 23.2
;; 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:
;;; Code:
;; XEmacs autoloads CL so we might as well make use of it.
(require 'cl)
(defalias 'current-time-seconds 'current-time)
(defun real-path-name (name &optional default)
(file-truename (expand-file-name name default)))
;; It's not clear what to return if the mouse is not in FRAME.
(defun read-mouse-position (frame)
(let ((pos (mouse-position)))
(if (eq (car pos) frame)
(cdr pos))))
(defun switch-to-other-buffer (arg)
"Switch to the previous buffer.
With a numeric arg N, switch to the Nth most recent buffer.
With an arg of 0, buries the current buffer at the
bottom of the buffer stack."
(interactive "p")
(if (eq arg 0)
(bury-buffer (current-buffer)))
(switch-to-buffer
(if (<= arg 1) (other-buffer (current-buffer))
(nth arg
(apply 'nconc
(mapcar
(lambda (buf)
(if (= ?\ (string-to-char (buffer-name buf)))
nil
(list buf)))
(buffer-list)))))))
(defun device-class (&optional device)
"Return the class (color behavior) of DEVICE.
This will be one of `color', `grayscale', or `mono'.
This function exists for compatibility with XEmacs."
(cond
((display-color-p device) 'color)
((display-grayscale-p device) 'grayscale)
(t 'mono)))
(defalias 'find-face 'facep)
(defalias 'get-face 'facep)
;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21.
;;;(defalias 'try-face-font 'internal-try-face-font)
(defalias 'exec-to-string 'shell-command-to-string)
;; Buffer context
(defun buffer-syntactic-context (&optional buffer)
"Syntactic context at point in BUFFER.
Either of `string', `comment' or nil.
This is an XEmacs compatibility function."
(with-current-buffer (or buffer (current-buffer))
(let ((state (syntax-ppss (point))))
(cond
((nth 3 state) 'string)
((nth 4 state) 'comment)))))
(defun buffer-syntactic-context-depth (&optional buffer)
"Syntactic parenthesis depth at point in BUFFER.
This is an XEmacs compatibility function."
(with-current-buffer (or buffer (current-buffer))
(nth 0 (syntax-ppss (point)))))
;; Extents
(defun make-extent (beg end &optional buffer)
(make-overlay beg end buffer))
(defun extent-properties (extent) (overlay-properties extent))
(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
(defun extent-at (pos &optional object property before)
(with-current-buffer (or object (current-buffer))
(let ((overlays (overlays-at pos 'sorted)))
(when property
(let (filtered)
(while overlays
(if (overlay-get (car overlays) property)
(setq filtered (cons (car overlays) filtered)))
(setq overlays (cdr overlays)))
(setq overlays filtered)))
(if before
(nth 1 (memq before overlays))
(car overlays)))))
(defun set-extent-property (extent prop value)
;; Make sure that separate adjacent extents
;; with the same mouse-face value
;; do not run together as one extent.
(and (eq prop 'mouse-face)
(symbolp value)
(setq value (list value)))
(if (eq prop 'duplicable)
(cond ((and value (not (overlay-get extent prop)))
;; If becoming duplicable, copy all overlayprops to text props.
(add-text-properties (overlay-start extent)
(overlay-end extent)
(overlay-properties extent)
(overlay-buffer extent)))
;; If becoming no longer duplicable, remove these text props.
((and (not value) (overlay-get extent prop))
(remove-text-properties (overlay-start extent)
(overlay-end extent)
(overlay-properties extent)
(overlay-buffer extent))))
;; If extent is already duplicable, put this property
;; on the text as well as on the overlay.
(if (overlay-get extent 'duplicable)
(put-text-property (overlay-start extent)
(overlay-end extent)
prop value (overlay-buffer extent))))
(overlay-put extent prop value))
(defun set-extent-face (extent face)
(set-extent-property extent 'face face))
(defun set-extent-end-glyph (extent glyph)
(set-extent-property extent 'after-string glyph))
(defun delete-extent (extent)
(set-extent-property extent 'duplicable nil)
(delete-overlay extent))
;; Support the Lucid names with `screen' instead of `frame'.
(defalias 'current-screen-configuration 'current-frame-configuration)
(defalias 'delete-screen 'delete-frame)
(defalias 'find-file-new-screen 'find-file-other-frame)
(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
(defalias 'find-tag-new-screen 'find-tag-other-frame)
;;(defalias 'focus-screen 'focus-frame)
(defalias 'iconify-screen 'iconify-frame)
(defalias 'mail-new-screen 'mail-other-frame)
(defalias 'make-screen-invisible 'make-frame-invisible)
(defalias 'make-screen-visible 'make-frame-visible)
;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
(defalias 'modify-screen-parameters 'modify-frame-parameters)
(defalias 'next-screen 'next-frame)
;; (defalias 'next-multiscreen-window 'next-multiframe-window)
;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
(defalias 'redraw-screen 'redraw-frame)
;; (defalias 'screen-char-height 'frame-char-height)
;; (defalias 'screen-char-width 'frame-char-width)
;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
;; (defalias 'screen-focus 'frame-focus)
(defalias 'screen-list 'frame-list)
;; (defalias 'screen-live-p 'frame-live-p)
(defalias 'screen-parameters 'frame-parameters)
(defalias 'screen-pixel-height 'frame-pixel-height)
(defalias 'screen-pixel-width 'frame-pixel-width)
(defalias 'screen-root-window 'frame-root-window)
(defalias 'screen-selected-window 'frame-selected-window)
(defalias 'lower-screen 'lower-frame)
(defalias 'raise-screen 'raise-frame)
(defalias 'screen-visible-p 'frame-visible-p)
(defalias 'screenp 'framep)
(defalias 'select-screen 'select-frame)
(defalias 'selected-screen 'selected-frame)
;; (defalias 'set-screen-configuration 'set-frame-configuration)
;; (defalias 'set-screen-height 'set-frame-height)
(defalias 'set-screen-position 'set-frame-position)
(defalias 'set-screen-size 'set-frame-size)
;; (defalias 'set-screen-width 'set-frame-width)
(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
;; (defalias 'unfocus-screen 'unfocus-frame)
(defalias 'visible-screen-list 'visible-frame-list)
(defalias 'window-screen 'window-frame)
(defalias 'x-create-screen 'x-create-frame)
(defalias 'x-new-screen 'make-frame)
(provide 'lucid)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
;;; lucid.el ends here

View file

@ -1,801 +0,0 @@
;;; whitespace.el --- warn about and clean bogus whitespaces in the file
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
;; Keywords: convenience
;; Obsolete-since: 23.1
;; 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:
;; URL: http://www.dsmit.com/lisp/
;;
;; The whitespace library is intended to find and help fix five different types
;; of whitespace problems that commonly exist in source code.
;;
;; 1. Leading space (empty lines at the top of a file).
;; 2. Trailing space (empty lines at the end of a file).
;; 3. Indentation space (8 or more spaces at beginning of line, that should be
;; replaced with TABS).
;; 4. Spaces followed by a TAB. (Almost always, we never want that).
;; 5. Spaces or TABS at the end of a line.
;;
;; Whitespace errors are reported in a buffer, and on the mode line.
;;
;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
;; where `x' and `y' can be one (or more) of:
;;
;; e - End-of-Line whitespace.
;; i - Indentation whitespace.
;; l - Leading whitespace.
;; s - Space followed by Tab.
;; t - Trailing whitespace.
;;
;; If any of the whitespace checks is turned off, the mode line will display a
;; !<y>.
;;
;; (since (3) is the most controversial one, here is the rationale: Most
;; terminal drivers and printer drivers have TAB configured or even
;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
;; always they default to 8.)
;;
;; Changing `tab-width' to other than 8 and editing will cause your code to
;; look different from within Emacs, and say, if you cat it or more it, or
;; even print it.
;;
;; Almost all the popular programming modes let you define an offset (like
;; c-basic-offset or perl-indent-level) to configure the offset, so you
;; should never have to set your `tab-width' to be other than 8 in all
;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause
;; Emacs to replace your 8 spaces with one \t (try it). If vi users in
;; your office complain, tell them to use vim, which distinguishes between
;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
;; to set smarttab.)
;;
;; All the above have caused (and will cause) unwanted codeline integration and
;; merge problems.
;;
;; whitespace.el will complain if it detects whitespaces on opening a file, and
;; warn you on closing a file also (in case you had inserted any
;; whitespaces during the process of your editing).
;;
;; Exported functions:
;;
;; `whitespace-buffer' - To check the current buffer for whitespace problems.
;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
;; `whitespace-region' - To check between point and mark for whitespace
;; problems.
;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
;; and mark in the current buffer.
;;; Code:
(defvar whitespace-version "3.5" "Version of the whitespace library.")
(defvar whitespace-all-buffer-files nil
"An associated list of buffers and files checked for whitespace cleanliness.
This is to enable periodic checking of whitespace cleanliness in the files
visited by the buffers.")
(defvar whitespace-rescan-timer nil
"Timer object used to rescan the files in buffers that have been modified.")
;; Tell Emacs about this new kind of minor mode
(defvar whitespace-mode nil
"Non-nil when Whitespace mode (a minor mode) is enabled.")
(make-variable-buffer-local 'whitespace-mode)
(defvar whitespace-mode-line nil
"String to display in the mode line for Whitespace mode.")
(make-variable-buffer-local 'whitespace-mode-line)
(defvar whitespace-check-buffer-leading nil
"Test leading whitespace for file in current buffer if t.")
(make-variable-buffer-local 'whitespace-check-buffer-leading)
;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp)
(defvar whitespace-check-buffer-trailing nil
"Test trailing whitespace for file in current buffer if t.")
(make-variable-buffer-local 'whitespace-check-buffer-trailing)
;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp)
(defvar whitespace-check-buffer-indent nil
"Test indentation whitespace for file in current buffer if t.")
(make-variable-buffer-local 'whitespace-check-buffer-indent)
;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp)
(defvar whitespace-check-buffer-spacetab nil
"Test Space-followed-by-TABS whitespace for file in current buffer if t.")
(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp)
(defvar whitespace-check-buffer-ateol nil
"Test end-of-line whitespace for file in current buffer if t.")
(make-variable-buffer-local 'whitespace-check-buffer-ateol)
;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp)
(defvar whitespace-highlighted-space nil
"The variable to store the extent to highlight.")
(make-variable-buffer-local 'whitespace-highlighted-space)
(defalias 'whitespace-make-overlay
(if (featurep 'xemacs) 'make-extent 'make-overlay))
(defalias 'whitespace-overlay-put
(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
(defalias 'whitespace-delete-overlay
(if (featurep 'xemacs) 'delete-extent 'delete-overlay))
(defalias 'whitespace-overlay-start
(if (featurep 'xemacs) 'extent-start 'overlay-start))
(defalias 'whitespace-overlay-end
(if (featurep 'xemacs) 'extent-end 'overlay-end))
(defalias 'whitespace-mode-line-update
(if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
(defgroup whitespace nil
"Check for and fix five different types of whitespaces in source code."
:version "21.1"
:link '(emacs-commentary-link "whitespace.el")
;; Since XEmacs doesn't have a 'convenience group, use the next best group
;; which is 'editing?
:group (if (featurep 'xemacs) 'editing 'convenience))
(defcustom whitespace-check-leading-whitespace t
"Flag to check leading whitespace. This is the global for the system.
It can be overridden by setting a buffer local variable
`whitespace-check-buffer-leading'."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-check-trailing-whitespace t
"Flag to check trailing whitespace. This is the global for the system.
It can be overridden by setting a buffer local variable
`whitespace-check-buffer-trailing'."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-check-spacetab-whitespace t
"Flag to check space followed by a TAB. This is the global for the system.
It can be overridden by setting a buffer local variable
`whitespace-check-buffer-spacetab'."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-spacetab-regexp "[ ]+\t"
"Regexp to match one or more spaces followed by a TAB."
:type 'regexp
:group 'whitespace)
(defcustom whitespace-check-indent-whitespace indent-tabs-mode
"Flag to check indentation whitespace. This is the global for the system.
It can be overridden by setting a buffer local variable
`whitespace-check-buffer-indent'."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-indent-regexp "^\t*\\( \\)+"
"Regexp to match multiples of eight spaces near line beginnings.
The default value ignores leading TABs."
:type 'regexp
:group 'whitespace)
(defcustom whitespace-check-ateol-whitespace t
"Flag to check end-of-line whitespace. This is the global for the system.
It can be overridden by setting a buffer local variable
`whitespace-check-buffer-ateol'."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-ateol-regexp "[ \t]+$"
"Regexp to match one or more TABs or spaces at line ends."
:type 'regexp
:group 'whitespace)
(defcustom whitespace-errbuf "*Whitespace Errors*"
"The name of the buffer where whitespace related messages will be logged."
:type 'string
:group 'whitespace)
(defcustom whitespace-clean-msg "clean."
"If non-nil, this message will be displayed after a whitespace check
determines a file to be clean."
:type 'string
:group 'whitespace)
(defcustom whitespace-abort-on-error nil
"While writing a file, abort if the file is unclean.
If `whitespace-auto-cleanup' is set, that takes precedence over
this variable."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-auto-cleanup nil
"Cleanup a buffer automatically on finding it whitespace unclean."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-silent nil
"All whitespace errors will be shown only in the mode line when t.
Note that setting this may cause all whitespaces introduced in a file to go
unnoticed when the buffer is killed, unless the user visits the `*Whitespace
Errors*' buffer before opening (or closing) another file."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
c-mode c++-mode cc-mode
change-log-mode cperl-mode
electric-nroff-mode emacs-lisp-mode
f90-mode fortran-mode html-mode
html3-mode java-mode jde-mode
ksh-mode latex-mode LaTeX-mode
lisp-mode m4-mode makefile-mode
modula-2-mode nroff-mode objc-mode
pascal-mode perl-mode prolog-mode
python-mode scheme-mode sgml-mode
sh-mode shell-script-mode simula-mode
tcl-mode tex-mode texinfo-mode
vrml-mode xml-mode)
"Major modes in which we turn on whitespace checking.
These are mostly programming and documentation modes. But you may add other
modes that you want whitespaces checked in by adding something like the
following to your `.emacs':
\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
whitespace-modes))\)
Or, alternately, you can use the Emacs `customize' command to set this."
:type '(repeat symbol)
:group 'whitespace)
(defcustom whitespace-rescan-timer-time 600
"Period in seconds to rescan modified buffers for whitespace creep.
This is the period after which the timer will fire causing
`whitespace-rescan-files-in-buffers' to check for whitespace creep in
modified buffers.
To disable timer scans, set this to zero."
:type 'integer
:group 'whitespace)
(defcustom whitespace-display-in-modeline t
"Display whitespace errors on the modeline."
:type 'boolean
:group 'whitespace)
(defcustom whitespace-display-spaces-in-color t
"Display the bogus whitespaces by coloring them with the face
`whitespace-highlight'."
:type 'boolean
:group 'whitespace)
(defface whitespace-highlight '((((class color) (background light))
(:background "green1"))
(((class color) (background dark))
(:background "sea green"))
(((class grayscale mono)
(background light))
(:background "black"))
(((class grayscale mono)
(background dark))
(:background "white")))
"Face used for highlighting the bogus whitespaces that exist in the buffer."
:group 'whitespace)
(if (not (assoc 'whitespace-mode minor-mode-alist))
(setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
minor-mode-alist)))
(set-default 'whitespace-check-buffer-leading
whitespace-check-leading-whitespace)
(set-default 'whitespace-check-buffer-trailing
whitespace-check-trailing-whitespace)
(set-default 'whitespace-check-buffer-indent
whitespace-check-indent-whitespace)
(set-default 'whitespace-check-buffer-spacetab
whitespace-check-spacetab-whitespace)
(set-default 'whitespace-check-buffer-ateol
whitespace-check-ateol-whitespace)
(defun whitespace-check-whitespace-mode (&optional arg)
"Test and set the whitespace-mode in qualifying buffers."
(if (null whitespace-mode)
(setq whitespace-mode
(if (or arg (member major-mode whitespace-modes))
t
nil))))
;;;###autoload
(defun whitespace-toggle-leading-check ()
"Toggle the check for leading space in the local buffer."
(interactive)
(let ((current-val whitespace-check-buffer-leading))
(setq whitespace-check-buffer-leading (not current-val))
(message "Will%s check for leading space in buffer."
(if whitespace-check-buffer-leading "" " not"))
(if whitespace-check-buffer-leading (whitespace-buffer-leading))))
;;;###autoload
(defun whitespace-toggle-trailing-check ()
"Toggle the check for trailing space in the local buffer."
(interactive)
(let ((current-val whitespace-check-buffer-trailing))
(setq whitespace-check-buffer-trailing (not current-val))
(message "Will%s check for trailing space in buffer."
(if whitespace-check-buffer-trailing "" " not"))
(if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
;;;###autoload
(defun whitespace-toggle-indent-check ()
"Toggle the check for indentation space in the local buffer."
(interactive)
(let ((current-val whitespace-check-buffer-indent))
(setq whitespace-check-buffer-indent (not current-val))
(message "Will%s check for indentation space in buffer."
(if whitespace-check-buffer-indent "" " not"))
(if whitespace-check-buffer-indent
(whitespace-buffer-search whitespace-indent-regexp))))
;;;###autoload
(defun whitespace-toggle-spacetab-check ()
"Toggle the check for space-followed-by-TABs in the local buffer."
(interactive)
(let ((current-val whitespace-check-buffer-spacetab))
(setq whitespace-check-buffer-spacetab (not current-val))
(message "Will%s check for space-followed-by-TABs in buffer."
(if whitespace-check-buffer-spacetab "" " not"))
(if whitespace-check-buffer-spacetab
(whitespace-buffer-search whitespace-spacetab-regexp))))
;;;###autoload
(defun whitespace-toggle-ateol-check ()
"Toggle the check for end-of-line space in the local buffer."
(interactive)
(let ((current-val whitespace-check-buffer-ateol))
(setq whitespace-check-buffer-ateol (not current-val))
(message "Will%s check for end-of-line space in buffer."
(if whitespace-check-buffer-ateol "" " not"))
(if whitespace-check-buffer-ateol
(whitespace-buffer-search whitespace-ateol-regexp))))
;;;###autoload
(defun whitespace-buffer (&optional quiet)
"Find five different types of white spaces in buffer.
These are:
1. Leading space \(empty lines at the top of a file).
2. Trailing space \(empty lines at the end of a file).
3. Indentation space \(8 or more spaces, that should be replaced with TABS).
4. Spaces followed by a TAB. \(Almost always, we never want that).
5. Spaces or TABS at the end of a line.
Check for whitespace only if this buffer really contains a non-empty file
and:
1. the major mode is one of the whitespace-modes, or
2. `whitespace-buffer' was explicitly called with a prefix argument."
(interactive)
(let ((whitespace-error nil))
(whitespace-check-whitespace-mode current-prefix-arg)
(if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
(progn
(whitespace-check-buffer-list (buffer-name) buffer-file-name)
(whitespace-tickle-timer)
(overlay-recenter (point-max))
(remove-overlays nil nil 'face 'whitespace-highlight)
(if whitespace-auto-cleanup
(if buffer-read-only
(if (not quiet)
(message "Can't cleanup: %s is read-only" (buffer-name)))
(whitespace-cleanup-internal))
(let ((whitespace-leading (if whitespace-check-buffer-leading
(whitespace-buffer-leading)
nil))
(whitespace-trailing (if whitespace-check-buffer-trailing
(whitespace-buffer-trailing)
nil))
(whitespace-indent (if whitespace-check-buffer-indent
(whitespace-buffer-search
whitespace-indent-regexp)
nil))
(whitespace-spacetab (if whitespace-check-buffer-spacetab
(whitespace-buffer-search
whitespace-spacetab-regexp)
nil))
(whitespace-ateol (if whitespace-check-buffer-ateol
(whitespace-buffer-search
whitespace-ateol-regexp)
nil))
(whitespace-errmsg nil)
(whitespace-filename buffer-file-name)
(whitespace-this-modeline ""))
;; Now let's complain if we found any of the above.
(setq whitespace-error (or whitespace-leading whitespace-indent
whitespace-spacetab whitespace-ateol
whitespace-trailing))
(if whitespace-error
(progn
(setq whitespace-errmsg
(concat whitespace-filename " contains:\n"
(if whitespace-leading
"Leading whitespace\n")
(if whitespace-indent
(concat "Indentation whitespace"
whitespace-indent "\n"))
(if whitespace-spacetab
(concat "Space followed by Tab"
whitespace-spacetab "\n"))
(if whitespace-ateol
(concat "End-of-line whitespace"
whitespace-ateol "\n"))
(if whitespace-trailing
"Trailing whitespace\n")
"\ntype `M-x whitespace-cleanup' to "
"cleanup the file."))
(setq whitespace-this-modeline
(concat (if whitespace-ateol "e")
(if whitespace-indent "i")
(if whitespace-leading "l")
(if whitespace-spacetab "s")
(if whitespace-trailing "t")))))
(whitespace-update-modeline whitespace-this-modeline)
(if (get-buffer whitespace-errbuf)
(kill-buffer whitespace-errbuf))
(with-current-buffer (get-buffer-create whitespace-errbuf)
(if whitespace-errmsg
(progn
(insert whitespace-errmsg)
(if (not (or quiet whitespace-silent))
(display-buffer (current-buffer) t))
(if (not quiet)
(message "Whitespaces: [%s%s] in %s"
whitespace-this-modeline
(let ((whitespace-unchecked
(whitespace-unchecked-whitespaces)))
(if whitespace-unchecked
(concat "!" whitespace-unchecked)
""))
whitespace-filename)))
(if (and (not quiet) (not (equal whitespace-clean-msg "")))
(message "%s %s" whitespace-filename
whitespace-clean-msg))))))))
whitespace-error))
;;;###autoload
(defun whitespace-region (s e)
"Check the region for whitespace errors."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region s e)
(whitespace-buffer))))
;;;###autoload
(defun whitespace-cleanup ()
"Cleanup the five different kinds of whitespace problems.
It normally applies to the whole buffer, but in Transient Mark mode
when the mark is active it applies to the region.
See `whitespace-buffer' docstring for a summary of the problems."
(interactive)
(if (and transient-mark-mode mark-active)
(whitespace-cleanup-region (region-beginning) (region-end))
(whitespace-cleanup-internal)))
(defun whitespace-cleanup-internal (&optional region-only)
;; If this buffer really contains a file, then run, else quit.
(whitespace-check-whitespace-mode current-prefix-arg)
(if (and buffer-file-name whitespace-mode)
(let ((whitespace-any nil)
(whitespace-tabwidth 8)
(whitespace-tabwidth-saved tab-width))
;; since all printable TABS should be 8, irrespective of how
;; they are displayed.
(setq tab-width whitespace-tabwidth)
(if (and whitespace-check-buffer-leading
(whitespace-buffer-leading))
(progn
(whitespace-buffer-leading-cleanup)
(setq whitespace-any t)))
(if (and whitespace-check-buffer-trailing
(whitespace-buffer-trailing))
(progn
(whitespace-buffer-trailing-cleanup)
(setq whitespace-any t)))
(if (and whitespace-check-buffer-indent
(whitespace-buffer-search whitespace-indent-regexp))
(progn
(whitespace-indent-cleanup)
(setq whitespace-any t)))
(if (and whitespace-check-buffer-spacetab
(whitespace-buffer-search whitespace-spacetab-regexp))
(progn
(whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
(setq whitespace-any t)))
(if (and whitespace-check-buffer-ateol
(whitespace-buffer-search whitespace-ateol-regexp))
(progn
(whitespace-buffer-cleanup whitespace-ateol-regexp "")
(setq whitespace-any t)))
;; Call this recursively till everything is taken care of
(if whitespace-any
(whitespace-cleanup-internal region-only)
;; if we are done, talk to the user
(progn
(unless whitespace-silent
(if region-only
(message "The region is now clean")
(message "%s is now clean" buffer-file-name)))
(whitespace-update-modeline)))
(setq tab-width whitespace-tabwidth-saved))))
;;;###autoload
(defun whitespace-cleanup-region (s e)
"Whitespace cleanup on the region."
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region s e)
(whitespace-cleanup-internal t))
(whitespace-buffer t)))
(defun whitespace-buffer-leading ()
"Return t if the current buffer has leading newline characters.
If highlighting is enabled, highlight these characters."
(save-excursion
(goto-char (point-min))
(skip-chars-forward "\n")
(unless (bobp)
(whitespace-highlight-the-space (point-min) (point))
t)))
(defun whitespace-buffer-leading-cleanup ()
"Remove any leading newline characters from current buffer."
(save-excursion
(goto-char (point-min))
(skip-chars-forward "\n")
(delete-region (point-min) (point))))
(defun whitespace-buffer-trailing ()
"Return t if the current buffer has extra trailing newline characters.
If highlighting is enabled, highlight these characters."
(save-excursion
(goto-char (point-max))
(skip-chars-backward "\n")
(forward-line)
(unless (eobp)
(whitespace-highlight-the-space (point) (point-max))
t)))
(defun whitespace-buffer-trailing-cleanup ()
"Remove extra trailing newline characters from current buffer."
(save-excursion
(goto-char (point-max))
(skip-chars-backward "\n")
(unless (eobp)
(forward-line)
(delete-region (point) (point-max)))))
(defun whitespace-buffer-search (regexp)
"Search for any given whitespace REGEXP."
(with-local-quit
(let (whitespace-retval)
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(whitespace-highlight-the-space (match-beginning 0) (match-end 0))
(push (match-beginning 0) whitespace-retval)))
(when whitespace-retval
(format " %s" (nreverse whitespace-retval))))))
(defun whitespace-buffer-cleanup (regexp newregexp)
"Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(replace-match newregexp))))
(defun whitespace-indent-cleanup ()
"Search for 8/more spaces at the start of a line and replace it with tabs."
(save-excursion
(goto-char (point-min))
(while (re-search-forward whitespace-indent-regexp nil t)
(let ((column (current-column))
(indent-tabs-mode t))
(delete-region (match-beginning 0) (point))
(indent-to column)))))
(defun whitespace-unchecked-whitespaces ()
"Return the list of whitespaces whose testing has been suppressed."
(let ((unchecked-spaces
(concat (if (not whitespace-check-buffer-ateol) "e")
(if (not whitespace-check-buffer-indent) "i")
(if (not whitespace-check-buffer-leading) "l")
(if (not whitespace-check-buffer-spacetab) "s")
(if (not whitespace-check-buffer-trailing) "t"))))
(if (not (equal unchecked-spaces ""))
unchecked-spaces
nil)))
(defun whitespace-update-modeline (&optional whitespace-err)
"Update mode line with whitespace errors.
Also with whitespaces whose testing has been turned off."
(if whitespace-display-in-modeline
(progn
(setq whitespace-mode-line nil)
;; Whitespace errors
(if (and whitespace-err (not (equal whitespace-err "")))
(setq whitespace-mode-line whitespace-err))
;; Whitespace suppressed errors
(let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
(if whitespace-unchecked
(setq whitespace-mode-line
(concat whitespace-mode-line "!" whitespace-unchecked))))
;; Add the whitespace modeline prefix
(setq whitespace-mode-line (if whitespace-mode-line
(concat " W:" whitespace-mode-line)
nil))
(whitespace-mode-line-update))))
(defun whitespace-highlight-the-space (b e)
"Highlight the current line, unhighlighting a previously jumped to line."
(if whitespace-display-spaces-in-color
(let ((ol (whitespace-make-overlay b e)))
(whitespace-overlay-put ol 'face 'whitespace-highlight))))
(defun whitespace-unhighlight-the-space()
"Unhighlight the currently highlight line."
(if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
(progn
(mapc 'whitespace-delete-overlay whitespace-highlighted-space)
(setq whitespace-highlighted-space nil))))
(defun whitespace-check-buffer-list (buf-name buf-file)
"Add a buffer and its file to the whitespace monitor list.
The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
periodically for whitespace."
(if (and whitespace-mode (not (member (list buf-file buf-name)
whitespace-all-buffer-files)))
(add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
(defun whitespace-tickle-timer ()
"Tickle timer to periodically to scan qualifying files for whitespace creep.
If timer is not set, then set it to scan the files in
`whitespace-all-buffer-files' periodically (defined by
`whitespace-rescan-timer-time') for whitespace creep."
(if (and whitespace-rescan-timer-time
(/= whitespace-rescan-timer-time 0)
(not whitespace-rescan-timer))
(setq whitespace-rescan-timer
(add-timeout whitespace-rescan-timer-time
'whitespace-rescan-files-in-buffers nil
whitespace-rescan-timer-time))))
(defun whitespace-rescan-files-in-buffers (&optional arg)
"Check monitored files for whitespace creep since last scan."
(let ((whitespace-all-my-files whitespace-all-buffer-files)
buffile bufname thiselt buf)
(if (not whitespace-all-my-files)
(progn
(disable-timeout whitespace-rescan-timer)
(setq whitespace-rescan-timer nil))
(while whitespace-all-my-files
(setq thiselt (car whitespace-all-my-files))
(setq whitespace-all-my-files (cdr whitespace-all-my-files))
(setq buffile (car thiselt))
(setq bufname (cadr thiselt))
(setq buf (get-buffer bufname))
(if (buffer-live-p buf)
(with-current-buffer bufname
;;(message "buffer %s live" bufname)
(if whitespace-mode
(progn
;;(message "checking for whitespace in %s" bufname)
(if whitespace-auto-cleanup
(progn
;;(message "cleaning up whitespace in %s" bufname)
(whitespace-cleanup-internal))
(progn
;;(message "whitespace-buffer %s." (buffer-name))
(whitespace-buffer t))))
;;(message "Removing %s from refresh list" bufname)
(whitespace-refresh-rescan-list buffile bufname)))
;;(message "Removing %s from refresh list" bufname)
(whitespace-refresh-rescan-list buffile bufname))))))
(defun whitespace-refresh-rescan-list (buffile bufname)
"Refresh the list of files to be rescanned for whitespace creep."
(if whitespace-all-buffer-files
(setq whitespace-all-buffer-files
(delete (list buffile bufname) whitespace-all-buffer-files))
(when whitespace-rescan-timer
(disable-timeout whitespace-rescan-timer)
(setq whitespace-rescan-timer nil))))
;;;###autoload
(defalias 'global-whitespace-mode 'whitespace-global-mode)
;;;###autoload
(define-minor-mode whitespace-global-mode
"Toggle using Whitespace mode in new buffers.
When this mode is active, `whitespace-buffer' is added to
`find-file-hook' and `kill-buffer-hook'."
:global t
:group 'whitespace
(if whitespace-global-mode
(progn
(add-hook 'find-file-hook 'whitespace-buffer)
(add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
(add-hook 'kill-buffer-hook 'whitespace-buffer))
(remove-hook 'find-file-hook 'whitespace-buffer)
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)
(remove-hook 'kill-buffer-hook 'whitespace-buffer)))
;;;###autoload
(defun whitespace-write-file-hook ()
"Hook function to be called on the buffer when whitespace check is enabled.
This is meant to be added buffer-locally to `write-file-functions'."
(let ((werr nil))
(if whitespace-auto-cleanup
(whitespace-cleanup-internal)
(setq werr (whitespace-buffer)))
(if (and whitespace-abort-on-error werr)
(error "Abort write due to whitespaces in %s"
buffer-file-name)))
nil)
(defun whitespace-unload-function ()
"Unload the whitespace library."
(if (unintern "whitespace-unload-hook" obarray)
;; if whitespace-unload-hook is defined, let's get rid of it
;; and recursively call `unload-feature'
(progn (unload-feature 'whitespace) t)
;; this only happens in the recursive call
(whitespace-global-mode -1)
(save-current-buffer
(dolist (buf (buffer-list))
(set-buffer buf)
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)))
;; continue standard unloading
nil))
(defun whitespace-unload-hook ()
(remove-hook 'find-file-hook 'whitespace-buffer)
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)
(remove-hook 'kill-buffer-hook 'whitespace-buffer))
(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
(provide 'whitespace)
;;; whitespace.el ends here

View file

@ -31,7 +31,7 @@
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
;; (password-cache-add "test" "foo")
;; (password-cache-add "test" (copy-sequence "foo"))
;; => nil
;; (password-read "Password? " "test")

View file

@ -5622,8 +5622,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; header
(let ((versions (concat "printing v" pr-version
" ps-print v" ps-print-version)))
;; to keep compatibility with Emacs 20 & 21:
;; DO NOT REPLACE `?\ ' BY `?\s'
(widget-insert (make-string (- 79 (length versions)) ?\ ) versions))
(pr-insert-italic "\nCurrent Directory : " 1)
(pr-insert-italic default-directory)

View file

@ -1,4 +1,4 @@
;;; autoconf.el --- mode for editing Autoconf configure.ac files
;;; autoconf.el --- mode for editing Autoconf configure.ac files -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.

View file

@ -405,7 +405,7 @@ comment at the start of cc-engine.el for more info."
(when (and (car c-macro-cache)
(> (point) (car c-macro-cache)) ; in case we have a
; zero-sized region.
(not (eq (char-before (1- (point))) ?\\)))
(not lim))
(setcdr c-macro-cache (point))
(setq c-macro-cache-syntactic nil)))))))
@ -1642,6 +1642,21 @@ comment at the start of cc-engine.el for more info."
(forward-char 2)
t))))
(defmacro c-forward-comment-minus-1 ()
"Call (forward-comment -1), taking care of escaped newlines.
Return the result of `forward-comment' if it gets called, nil otherwise."
`(if (not comment-end-can-be-escaped)
(forward-comment -1)
(when (and (< (skip-syntax-backward " >") 0)
(eq (char-after) ?\n))
(forward-char))
(cond
((and (eq (char-before) ?\n)
(eq (char-before (1- (point))) ?\\))
(backward-char)
nil)
(t (forward-comment -1)))))
(defun c-backward-single-comment ()
"Move backward past whitespace and the closest preceding comment, if any.
Return t if a comment was found, nil otherwise. In either case, the
@ -1675,12 +1690,12 @@ This function does not do any hidden buffer changes."
;; same line.
(re-search-forward "\\=\\s *[\n\r]" start t)
(if (if (forward-comment -1)
(if (if (c-forward-comment-minus-1)
(if (eolp)
;; If forward-comment above succeeded and we're at eol
;; then the newline we moved over above didn't end a
;; line comment, so we give it another go.
(forward-comment -1)
(c-forward-comment-minus-1)
t))
;; Emacs <= 20 and XEmacs move back over the closer of a
@ -1709,7 +1724,7 @@ comment at the start of cc-engine.el for more info."
(if (let (moved-comment)
(while
(and (not (setq moved-comment (forward-comment -1)))
(and (not (setq moved-comment (c-forward-comment-minus-1)))
;; Cope specifically with ^M^J here -
;; forward-comment sometimes gets stuck after ^Ms,
;; sometimes after ^M^J.

View file

@ -1431,7 +1431,7 @@ Note that the style variables are always made local to the buffer."
;; Move to end of logical line (as it will be after the change, or as it
;; was before unescaping a NL.)
(re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
(re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
;; We're at an EOLL or point-max.
(if (equal (c-get-char-property (point) 'syntax-table) '(15))
(if (memq (char-after) '(?\n ?\r))
@ -1539,7 +1539,7 @@ Note that the style variables are always made local to the buffer."
(progn
(goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
(point-max)))
(re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
(re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t)
(point))
c-new-END))
@ -1620,7 +1620,7 @@ Note that the style variables are always made local to the buffer."
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
;; Search forward for EOLL
(setq lim (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
(setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char

View file

@ -4975,8 +4975,6 @@ killed after process termination."
(defun ebnf-eps-filename (str)
(let* ((len (length str))
(stri 0)
;; to keep compatibility with Emacs 20 & 21:
;; DO NOT REPLACE `?\ ' BY `?\s'
(new (make-string len ?\ )))
(while (< stri len)
(aset new stri (aref ebnf-map-name (aref str stri)))
@ -5993,8 +5991,6 @@ killed after process termination."
(defun ebnf-trim-right (str)
(let* ((len (1- (length str)))
(index len))
;; to keep compatibility with Emacs 20 & 21:
;; DO NOT REPLACE `?\ ' BY `?\s'
(while (and (> index 0) (= (aref str index) ?\ ))
(setq index (1- index)))
(if (= index len)

View file

@ -655,18 +655,16 @@ functions are annotated with \"<f>\" via the
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format
(let ((str "(%s %s)"))
(put-text-property 1 3 'face 'font-lock-keyword-face str)
(put-text-property 4 6 'face 'font-lock-function-name-face str)
str))
#("(%s %s)"
1 3 (face font-lock-keyword-face)
4 6 (face font-lock-function-name-face)))
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format-extra
(let ((str "(%s %s %s)"))
(put-text-property 1 3 'face 'font-lock-keyword-face str)
(put-text-property 4 6 'face 'font-lock-function-name-face str)
str))
#("(%s %s %s)"
1 3 (face font-lock-keyword-face)
4 6 (face font-lock-function-name-face)))
(defvar find-feature-regexp);; in find-func.el

View file

@ -316,9 +316,10 @@ generated it."
&optional data
overlay-properties)
"Make a Flymake diagnostic for BUFFER's region from BEG to END.
TYPE is a key to symbol and TEXT is a description of the problem
detected in this region. DATA is any object that the caller
wishes to attach to the created diagnostic for later retrieval.
TYPE is a diagnostic symbol and TEXT is string describing the
problem detected in this region. DATA is any object that the
caller wishes to attach to the created diagnostic for later
retrieval.
OVERLAY-PROPERTIES is an alist of properties attached to the
created diagnostic, overriding the default properties and any

View file

@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
;; Version: 0.1
;; Version: 0.1.3
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@ -273,9 +273,32 @@ backend implementation of `project-external-roots'.")
(pcase backend
('Git
;; Don't stop at submodule boundary.
;; Note: It's not necessarily clear-cut what should be
;; considered a "submodule" in the sense that some users
;; may setup things equivalent to "git-submodule"s using
;; "git worktree" instead (for example).
;; FIXME: Also it may be the case that some users would consider
;; a submodule as its own project. So there's a good chance
;; we will need to let the user tell us what is their intention.
(or (vc-file-getprop dir 'project-git-root)
(vc-file-setprop dir 'project-git-root
(vc-find-root dir ".git/"))))
(let* ((root (vc-call-backend backend 'root dir))
(gitfile (expand-file-name ".git" root)))
(vc-file-setprop
dir 'project-git-root
(cond
((file-directory-p gitfile)
root)
((with-temp-buffer
(insert-file-contents gitfile)
(goto-char (point-min))
;; Kind of a hack to distinguish a submodule from
;; other cases of .git files pointing elsewhere.
(looking-at "gitdir: [./]+/\\.git/modules/"))
(let* ((parent (file-name-directory
(directory-file-name root))))
(vc-call-backend backend 'root parent)))
(t root)))
)))
('nil nil)
(_ (ignore-errors (vc-call-backend backend 'root dir))))))
(and root (cons 'vc root))))

View file

@ -1,8 +1,8 @@
;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
;; Version: 1.0.0
;; Package-Requires: ((emacs "26.3") (project "0.1"))
;; Version: 1.0.1
;; Package-Requires: ((emacs "26.3") (project "0.1.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
@ -1322,11 +1322,11 @@ directory, used as the root of the ignore globs."
(lambda (ignore)
(when (string-match-p "/\\'" ignore)
(setq ignore (concat ignore "*")))
(if (string-match "\\`\\./" ignore)
(setq ignore (replace-match dir t t ignore))
(unless (string-prefix-p "*" ignore)
(setq ignore (concat "*/" ignore))))
(shell-quote-argument ignore))
(shell-quote-argument (if (string-match "\\`\\./" ignore)
(replace-match dir t t ignore)
(if (string-prefix-p "*" ignore)
ignore
(concat "*/" ignore)))))
ignores
" -o -path ")
" "

View file

@ -4141,6 +4141,20 @@ its behavior with respect to remote file attribute caching.
You should only ever change this variable with a let-binding;
never with `setq'.")
(defcustom process-file-return-signal-string nil
"Whether to return a string describing the signal interrupting a process.
When a process returns an exit code greater than 128, it is
interpreted as a signal. `process-file' requires to return a
string describing this signal.
Since there are processes violating this rule, returning exit
codes greater than 128 which are not bound to a signal,
`process-file' returns the exit code as natural number also in
this case. Setting this user option to non-nil forces
`process-file' to interpret such exit codes as signals, and to
return a corresponding string."
:version "28.1"
:type 'boolean)
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
@ -4889,7 +4903,7 @@ of this sample text; it defaults to 40."
;; Swap point-and-mark quickly so as to show the region that
;; was selected. Don't do it if the region is highlighted.
(unless (and (region-active-p)
(face-background 'region))
(face-background 'region nil t))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char mark)

View file

@ -480,23 +480,9 @@ checksum before doing the check."
(defun tar-grind-file-mode (mode)
"Construct a `rw-r--r--' string indicating MODE.
MODE should be an integer which is a file mode value."
(string
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 2048 mode))
(if (zerop (logand 64 mode)) ?- ?x)
(if (zerop (logand 64 mode)) ?S ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 1024 mode))
(if (zerop (logand 8 mode)) ?- ?x)
(if (zerop (logand 8 mode)) ?S ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 512 mode))
(if (zerop (logand 1 mode)) ?- ?x)
(if (zerop (logand 1 mode)) ?T ?t))))
MODE should be an integer which is a file mode value.
For instance, if mode is #o700, then it produces `rwx------'."
(substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
"Return a line similar to the output of `tar -vtf'."

View file

@ -3559,9 +3559,9 @@ LOCAL is t for interactive calls."
(lambda ()
(:documentation
(format "Insert a template for a @%s entry; see also `bibtex-entry'."
entry)
entry))
(interactive "*")
(bibtex-entry entry)))))
(bibtex-entry entry))))
;; Menu entries
(define-key menu-map (vector fname)
`(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))

View file

@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
(defalias 'ediff-vc-revision-other-window
(if (fboundp 'vc-revision-other-window)
'vc-revision-other-window
'vc-version-other-window))
(defalias 'ediff-vc-working-revision
(if (fboundp 'vc-working-revision)
'vc-working-revision
'vc-workfile-version))
(define-obsolete-function-alias 'ediff-vc-revision-other-window
#'vc-revision-other-window "28.1")
(define-obsolete-function-alias 'ediff-vc-working-revision
#'vc-working-revision "28.1")
;; VC.el support
@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
(ediff-vc-revision-other-window rev1)
(vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
(ediff-vc-revision-other-window rev2))
(vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
(ediff-vc-revision-other-window rev1)
(vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
(ediff-vc-revision-other-window rev2))
(vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
(setq ancestor-rev (ediff-vc-working-revision
(setq ancestor-rev (vc-working-revision
buffer-file-name)))
(ediff-vc-revision-other-window ancestor-rev)
(vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))

View file

@ -4952,12 +4952,10 @@ typedef union
#ifdef HAVE___BUILTIN_UNWIND_INIT
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
__builtin_unwind_init (); \
*(p) = NEAR_STACK_TOP (&sentry)
#else
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
__builtin_unwind_init (); \
test_setjmp (); \
sys_setjmp (sentry.j); \
*(p) = NEAR_STACK_TOP (&sentry + (stack_bottom < &sentry.c))
@ -5033,7 +5031,7 @@ mark_stack (char const *bottom, char const *end)
from FUNC. */
NO_INLINE void
flush_stack_call_func (void (*func) (void *arg), void *arg)
flush_stack_call_func1 (void (*func) (void *arg), void *arg)
{
void *end;
struct thread_state *self = current_thread;

View file

@ -3819,7 +3819,15 @@ extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
extern void mark_stack (char const *, char const *);
extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
INLINE void
flush_stack_call_func (void (*func) (void *arg), void *arg)
{
__builtin_unwind_init ();
flush_stack_call_func1 (func, arg);
}
extern void garbage_collect (void);
extern void maybe_garbage_collect (void);
extern const char *pending_malloc_warning;

View file

@ -5120,7 +5120,7 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
if (CONSP (spec) && EQ (XCAR (spec), Qdisable_eval))
{
enable_eval = false;
spec = XCAR (XCDR (spec));
spec = CONSP (XCDR (spec)) ? XCAR (XCDR (spec)) : Qnil;
}
if (CONSP (spec)

View file

@ -6738,8 +6738,10 @@ x_hide_tip (bool delete)
}
}
/* Reset tip_last_frame, it will be reassigned when showing the
next GTK+ system tooltip. */
/* When using GTK+ system tooltips (compare Bug#41200) reset
tip_last_frame. It will be reassigned when showing the next
GTK+ system tooltip. */
if (x_gtk_use_system_tooltips)
tip_last_frame = Qnil;
/* Now look whether there's an Emacs tip around. */

View file

@ -28,7 +28,7 @@
(let ((alist (list (cons 448 "-rwx------")
(cons 420 "-rw-r--r--")
(cons 292 "-r--r--r--")
(cons 512 "----------")
(cons 512 "---------T")
(cons 1024 "------S---") ; Bug#28092
(cons 2048 "---S------"))))
(dolist (x alist)

View file

@ -345,6 +345,58 @@ An existing calc stack is reused, otherwise a new one is created."
(should (Math-num-integerp '(float 1 0)))
(should-not (Math-num-integerp nil)))
(ert-deftest calc-matrix-determinant ()
(should (equal (calcFunc-det '(vec (vec 3)))
3))
(should (equal (calcFunc-det '(vec (vec 2 3) (vec 6 7)))
-4))
(should (equal (calcFunc-det '(vec (vec 1 2 3) (vec 4 5 7) (vec 9 6 2)))
15))
(should (equal (calcFunc-det '(vec (vec 0 5 7 3)
(vec 0 0 2 0)
(vec 1 2 3 4)
(vec 0 0 0 3)))
30))
(should (equal (calcFunc-det '(vec (vec (var a var-a))))
'(var a var-a)))
(should (equal (calcFunc-det '(vec (vec 2 (var a var-a))
(vec 7 (var a var-a))))
'(* -5 (var a var-a))))
(should (equal (calcFunc-det '(vec (vec 1 0 0 0)
(vec 0 1 0 0)
(vec 0 0 0 1)
(vec 0 0 (var a var-a) 0)))
'(neg (var a var-a)))))
(ert-deftest calc-gcd ()
(should (equal (calcFunc-gcd 3 4) 1))
(should (equal (calcFunc-gcd 12 15) 3))
(should (equal (calcFunc-gcd -12 15) 3))
(should (equal (calcFunc-gcd 12 -15) 3))
(should (equal (calcFunc-gcd -12 -15) 3))
(should (equal (calcFunc-gcd 0 5) 5))
(should (equal (calcFunc-gcd 5 0) 5))
(should (equal (calcFunc-gcd 0 -5) 5))
(should (equal (calcFunc-gcd -5 0) 5))
(should (equal (calcFunc-gcd 0 0) 0))
(should (equal (calcFunc-gcd 0 '(var x var-x))
'(calcFunc-abs (var x var-x))))
(should (equal (calcFunc-gcd '(var x var-x) 0)
'(calcFunc-abs (var x var-x)))))
(ert-deftest calc-sum-gcd ()
;; sum(gcd(0,n),n,-1,-1)
(should (equal (math-simplify '(calcFunc-sum (calcFunc-gcd 0 (var n var-n))
(var n var-n) -1 -1))
1))
;; sum(sum(gcd(n,k),k,-1,1),n,-1,1)
(should (equal (math-simplify
'(calcFunc-sum
(calcFunc-sum (calcFunc-gcd (var n var-n) (var k var-k))
(var k var-k) -1 1)
(var n var-n) -1 1))
8)))
(provide 'calc-tests)
;;; calc-tests.el ends here

View file

@ -425,7 +425,9 @@ collection clause."
'(2 3 4 5 6))))
(ert-deftest cl-macs-loop-across-ref ()
(should (equal (cl-loop with my-vec = ["one" "two" "three"]
(should (equal (cl-loop with my-vec = (vector (cl-copy-seq "one")
(cl-copy-seq "two")
(cl-copy-seq "three"))
for x across-ref my-vec
do (setf (aref x 0) (upcase (aref x 0)))
finally return my-vec)

View file

@ -107,8 +107,8 @@
(ert-deftest erc-track--erc-faces-in ()
"`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
(let ((str0 "is bold")
(str1 "is bold"))
(let ((str0 (copy-sequence "is bold"))
(str1 (copy-sequence "is bold")))
;; Turn on Font Lock mode: this initialize `char-property-alias-alist'
;; to '((face font-lock-face)). Note that `font-lock-mode' don't
;; turn on the mode if the test is run on batch mode or if the

View file

@ -1164,6 +1164,42 @@ works as expected if the default directory is quoted."
(should-not (make-directory a/b t))
(delete-directory dir 'recursive)))
(ert-deftest files-tests-file-modes-symbolic-to-number ()
(let ((alist (list (cons "a=rwx" #o777)
(cons "o=t" #o1000)
(cons "o=xt" #o1001)
(cons "o=tx" #o1001) ; Order doesn't matter.
(cons "u=rwx,g=rx,o=rx" #o755)
(cons "u=rwx,g=,o=" #o700)
(cons "u=rwx" #o700) ; Empty permissions can be ignored.
(cons "u=rw,g=r,o=r" #o644)
(cons "u=rw,g=r,o=t" #o1640)
(cons "u=rw,g=r,o=xt" #o1641)
(cons "u=rwxs,g=rs,o=xt" #o7741)
(cons "u=rws,g=rs,o=t" #o7640)
(cons "u=rws,g=rs,o=r" #o6644)
(cons "a=r" #o444)
(cons "u=S" nil)
(cons "u=T" nil)
(cons "u=Z" nil))))
(dolist (x alist)
(if (cdr-safe x)
(should (equal (cdr x) (file-modes-symbolic-to-number (car x))))
(should-error (file-modes-symbolic-to-number (car x)))))))
(ert-deftest files-tests-file-modes-number-to-symbolic ()
(let ((alist (list (cons #o755 "-rwxr-xr-x")
(cons #o700 "-rwx------")
(cons #o644 "-rw-r--r--")
(cons #o1640 "-rw-r----T")
(cons #o1641 "-rw-r----t")
(cons #o7741 "-rwsr-S--t")
(cons #o7640 "-rwSr-S--T")
(cons #o6644 "-rwSr-Sr--")
(cons #o444 "-r--r--r--"))))
(dolist (x alist)
(should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
(ert-deftest files-tests-no-file-write-contents ()
"Test that `write-contents-functions' permits saving a file.
Usually `basic-save-buffer' will prompt for a file name if the

View file

@ -75,6 +75,7 @@
;; Needed for Emacs 26.
(defvar async-shell-command-width)
;; Needed for Emacs 27.
(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
;; Beautify batch mode.
@ -4208,18 +4209,27 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
(should
(= 42
(process-file
;; Return exit code.
(should (= 42 (process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "exit 42")))
;; Return string in case the process is interrupted.
;; Return exit code in case the process is interrupted,
;; and there's no indication for a signal describing string.
(let (process-file-return-signal-string)
(should
(string-equal
"Signal 2"
(= (+ 128 2)
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$")))
nil nil nil "-c" "kill -2 $$"))))
;; Return string in case the process is interrupted and
;; there's an indication for a signal describing string.
(let ((process-file-return-signal-string t))
(should
(string-equal
"Interrupt"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$"))))
(with-temp-buffer
(write-region "foo" nil tmp-name)

View file

@ -28,31 +28,31 @@
(ert-deftest password-cache-tests-add-and-remove ()
(let ((password-data (copy-hash-table password-data)))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(should (eq (password-in-cache-p "foo") t))
(password-cache-remove "foo")
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-read-from-cache ()
(let ((password-data (copy-hash-table password-data)))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read-from-cache "foo") "bar"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-in-cache-p ()
(let ((password-data (copy-hash-table password-data)))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(should (password-in-cache-p "foo"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-read ()
(let ((password-data (copy-hash-table password-data)))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read nil "foo") "bar"))))
(ert-deftest password-cache-tests-reset ()
(let ((password-data (copy-hash-table password-data)))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(password-reset)
(should (not (password-in-cache-p "foo")))))
@ -60,14 +60,14 @@
:tags '(:expensive-test)
(let ((password-data (copy-hash-table password-data))
(password-cache-expiry 0.01))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(sit-for 0.1)
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-no-password-cache ()
(let ((password-data (copy-hash-table password-data))
(password-cache nil))
(password-cache-add "foo" "bar")
(password-cache-add "foo" (copy-sequence "bar"))
(should (not (password-in-cache-p "foo")))
(should (not (password-read-from-cache "foo")))))

View file

@ -0,0 +1,55 @@
;;; autoconf-tests.el --- Tests for autoconf.el -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
;; 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:
;;
;;; Code:
(require 'autoconf)
(require 'ert)
(ert-deftest autoconf-tests-current-defun-function-define ()
(with-temp-buffer
(insert "AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.])")
(goto-char (point-min))
(should-not (autoconf-current-defun-function))
(forward-char 10)
(should (equal (autoconf-current-defun-function) "HAVE_RSVG"))))
(ert-deftest autoconf-tests-current-defun-function-subst ()
(with-temp-buffer
(insert "AC_SUBST(srcdir)")
(goto-char (point-min))
(should-not (autoconf-current-defun-function))
(forward-char 9)
(should (equal (autoconf-current-defun-function) "srcdir"))))
(ert-deftest autoconf-tests-autoconf-mode-comment-syntax ()
(with-temp-buffer
(autoconf-mode)
(insert "dnl Autoconf script for GNU Emacs")
(should (nth 4 (syntax-ppss)))))
(provide 'autoconf-tests)
;;; autoconf-tests.el ends here

View file

@ -0,0 +1,47 @@
;;; startup-tests.el --- unit tests for startup.el -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Philipp Stephani <phst@google.com>
;; 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:
;; Unit tests for startup.el.
;;; Code:
(ert-deftest startup-tests/command-switch-alist ()
(let* ((foo-args ()) (bar-args ())
(command-switch-alist
(list (cons "--foo"
(lambda (arg)
(ert-info ("Processing argument --foo")
(push arg foo-args)
(should (equal command-line-args-left
'("value" "--bar=value")))
(pop command-line-args-left))))
(cons "--bar=value"
(lambda (arg)
(ert-info ("Processing argument --bar")
(push arg bar-args)
(should-not command-line-args-left)))))))
(command-line-1 '("--foo" "value" "--bar=value"))
(should (equal foo-args '("--foo")))
(should (equal bar-args '("--bar=value")))))
;;; startup-tests.el ends here

View file

@ -29,7 +29,8 @@
(cons 420 "rw-r--r--")
(cons 292 "r--r--r--")
(cons 512 "--------T")
(cons 1024 "-----S---"))))
(cons 1024 "-----S---")
(cons 2048 "--S------"))))
(dolist (x alist)
(should (equal (cdr x) (tar-grind-file-mode (car x)))))))

View file

@ -49,21 +49,21 @@
(should-error (nreverse))
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
(should (equal (nreverse "xyzzy") "yzzyx"))
(let ((A []))
(should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
(let ((A (vector)))
(nreverse A)
(should (equal A [])))
(let ((A [0]))
(let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
(let ((A [1 2 3 4]))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
(let ((A [1 2 3 4]))
(let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
(let* ((A [1 2 3 4])
(let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort ()
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9)))
(should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
(should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1)))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9]))
(should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
(should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1]))
(should (equal
(sort
@ -172,7 +172,7 @@
;; Punctuation and whitespace characters are relevant for POSIX.
(should
(equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account
@ -180,7 +180,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@ -190,7 +190,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical.
(should
(equal
(sort '("Ævar" "Agustín" "Adrian" "Eli")
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales,
@ -198,7 +198,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
(sort '("Ævar" "Agustín" "Adrian" "Eli")
(sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@ -212,7 +212,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png")))
(should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
(should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234"))
@ -432,9 +432,9 @@
(should-error (mapcan))
(should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo)))
(should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
(should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive
(let ((data '((foo) (bar))))
(let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))