Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
commit
cd4ef52c86
73 changed files with 705 additions and 1942 deletions
|
@ -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"
|
||||
|
|
|
@ -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)";
|
||||
|
|
|
@ -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)";
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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}.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
107
etc/NEWS
|
@ -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'.
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
|
|
@ -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"))))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
;;;
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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'
|
||||
|
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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")
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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 ")
|
||||
" "
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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'."
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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;
|
||||
|
|
10
src/lisp.h
10
src/lisp.h
|
@ -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;
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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. */
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")))))
|
||||
|
||||
|
|
55
test/lisp/progmodes/autoconf-tests.el
Normal file
55
test/lisp/progmodes/autoconf-tests.el
Normal 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
|
47
test/lisp/startup-tests.el
Normal file
47
test/lisp/startup-tests.el
Normal 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
|
|
@ -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)))))))
|
||||
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue