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

Merge remote-tracking branch 'savannah/master' into native-comp

Browse source
This commit is contained in:
Andrea Corallo 2021-03-31 10:48:02 +02:00
commit 515378434a
99 changed files with 8170 additions and 6730 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
ChangeLog.3
View file

@ -2,6 +2,20 @@
* Version 27.2 released.
2021-03-18 Basil L. Contovounesios <contovob@tcd.ie>
Fix 'frame-inner-height' in non-GUI builds
Include tab bar in frame's inner height in non-GUI builds that
don't define 'tab-bar-height'. This is consistent with the
inclusion of the menu bar in the calculated height. It is also
consistent with TTY frames of GUI builds, for which
'tab-bar-height' is always zero anyway (bug#47234).
Fix suggested by Eli Zaretskii <eliz@gnu.org>.
* lisp/frame.el (frame-inner-height): Don't assume
'tab-bar-height' is defined in builds --without-x.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
* etc/HISTORY: Update for Emacs 27.2.

4
admin/admin.el
View file

@ -151,7 +151,7 @@ Root must be the root of an Emacs source tree."
(display-warning 'admin
"NEWS file contains empty sections - remove them?"))
(goto-char (point-min))
(if (re-search-forward "^\\(\\+\\+\\+ *$\\|--- *$\\|Temporary note:\\)" nil t)
(if (re-search-forward "^\\(\\+\\+\\+? *$\\|---? *$\\|Temporary note:\\)" nil t)
(display-warning 'admin
"NEWS file still contains temporary markup.
Documentation changes might not have been completed!"))))
@ -545,7 +545,7 @@ Leave point after the table."
(forward-line 1)
(while (not done)
(cond ((re-search-forward "<tr><td.*&bull; \\(<a.*</a>\\)\
:</td><td>&nbsp;&nbsp;</td><td[^>]*>\\(.*\\)" (line-end-position) t)
:?</td><td>&nbsp;&nbsp;</td><td[^>]*>\\(.*\\)" (line-end-position) t)
(replace-match (format "<tr><td%s>\\1</td>\n<td>\\2"
(if table-workaround
" bgcolor=\"white\"" "")))

66
admin/make-tarball.txt
View file

@ -91,6 +91,12 @@ General steps (for each step, check for possible errors):
versioned ChangeLog.N and commit that along with etc/HISTORY.
Then you can tag that commit as the release.
Alternatively, you can commit and tag with the RC tag right away,
and delay the final tagging until you actually decide to make a
release and announce it. The "git tag" command can tag a specific
commit if you give it the SHA1 of that commit, even if additional
commits have been pushed in the meantime.
Name the tar file as emacs-XX.Y-rc1.tar. If all goes well in the
following week, you can simply rename the file and use it for the
actual release. If you need another release candidate, remember
@ -104,11 +110,11 @@ General steps (for each step, check for possible errors):
Never replace an existing tarfile! If you need to fix something,
always upload it with a different name.
4. autoreconf -i -I m4 --force
make bootstrap
4. autoreconf -i -I m4 --force
make bootstrap
make -C etc/refcards
make -C etc/refcards clean
make -C etc/refcards
make -C etc/refcards clean
If some of the etc/refcards, especially the non-English ones, fail
to build, you probably need to install some TeX/LaTeX packages, in
@ -122,13 +128,18 @@ General steps (for each step, check for possible errors):
5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el.
Commit ChangeLog.N, etc/AUTHORS, lisp/ldefs-boot.el, and the
files changed by M-x set-version.
files changed by M-x set-version. The easiest way of doing that
is "C-x v d ROOT-DIR RET", then go to the first modified file,
press 'M' to mark all modified files, and finally 'v' to commit
them. Make sure the commit log message mentions all the changes
in all modified files, as by default 'v' doesn't necessarily do
so.
If someone else made a commit between step 1 and now,
you need to repeat from step 4 onwards. (You can commit the files
from step 2 and 3 earlier to reduce the chance of this.)
6. ./make-dist --snapshot --no-compress
6. ./make-dist --snapshot --no-compress
Check the contents of the new tar with admin/diff-tar-files
against the previous release (if this is the first pretest) or the
@ -136,6 +147,14 @@ General steps (for each step, check for possible errors):
yourself, find it at <https://alpha.gnu.org/gnu/emacs/pretest>.
Releases are of course at <https://ftp.gnu.org/pub/gnu/emacs/>.
./admin/diff-tar-files emacs-OLD.tar.gz emacs-NEW.tar.gz
Alternatively:
tar tJf emacs-OLD.tar.xz | sed -e 's,^[^/]*,,' | sort > old_tmp
tar tJf emacs-NEW.tar.xz | sed -e 's,^[^/]*,,' | sort > new_tmp
diff -u old_tmp new_tmp
If this is the first pretest of a major release, just comparing
with the previous release may overlook many new files. You can try
something like 'find . | sort' in a clean repository, and compare the
@ -143,6 +162,7 @@ General steps (for each step, check for possible errors):
7. tar -xf emacs-NEW.tar; cd emacs-NEW
./configure --prefix=/tmp/emacs && make check && make install
Use 'script' or M-x compile to save the compilation log in
compile-NEW.log and compare it against an old one. The easiest way
to do that is to visit the old log in Emacs, change the version
@ -150,8 +170,23 @@ General steps (for each step, check for possible errors):
M-x ediff. Especially check that Info files aren't built, and that
no autotools (autoconf etc) run.
8. cd EMACS_ROOT_DIR && git tag -a TAG && git push origin tag TAG
TAG is emacs-XX.Y.ZZ for a pretest, emacs-XX.Y for a release.
8. You can now tag the release/pretest and push it together with the
last commit:
cd EMACS_ROOT_DIR && git tag -a TAG -m "Emacs TAG"
git push
git push --tags
Here TAG is emacs-XX.Y.ZZ for a pretest, emacs-XX.Y for a release.
For a release, if you are producing a release candidate first, use
emacs-XX.Y-rcN (N = 1, 2, ...) when you tar the RC, and add the
actual release tag later, when the official release tarball is
uploaded to ftp.gnu.org. When adding a tag later, it is safer to
use the SHA1 of the last commit which went into the release
tarball, in case there were some intervening commits since then:
git tag -a TAG -m "Emacs TAG" SHA1
git push --tags
9. Decide what compression schemes to offer.
For a release, at least gz and xz:
@ -215,8 +250,12 @@ General steps (for each step, check for possible errors):
because replies that invariably are not announcements also get
sent out as if they were.)
12. After a release, update the Emacs pages as below.
12. After a release, update the Emacs pages as described below.
13. Bump the Emacs version on the release branch.
If the released version was XX.Y, use 'set-version' from
admin/admin.el to bump the version on the release branch to
XX.Y.50. Commit the changes.
UPDATING THE EMACS WEB PAGES AFTER A RELEASE
@ -236,5 +275,14 @@ page for about a month, then comment it again.
Regenerate the various manuals in manual/.
The scripts admin/make-manuals and admin/upload-manuals summarize the process.
If you have Texinfo installed locally, make-manuals might fail if it
cannot find epsf.tex. In that case define in the environment
TEXINPUTS=:/path/to/texinfo-tree/doc
where /path/to/texinfo-tree is the absolute file name of the top-level
directory where you have the Texinfo source tree. Then re-run
make-manuals.
Browsing <https://web.cvs.savannah.gnu.org/viewvc/?root=emacs> is one
way to check for any files that still need updating.

15
admin/notes/emba
View file

@ -36,6 +36,21 @@ of the Emacs git repository to perform a bootstrap and test of Emacs.
This could happen for several jobs with changed configuration, compile
and test parameters.
There are different types of jobs: 'prep-image-base' is responsible to
prepare the environment for the following jobs. 'build-image-*' jobs
are responsible to compile Emacs in different configuration. The
corresponding 'test-*' jobs run the ert tests.
A special job is 'test-all-inotify', which runs 'make check-expensive'.
While most of the jobs run as soon as a respective file has been
committed into the Emacs git repository, this test job runs scheduled,
every 8 hours.
The log files for every test job are kept on the server for a week.
They can be downloaded from the server, visiting the URL
<https://emba.gnu.org/emacs/emacs/-/pipelines>, and selecting the job
in question.
* Emba configuration
The emba configuration files are hosted on

2
doc/lispref/files.texi
View file

@ -764,6 +764,8 @@ This function unlocks the file being visited in the current buffer,
if the buffer is modified. If the buffer is not modified, then
the file should not be locked, so this function does nothing. It also
does nothing if the current buffer is not visiting a file, or is not locked.
This function handles file system errors by calling @code{display-warning}
and otherwise ignores the error.
@end defun
@defopt create-lockfiles

20
doc/misc/tramp.texi
View file

@ -2305,6 +2305,8 @@ which support this.
This approach has also the advantage, that settings in
@code{tramp-sh-extra-args} will be applied. For @command{zsh}, the
trouble with the shell prompt due to set zle options will be avoided.
For @command{bash}, loading @file{~/.editrc} or @file{~/.inputrc} is
suppressed.
Similar problems can happen with the local shell Tramp uses to create
a process. By default, it uses the command @command{/bin/sh} for
@ -5076,6 +5078,24 @@ In case you have installed it from its Git repository, @ref{Recompilation}.
@end ifset
@item
I get an error @samp{tramp-file-name-handler: Invalid function:
tramp-compat-with-mutex}
Likely, you have a running Emacs session with loaded @value{tramp},
and you try to upgrade it to another version from GNU ELPA. Since
@value{tramp} is not forward compatible, you must unload / reload it.
Try the following steps:
@example
@kbd{M-x tramp-unload-tramp @key{RET}}
@kbd{M-x load-library @key{RET} tramp @key{RET}}
@end example
If this doesn't work, you must restart Emacs with proper
@code{load-path} for the new @value{tramp} version.
@item
I get an error @samp{Remote file error: Forbidden reentrant call of Tramp}

6
etc/NEWS
View file

@ -2514,6 +2514,12 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
* Lisp Changes in Emacs 28.1
+++
** 'unlock-buffer' displays warnings instead of signaling.
Instead of signaling 'file-error' conditions for file system level
errors, the function now calls 'display-warning' and continues as if
the error did not occur.
+++
** New function 'always'.
This is identical to 'ignore', but returns t instead.

1
etc/NEWS.27
View file

@ -966,7 +966,6 @@ the entire list as before. An integer value limits the list length
*** 'vc-git-stash' is now bound to 'C' in the stash headers.
--
*** Some stash keybindings are now available in the stash button.
'vc-git-stash' and 'vc-git-stash-snapshot' can now be run using 'C'
and 'S' respectively, including when there are no stashes.

892
etc/schema/OpenDocument-schema-v1.3+libreoffice.rnc Normal file
View file

@ -0,0 +1,892 @@
# Open Document Format for Office Applications (OpenDocument) Version 1.3
# OASIS Standard, In progress
# Relax-NG Schema
# Source: https://tools.oasis-open.org/version-control/svn/office/
# Copyright (c) OASIS Open 2002-2015. All Rights Reserved.
#
# All capitalized terms in the following text have the meanings assigned to them
# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The
# full Policy may be found at the OASIS website.
#
# This document and translations of it may be copied and furnished to others, and
# derivative works that comment on or otherwise explain it or assist in its
# implementation may be prepared, copied, published, and distributed, in whole or
# in part, without restriction of any kind, provided that the above copyright
# notice and this section are included on all such copies and derivative works.
# However, this document itself may not be modified in any way, including by
# removing the copyright notice or references to OASIS, except as needed for the
# purpose of developing any document or deliverable produced by an OASIS
# Technical Committee (in which case the rules applicable to copyrights, as set
# forth in the OASIS IPR Policy, must be followed) or as required to translate it
# into languages other than English.
#
# The limited permissions granted above are perpetual and will not be revoked by
# OASIS or its successors or assigns.
#
# This document and the information contained herein is provided on an "AS IS"
# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT
# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT
# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR
# FITNESS FOR A PARTICULAR PURPOSE.
namespace anim = "urn:oasis:names:tc:opendocument:xmlns:animation:1.0"
namespace calcext =
"urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0"
namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
namespace chartooo = "http://openoffice.org/2010/chart"
namespace config = "urn:oasis:names:tc:opendocument:xmlns:config:1.0"
namespace css3t = "http://www.w3.org/TR/css3-text/"
namespace db = "urn:oasis:names:tc:opendocument:xmlns:database:1.0"
namespace dc = "http://purl.org/dc/elements/1.1/"
namespace dr3d = "urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0"
namespace draw = "urn:oasis:names:tc:opendocument:xmlns:drawing:1.0"
namespace drawooo = "http://openoffice.org/2010/draw"
namespace field =
"urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0"
namespace fo =
"urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0"
namespace form = "urn:oasis:names:tc:opendocument:xmlns:form:1.0"
namespace grddl = "http://www.w3.org/2003/g/data-view#"
namespace loext =
"urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0"
namespace math = "http://www.w3.org/1998/Math/MathML"
namespace meta = "urn:oasis:names:tc:opendocument:xmlns:meta:1.0"
namespace number = "urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0"
namespace office = "urn:oasis:names:tc:opendocument:xmlns:office:1.0"
namespace officeooo = "http://openoffice.org/2009/office"
namespace presentation =
"urn:oasis:names:tc:opendocument:xmlns:presentation:1.0"
namespace rng = "http://relaxng.org/ns/structure/1.0"
namespace script = "urn:oasis:names:tc:opendocument:xmlns:script:1.0"
namespace smil =
"urn:oasis:names:tc:opendocument:xmlns:smil-compatible:1.0"
namespace style = "urn:oasis:names:tc:opendocument:xmlns:style:1.0"
namespace svg =
"urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0"
namespace table = "urn:oasis:names:tc:opendocument:xmlns:table:1.0"
namespace tableooo = "http://openoffice.org/2009/table"
namespace text = "urn:oasis:names:tc:opendocument:xmlns:text:1.0"
namespace xforms = "http://www.w3.org/2002/xforms"
namespace xhtml = "http://www.w3.org/1999/xhtml"
namespace xlink = "http://www.w3.org/1999/xlink"
include "OpenDocument-schema-v1.3.rnc" {
office-document-common-attrs =
attribute office:version {
# FIXME remove this hack once we write 1.3
"1.3" | "1.2"
}
& attribute grddl:transformation {
list { anyIRI* }
}?
style-graphic-properties-attlist =
attribute draw:stroke { "none" | "dash" | "solid" }?
& attribute draw:stroke-dash { styleNameRef }?
& attribute draw:stroke-dash-names { styleNameRefs }?
& attribute svg:stroke-width { length }?
& attribute svg:stroke-color { color }?
& attribute draw:marker-start { styleNameRef }?
& attribute draw:marker-end { styleNameRef }?
& attribute draw:marker-start-width { length }?
& attribute draw:marker-end-width { length }?
& attribute draw:marker-start-center { boolean }?
& attribute draw:marker-end-center { boolean }?
& attribute svg:stroke-opacity {
xsd:double { minInclusive = "0" maxInclusive = "1" }
| zeroToHundredPercent
}?
& attribute draw:stroke-linejoin {
"miter" | "round" | "bevel" | "middle" | "none"
}?
& attribute svg:stroke-linecap { "butt" | "square" | "round" }?
& attribute draw:symbol-color { color }?
& attribute text:animation {
"none" | "scroll" | "alternate" | "slide"
}?
& attribute text:animation-direction {
"left" | "right" | "up" | "down"
}?
& attribute text:animation-start-inside { boolean }?
& attribute text:animation-stop-inside { boolean }?
& attribute text:animation-repeat { nonNegativeInteger }?
& attribute text:animation-delay { duration }?
& attribute text:animation-steps { length }?
& attribute draw:auto-grow-width { boolean }?
& attribute draw:auto-grow-height { boolean }?
& # FIXME remove this once the export bug is fixed
attribute draw:fit-to-size {
"true" | "false" | "all" | "shrink-to-fit"
}?
& attribute draw:fit-to-contour { boolean }?
& attribute draw:textarea-vertical-align {
"top" | "middle" | "bottom" | "justify"
}?
& attribute draw:textarea-horizontal-align {
"left" | "center" | "right" | "justify"
}?
& attribute fo:wrap-option { "no-wrap" | "wrap" }?
& attribute style:shrink-to-fit { boolean }?
& attribute draw:color-mode {
"greyscale" | "mono" | "watermark" | "standard"
}?
& attribute draw:color-inversion { boolean }?
& attribute draw:luminance { signedZeroToHundredPercent }
# https://issues.oasis-open.org/browse/OFFICE-3821
?
& attribute draw:contrast { percent }?
& attribute draw:gamma { percent }?
& attribute draw:red { signedZeroToHundredPercent }?
& attribute draw:green { signedZeroToHundredPercent }?
& attribute draw:blue { signedZeroToHundredPercent }?
& attribute draw:image-opacity { zeroToHundredPercent }?
& attribute draw:shadow { "visible" | "hidden" }?
& attribute draw:shadow-offset-x { length }?
& attribute draw:shadow-offset-y { length }?
& attribute draw:shadow-color { color }?
& attribute draw:shadow-opacity { zeroToHundredPercent }?
& # TODO: no proposal for loext:shadow-blur
attribute loext:shadow-blur { length }?
& attribute draw:start-line-spacing-horizontal { distance }?
& attribute draw:start-line-spacing-vertical { distance }?
& attribute draw:end-line-spacing-horizontal { distance }?
& attribute draw:end-line-spacing-vertical { distance }?
& attribute draw:line-distance { distance }?
& attribute draw:guide-overhang { length }?
& attribute draw:guide-distance { distance }?
& attribute draw:start-guide { length }?
& attribute draw:end-guide { length }?
& attribute draw:placing { "below" | "above" }?
& attribute draw:parallel { boolean }?
& attribute draw:measure-align {
"automatic" | "left-outside" | "inside" | "right-outside"
}?
& attribute draw:measure-vertical-align {
"automatic" | "above" | "below" | "center"
}?
& attribute draw:unit {
"automatic"
| "mm"
| "cm"
| "m"
| "km"
| "pt"
| "pc"
| "inch"
| "ft"
| "mi"
}?
& attribute draw:show-unit { boolean }?
& attribute draw:decimal-places { nonNegativeInteger }?
& attribute draw:caption-type {
"straight-line" | "angled-line" | "angled-connector-line"
}?
& attribute draw:caption-angle-type { "fixed" | "free" }?
& attribute draw:caption-angle { angle }?
& attribute draw:caption-gap { distance }?
& attribute draw:caption-escape-direction {
"horizontal" | "vertical" | "auto"
}?
& attribute draw:caption-escape { length | percent }?
& attribute draw:caption-line-length { length }?
& attribute draw:caption-fit-line-length { boolean }?
& attribute dr3d:horizontal-segments { nonNegativeInteger }?
& attribute dr3d:vertical-segments { nonNegativeInteger }?
& attribute dr3d:edge-rounding { percent }?
& attribute dr3d:edge-rounding-mode { "correct" | "attractive" }?
& attribute dr3d:back-scale { percent }?
& attribute dr3d:depth { length }?
& attribute dr3d:backface-culling { "enabled" | "disabled" }?
& attribute dr3d:end-angle { angle }?
& attribute dr3d:close-front { boolean }?
& attribute dr3d:close-back { boolean }?
& attribute dr3d:lighting-mode { "standard" | "double-sided" }?
& attribute dr3d:normals-kind { "object" | "flat" | "sphere" }?
& attribute dr3d:normals-direction { "normal" | "inverse" }?
& attribute dr3d:texture-generation-mode-x {
"object" | "parallel" | "sphere"
}?
& attribute dr3d:texture-generation-mode-y {
"object" | "parallel" | "sphere"
}?
& attribute dr3d:texture-kind {
"luminance" | "intensity" | "color"
}?
& attribute dr3d:texture-filter { "enabled" | "disabled" }?
& attribute dr3d:texture-mode { "replace" | "modulate" | "blend" }?
& attribute dr3d:ambient-color { color }?
& attribute dr3d:emissive-color { color }?
& attribute dr3d:specular-color { color }?
& attribute dr3d:diffuse-color { color }?
& attribute dr3d:shininess { percent }?
& attribute dr3d:shadow { "visible" | "hidden" }?
& common-draw-rel-size-attlist
& attribute fo:min-width { length | percent }?
& attribute fo:min-height { length | percent }?
& attribute fo:max-height { length | percent }?
& attribute fo:max-width { length | percent }?
& common-horizontal-margin-attlist
& common-vertical-margin-attlist
& common-margin-attlist
& attribute style:print-content { boolean }?
& attribute style:protect {
"none"
| list { ("content" | "position" | "size")+ }
}?
& attribute style:horizontal-pos {
"left"
| "center"
| "right"
| "from-left"
| "inside"
| "outside"
| "from-inside"
}?
& attribute svg:x { coordinate }?
& attribute style:horizontal-rel {
"page"
| "page-content"
| "page-start-margin"
| "page-end-margin"
| "frame"
| "frame-content"
| "frame-start-margin"
| "frame-end-margin"
| "paragraph"
| "paragraph-content"
| "paragraph-start-margin"
| "paragraph-end-margin"
| "char"
}?
& common-vertical-pos-attlist
& common-vertical-rel-attlist
& common-text-anchor-attlist
& common-border-attlist
& common-border-line-width-attlist
& common-padding-attlist
& common-shadow-attlist
& common-background-color-attlist
& common-background-transparency-attlist
& common-editable-attlist
& attribute style:wrap {
"none"
| "left"
| "right"
| "parallel"
| "dynamic"
| "run-through"
| "biggest"
}?
& attribute style:wrap-dynamic-threshold { nonNegativeLength }?
& attribute style:number-wrapped-paragraphs {
"no-limit" | positiveInteger
}?
& attribute style:wrap-contour { boolean }?
& attribute style:wrap-contour-mode { "full" | "outside" }?
& attribute style:run-through { "foreground" | "background" }?
& attribute style:flow-with-text { boolean }?
& attribute style:overflow-behavior {
"clip" | "auto-create-new-frame"
}?
& attribute style:mirror {
"none"
| "vertical"
| horizontal-mirror
| list { "vertical", horizontal-mirror }
| list { horizontal-mirror, "vertical" }
}?
& attribute fo:clip { "auto" | clipShape }?
& attribute draw:wrap-influence-on-position {
"iterative" | "once-concurrent" | "once-successive"
}?
& common-writing-mode-attlist
& attribute draw:frame-display-scrollbar { boolean }?
& attribute draw:frame-display-border { boolean }?
& attribute draw:frame-margin-horizontal { nonNegativePixelLength }?
& attribute draw:frame-margin-vertical { nonNegativePixelLength }?
& attribute draw:visible-area-left { nonNegativeLength }?
& attribute draw:visible-area-top { nonNegativeLength }?
& attribute draw:visible-area-width { positiveLength }?
& attribute draw:visible-area-height { positiveLength }?
& attribute draw:draw-aspect {
"content" | "thumbnail" | "icon" | "print-view"
}?
& attribute draw:ole-draw-aspect { nonNegativeInteger }?
& # https://issues.oasis-open.org/browse/OFFICE-4047
attribute loext:allow-overlap { boolean }?
& # TODO: no proposal for loext:glow*
attribute loext:glow-radius { length }?
& attribute loext:glow-color { color }?
& attribute loext:glow-transparency { zeroToHundredPercent }?
& # TODO: no proposal for loext:softedge-radius
attribute loext:softedge-radius { length }?
draw-text =
(text-p
| text-list
| # https://issues.oasis-open.org/browse/OFFICE-3761
loext-table)*
office-annotation-attlist &=
attribute office:display { boolean }?
& common-office-annotation-name-attlist?
& attribute loext:resolved { boolean }?
style-style-content =
(attribute style:family { "text" },
style-text-properties?)
| (attribute style:family { "paragraph" },
# TODO no proposal
loext-graphic-properties?,
style-paragraph-properties?,
style-text-properties?)
| (attribute style:family { "section" },
style-section-properties?)
| (attribute style:family { "ruby" },
style-ruby-properties?)
| (attribute style:family { "table" },
style-table-properties?)
| (attribute style:family { "table-column" },
style-table-column-properties?)
| (attribute style:family { "table-row" },
style-table-row-properties?)
| (attribute style:family { "table-cell" },
# TODO no proposal
loext-graphic-properties?,
style-table-cell-properties?,
style-paragraph-properties?,
style-text-properties?)
| (attribute style:family { "graphic" | "presentation" },
style-graphic-properties?,
style-paragraph-properties?,
style-text-properties?)
| (attribute style:family { "drawing-page" },
style-drawing-page-properties?)
| (attribute style:family { "chart" },
style-chart-properties?,
style-graphic-properties?,
style-paragraph-properties?,
style-text-properties?)
table-table-template =
element table:table-template {
table-table-template-attlist,
table-first-row?,
table-last-row?,
table-first-column?,
table-last-column?,
table-body,
table-even-rows?,
table-odd-rows?,
table-even-columns?,
table-odd-columns?,
table-background?,
# TODO no proposal
table-first-row-even-column?,
table-last-row-even-column?,
table-first-row-end-column?,
table-first-row-start-column?,
table-last-row-end-column?,
table-last-row-start-column?
}
draw-frame =
element draw:frame {
common-draw-shape-with-text-and-styles-attlist,
common-draw-position-attlist,
common-draw-rel-size-attlist,
common-draw-caption-id-attlist,
presentation-shape-attlist,
draw-frame-attlist,
(draw-text-box
| draw-image
| draw-object
| draw-object-ole
| draw-applet
| draw-floating-frame
| draw-plugin
| table-table)*,
office-event-listeners?,
draw-glue-point*,
draw-image-map?,
svg-title?,
svg-desc?,
(draw-contour-polygon | draw-contour-path)?,
# TODO no proposal
loext-signatureline?,
loext-qrcode?
}
common-value-and-type-attlist =
(attribute office:value-type { "float" },
attribute calcext:value-type { "float" }?,
attribute office:value { double })
| (attribute office:value-type { "percentage" },
attribute calcext:value-type { "percentage" }?,
attribute office:value { double })
| (attribute office:value-type { "currency" },
attribute calcext:value-type { "currency" }?,
attribute office:value { double },
attribute office:currency { \string }?)
| (attribute office:value-type { "date" },
attribute calcext:value-type { "date" }?,
attribute office:date-value { dateOrDateTime })
| (attribute office:value-type { "time" },
attribute calcext:value-type { "time" }?,
attribute office:time-value { duration })
| (attribute office:value-type { "boolean" },
attribute calcext:value-type { "boolean" }?,
attribute office:boolean-value { boolean })
| (attribute office:value-type { "string" },
# OFFICE-3759
attribute calcext:value-type { "string" | "error" }?,
attribute office:string-value { \string }?)
chart-axis =
element chart:axis {
chart-axis-attlist,
# OFFICE-2119
((attribute chartooo:axis-type { "auto" },
chartooo-date-scale?)
| (attribute chartooo:axis-type { "date" },
chartooo-date-scale)
| attribute chartooo:axis-type { "text" })?,
chart-title?,
chart-categories?,
chart-grid*
}
table-table =
element table:table {
table-table-attlist,
table-title?,
table-desc?,
# TODO add to proposal, OFFICE-2112
table-table-protection?,
table-table-source?,
office-dde-source?,
table-scenario?,
office-forms?,
table-shapes?,
table-columns-and-groups,
table-rows-and-groups,
table-named-expressions?,
# TODO no proposal, this is wild guessing, OFFICE-3785
element calcext:conditional-formats {
element calcext:conditional-format {
attribute calcext:target-range-address { cellRangeAddress },
(element calcext:condition {
attribute calcext:apply-style-name { styleNameRef },
attribute calcext:value { \string },
attribute calcext:base-cell-address { cellAddress }
}+
| element calcext:data-bar {
attribute calcext:max-length { \string },
attribute calcext:negative-color { color },
attribute calcext:positive-color { color },
attribute calcext:axis-color { color },
attribute calcext:axis-position { "middle" }?,
element calcext:formatting-entry {
attribute calcext:value { \string },
attribute calcext:type {
"auto-minimum"
| "auto-maximum"
| "minimum"
| "maximum"
| "percent"
| "percentile"
| "number"
| "formula"
}
},
element calcext:formatting-entry {
attribute calcext:value { \string },
attribute calcext:type {
"auto-minimum"
| "auto-maximum"
| "minimum"
| "maximum"
| "percent"
| "percentile"
| "number"
| "formula"
}
}
}
| element calcext:color-scale {
element calcext:color-scale-entry {
attribute calcext:value { \string },
attribute calcext:type {
"minimum"
| "maximum"
| "percent"
| "percentile"
| "number"
| "formula"
},
attribute calcext:color { color }
},
element calcext:color-scale-entry {
attribute calcext:value { \string },
attribute calcext:type {
"minimum"
| "maximum"
| "percent"
| "percentile"
| "number"
| "formula"
},
attribute calcext:color { color }
},
element calcext:color-scale-entry {
attribute calcext:value { \string },
attribute calcext:type {
"minimum"
| "maximum"
| "percent"
| "percentile"
| "number"
| "formula"
},
attribute calcext:color { color }
}?
})
}+
}?
}
# TODO no proposal
draw-object =
element draw:object {
draw-object-attlist,
loext-text,
(common-draw-data-attlist | office-document | math-math)
}
draw-object-ole =
element draw:object-ole {
draw-object-ole-attlist,
loext-text,
(common-draw-data-attlist | office-binary-data)
}
# FIXME: one test exports 250 here, which is probably a bug
fontWeight =
"normal"
| "bold"
| "100"
| "200"
| "250"
| "300"
| "400"
| "500"
| "600"
| "700"
| "800"
| "900"
}
# TODO no proposal
loext-p =
element loext:p { paragraph-attrs, paragraph-content-or-hyperlink* }
loext-text = (loext-p | text-list | loext-table)*
# OFFICE-2119
chartooo-date-scale =
element chartooo:date-scale {
attribute chart:base-time-unit { chart-time-unit }?
& (attribute chart:major-interval-value { positiveInteger },
attribute chart:major-interval-unit { chart-time-unit })?
& (attribute chart:minor-interval-value { positiveInteger },
attribute chart:minor-interval-unit { chart-time-unit })?
}
chart-time-unit = "days" | "months" | "years"
# TODO no proposal
loext-signatureline =
element loext:signatureline {
attribute loext:id { \string },
attribute loext:suggested-signer-name { \string },
attribute loext:suggested-signer-title { \string },
attribute loext:suggested-signer-email { \string },
attribute loext:signing-instructions { \string },
attribute loext:show-sign-date { boolean },
attribute loext:can-add-comment { boolean }
}
loext-qrcode =
element loext:qrcode {
attribute office:string-value { \string },
attribute loext:qrcode-errorcorrection {
"low" | "medium" | "quartile" | "high"
},
attribute loext:qrcode-border { nonNegativeInteger }
}
# https://issues.oasis-open.org/browse/OFFICE-3761
loext-table =
element loext:table {
table-table-attlist,
table-title?,
table-desc?,
table-table-source?,
office-dde-source?,
table-scenario?,
office-forms?,
table-shapes?,
loext-columns-and-groups,
loext-rows-and-groups,
table-named-expressions?
}
loext-rows-and-groups = (table-table-row-group | loext-rows-no-group)+
loext-rows-no-group =
(loext-rows, (table-table-header-rows, loext-rows?)?)
| (table-table-header-rows, loext-rows?)
loext-rows =
table-table-rows | (text-soft-page-break?, loext-table-row)+
loext-table-row =
element loext:table-row {
table-table-row-attlist,
(loext-table-cell | loext-covered-table-cell)+
}
loext-table-cell =
element loext:table-cell {
table-table-cell-attlist,
table-table-cell-attlist-extra,
table-table-cell-content
}
loext-covered-table-cell =
element loext:covered-table-cell {
table-table-cell-attlist, table-table-cell-content
}
loext-columns-and-groups =
(table-table-column-group | loext-columns-no-group)+
loext-columns-no-group =
(loext-columns, (table-table-header-columns, loext-columns?)?)
| (table-table-header-columns, loext-columns?)
loext-columns = loext-table-columns | loext-table-column+
loext-table-columns =
element loext:table-columns { loext-table-column+ }
loext-table-column =
element loext:table-column { table-table-column-attlist, empty }
loext-graphic-properties =
element loext:graphic-properties {
style-graphic-properties-content-strict
}
table-first-row-even-column =
element loext:first-row-even-column {
common-table-template-attlist, empty
}
table-last-row-even-column =
element loext:last-row-even-column {
common-table-template-attlist, empty
}
table-first-row-end-column =
element loext:first-row-end-column {
common-table-template-attlist, empty
}
table-first-row-start-column =
element loext:first-row-start-column {
common-table-template-attlist, empty
}
table-last-row-end-column =
element loext:last-row-end-column {
common-table-template-attlist, empty
}
table-last-row-start-column =
element loext:last-row-start-column {
common-table-template-attlist, empty
}
common-draw-rel-size-attlist &=
# OFFICE-3854
attribute loext:rel-width-rel {
"page"
| [
# TODO layout-environment ?
]
"paragraph"
}?,
attribute loext:rel-height-rel { "page" | "paragraph" }?
common-svg-font-face-xlink-attlist &=
# TODO no proposal
attribute loext:font-style { fontStyle }?,
attribute loext:font-weight { fontWeight }?
# TODO no proposal
# there's no ref-attrs so add it here
text-common-ref-content &=
attribute loext:reference-language { language }?
style-list-level-label-alignment-attlist &=
# TODO no proposal
attribute loext:label-followed-by {
"listtab" | "space" | "nothing" | "newline"
}?
style-ruby-properties-attlist &=
# TODO proposal, OFFICE-3944
attribute loext:ruby-position {
"above" | "below" | "inter-character"
}?
style-text-properties-attlist &=
# TODO no proposal
attribute officeooo:rsid { \string }?,
attribute officeooo:paragraph-rsid { \string }?,
# https://issues.oasis-open.org/browse/OFFICE-4049
attribute loext:opacity { zeroToHundredPercent }?
style-text-properties-attlist &=
# OFFICE-3843
attribute loext:padding { nonNegativeLength }?,
attribute loext:padding-left { nonNegativeLength }?,
attribute loext:padding-right { nonNegativeLength }?,
attribute loext:padding-top { nonNegativeLength }?,
attribute loext:padding-bottom { nonNegativeLength }?,
attribute loext:border { \string }?,
attribute loext:border-left { \string }?,
attribute loext:border-right { \string }?,
attribute loext:border-top { \string }?,
attribute loext:border-bottom { \string }?,
attribute loext:shadow { shadowType }?
# TODO no proposal
style-chart-properties-attlist &=
attribute loext:try-staggering-first { boolean }?
# TODO no proposal
style-chart-properties-attlist &=
attribute loext:std-weight { \string }?
# TODO no proposal
chart-series-attlist &= attribute loext:label-string { \string }?
# OFFICE-1148
style-chart-properties-attlist &=
attribute loext:regression-max-degree { positiveInteger }?,
attribute loext:regression-force-intercept { boolean }?,
attribute loext:regression-intercept-value { double }?,
attribute loext:regression-name { \string }?,
attribute loext:regression-period { \string }?,
attribute loext:regression-extrapolate-forward { \string }?,
attribute loext:regression-extrapolate-backward { \string }?
# TODO no proposal
table-data-pilot-field-attlist &=
attribute tableooo:display-name { \string }?
# TODO no proposal, 9009663d
chart-chart-attlist &= attribute loext:data-pilot-source { \string }?
# OFFICE-2112, TODO half of this missing in proposal
table-table-protection =
element loext:table-protection {
attribute loext:select-protected-cells { boolean }?,
attribute loext:select-unprotected-cells { boolean }?,
attribute loext:insert-columns { boolean }?,
attribute loext:insert-rows { boolean }?,
attribute loext:delete-columns { boolean }?,
attribute loext:delete-rows { boolean }?
}
office-spreadsheet-attlist &=
attribute loext:protection-key-digest-algorithm-2 { anyURI }?
table-table-attlist &=
attribute loext:protection-key-digest-algorithm-2 { anyURI }?
# https://issues.oasis-open.org/browse/OFFICE-2317
vertJustifyValues = "auto" | "distribute"
common-text-justify =
attribute css3t:text-justify { vertJustifyValues }?
style-vertical-justify =
attribute loext:vertical-justify { vertJustifyValues }?,
attribute style:vertical-justify { vertJustifyValues }?
style-paragraph-properties-attlist &=
(common-text-justify, style-vertical-justify)?
style-table-cell-properties-attlist &=
(common-text-justify, style-vertical-justify)?
number-fraction-attlist &=
# OFFICE-3695
# TODO no proposal, 1544a26ac9f7dd60605dd21e9cbe29d490aafdce
attribute loext:max-numerator-digits { positiveInteger }?
# TODO no proposal
table-data-pilot-level-attlist &=
attribute calcext:repeat-item-labels { boolean }?
# TODO no proposal
draw-enhanced-geometry-attlist &=
attribute drawooo:sub-view-size { \string }?,
attribute drawooo:enhanced-path { \string }?
# TODO no proposal
draw-custom-shape-attlist &= common-draw-rel-size-attlist
# TODO no proposal
style-page-layout-properties-attlist &=
style-graphic-fill-properties-attlist
style-header-footer-properties-attlist &=
style-graphic-fill-properties-attlist
# TODO no proposal
text-index-entry-tab-stop-attrs &= attribute style:with-tab { boolean }?
# TODO no proposal
style-text-properties-attlist &=
attribute loext:char-shading-value { \string }?
# TODO no proposal
text-bookmark-start-attlist &=
(attribute loext:hidden { boolean },
attribute loext:condition { \string }?)?
# TODO no proposal; see 7a5d79f2297a43d0a854e304b0792164272edfe0
# FIXME this is almost certainly incomplete: need to figure out which elements can have this and which named pattern can be extended with it to get exactly these elements
form-checkbox-attlist &= attribute form:input-required { boolean }?
# https://issues.oasis-open.org/browse/OFFICE-4030
common-writing-mode-attlist &= attribute loext:writing-mode { "bt-lr" }?
# https://issues.oasis-open.org/browse/OFFICE-4073
common-vertical-rel-attlist &=
attribute loext:vertical-rel {
"page-content-top" | "page-content-bottom"
}?
# https://issues.oasis-open.org/browse/OFFICE-4105
style-page-layout-properties-attlist &=
attribute loext:margin-gutter { length }?
# just a test-case for user-defined attributes, move along, nothing to see here...
style-table-cell-properties-attlist &= attribute proName { \string }?
# TODO no proposal
chart-data-point-attlist &=
attribute loext:custom-label-field { \string }?
# TODO no proposal
style-text-properties-attlist &=
attribute loext:hyphenation-no-caps { boolean }?
# TODO no proposal
chart-data-point-attlist &=
(attribute loext:custom-label-pos-x { double },
attribute loext:custom-label-pos-y { double })?
# TODO no proposal
chart-legend-attlist &= attribute loext:overlay { boolean }?
# https://issues.oasis-open.org/browse/OFFICE-3936
style-chart-properties-attlist &=
attribute loext:major-origin { double }?
# TODO no proposal
text-index-entry-chapter-attrs &=
attribute loext:outline-content-visible { boolean }?
# https://issues.oasis-open.org/browse/OFFICE-2096
paragraph-content |=
element field:fieldmark-start {
attribute text:name { \string },
attribute field:type {
# TODO <rng:ref name="namespacedToken"/>
\string
},
element field:param {
attribute field:name { \string },
attribute field:value { \string }
}*
}
paragraph-content |= element field:fieldmark-end { empty }
paragraph-content |=
element field:fieldmark {
attribute text:name { \string },
attribute field:type {
# TODO <rng:ref name="namespacedToken"/>
\string
},
element field:param {
attribute field:name { \string },
attribute field:value { \string }
}*
}
# TODO no proposal
animation-element |=
element loext:animatePhysics {
common-anim-target-attlist,
common-timing-attlist,
animate-physics-attlist
}
animate-physics-attlist =
# default value: 0
attribute loext:velocity-x { double }?,
# default value: 0
attribute loext:velocity-y { double }?,
# default value: 0.1
attribute loext:bounciness {
xsd:double { minInclusive = "0" maxInclusive = "1" }
}?,
# default value: 1
attribute loext:density {
xsd:double { minInclusive = "0" }
}?
# TODO no proposal
style-chart-properties-attlist &=
attribute loext:custom-leader-lines { boolean }?
# TODO no proposal
style-chart-properties-attlist &=
attribute loext:external-data { \string }?

10834
etc/schema/od-schema-v1.2-os.rnc → etc/schema/OpenDocument-schema-v1.3.rnc
View file

File diff suppressed because it is too large Load diff

6
etc/schema/schemas.xml
View file

@ -31,6 +31,10 @@
<namespace ns="http://relaxng.org/ns/structure/1.0" typeId="RELAX NG"/>
<namespace ns="http://thaiopensource.com/ns/locating-rules/1.0"
uri="locate.rnc"/>
<namespace ns="urn:oasis:names:tc:opendocument:xmlns:office:1.0" typeId="LibreOffice"/>
<namespace ns="urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0" typeId="LibreOffice"/>
<namespace ns="urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0" typeId="LibreOffice"/>
<namespace ns="urn:oasis:names:tc:opendocument:xmlns:manifest:1.0" typeId="OpenDocument Manifest"/>
<documentElement localName="stylesheet" typeId="XSLT"/>
<documentElement prefix="xsl" localName="transform" typeId="XSLT"/>
@ -59,7 +63,7 @@
<documentElement prefix="office" typeId="OpenDocument"/>
<documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/>
<typeId id="OpenDocument" uri="od-schema-v1.2-os.rnc"/>
<typeId id="LibreOffice" uri="OpenDocument-schema-v1.3+libreoffice.rnc"/>
<typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
</locatingRules>

94
lisp/allout-widgets.el
View file

@ -1,4 +1,4 @@
;; allout-widgets.el --- Visually highlight allout outline structure.
;; allout-widgets.el --- Visually highlight allout outline structure. -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@ -72,11 +72,11 @@
(eval-when-compile (require 'cl-lib))
;;;_ : internal variables needed before user-customization variables
;;; In order to enable activation of allout-widgets-mode via customization,
;;; allout-widgets-auto-activation uses a setting function. That function
;;; is invoked when the customization variable definition is evaluated,
;;; during file load, so the involved code must reside above that
;;; definition in the file.
;; In order to enable activation of allout-widgets-mode via customization,
;; allout-widgets-auto-activation uses a setting function. That function
;; is invoked when the customization variable definition is evaluated,
;; during file load, so the involved code must reside above that
;; definition in the file.
;;;_ = allout-widgets-mode
(defvar-local allout-widgets-mode nil
"Allout mode enhanced with graphical widgets.")
@ -100,8 +100,8 @@ with allout-mode."
See `allout-widgets-mode-inhibit' for per-file/per-buffer
inhibition of allout-widgets-mode."
(add-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
(add-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
(add-hook 'allout-mode-off-hook #'allout-widgets-mode-off)
(add-hook 'allout-mode-on-hook #'allout-widgets-mode-on)
t)
;;;_ > allout-widgets-mode-disable
(defun allout-widgets-mode-disable ()
@ -109,8 +109,8 @@ inhibition of allout-widgets-mode."
See `allout-widgets-mode-inhibit' for per-file/per-buffer
inhibition of allout-widgets-mode."
(remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
(remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
(remove-hook 'allout-mode-off-hook #'allout-widgets-mode-off)
(remove-hook 'allout-mode-on-hook #'allout-widgets-mode-on)
t)
;;;_ > allout-widgets-setup (varname value)
;;;###autoload
@ -141,7 +141,7 @@ See `allout-widgets-mode' for allout widgets mode features."
:version "24.1"
:type 'boolean
:group 'allout-widgets
:set 'allout-widgets-setup
:set #'allout-widgets-setup
)
;; ;;;_ = allout-widgets-allow-unruly-edits
;; (defcustom allout-widgets-allow-unruly-edits nil
@ -307,7 +307,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode
buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
(put 'allout-widgets-mode-inhibit 'safe-local-variable #'booleanp)
;;;_ = allout-inhibit-body-modification-hook
(defvar-local allout-inhibit-body-modification-hook nil
"Override de-escaping of text-prefixes in item bodies during specific changes.
@ -402,14 +402,14 @@ not altered with an escape sequence.")
(set-keymap-parent km as-parent)
(dolist (digit '("0" "1" "2" "3"
"4" "5" "6" "7" "8" "9"))
(define-key km digit 'digit-argument))
(define-key km "-" 'negative-argument)
(define-key km digit #'digit-argument))
(define-key km "-" #'negative-argument)
;; Override underlying mouse-1 and mouse-2 bindings in icon territory:
(define-key km [(mouse-1)] (lambda () (interactive) nil))
(define-key km [(mouse-2)] (lambda () (interactive) nil))
(define-key km [(mouse-1)] #'ignore)
(define-key km [(mouse-2)] #'ignore)
;; Catchall, handles actual keybindings, dynamically doing keymap lookups:
(define-key km [t] 'allout-item-icon-key-handler)
(define-key km [t] #'allout-item-icon-key-handler)
km)
"General tree-node key bindings.")
@ -535,7 +535,7 @@ outline hot-spot navigation (see `allout-mode')."
"\\1\\3"))
)
(add-hook 'after-change-functions 'allout-widgets-after-change-handler
(add-hook 'after-change-functions #'allout-widgets-after-change-handler
nil t)
(allout-setup-text-properties)
@ -551,23 +551,23 @@ outline hot-spot navigation (see `allout-mode')."
(set-keymap-parent allout-item-icon-keymap as-parent))
(add-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder nil 'local)
#'allout-widgets-exposure-change-recorder nil 'local)
(add-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder nil 'local)
#'allout-widgets-additions-recorder nil 'local)
(add-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder nil 'local)
#'allout-widgets-deletions-recorder nil 'local)
(add-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder nil 'local)
#'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function nil 'local)
#'allout-widgets-after-copy-or-kill-function nil 'local)
(add-hook 'allout-post-undo-hook
'allout-widgets-after-undo-function nil 'local)
#'allout-widgets-after-undo-function nil 'local)
(add-hook 'before-change-functions 'allout-widgets-before-change-handler
(add-hook 'before-change-functions
#'allout-widgets-before-change-handler nil 'local)
(add-hook 'post-command-hook #'allout-widgets-post-command-business
nil 'local)
(add-hook 'post-command-hook 'allout-widgets-post-command-business
nil 'local)
(add-hook 'pre-command-hook 'allout-widgets-pre-command-business
(add-hook 'pre-command-hook #'allout-widgets-pre-command-business
nil 'local)
;; init the widgets tally for debugging:
@ -596,23 +596,23 @@ outline hot-spot navigation (see `allout-mode')."
(remove-from-invisibility-spec 'allout-escapes)
(remove-hook 'after-change-functions
'allout-widgets-after-change-handler 'local)
#'allout-widgets-after-change-handler 'local)
(remove-hook 'allout-exposure-change-functions
'allout-widgets-exposure-change-recorder 'local)
#'allout-widgets-exposure-change-recorder 'local)
(remove-hook 'allout-structure-added-functions
'allout-widgets-additions-recorder 'local)
#'allout-widgets-additions-recorder 'local)
(remove-hook 'allout-structure-deleted-functions
'allout-widgets-deletions-recorder 'local)
#'allout-widgets-deletions-recorder 'local)
(remove-hook 'allout-structure-shifted-functions
'allout-widgets-shifts-recorder 'local)
#'allout-widgets-shifts-recorder 'local)
(remove-hook 'allout-after-copy-or-kill-hook
'allout-widgets-after-copy-or-kill-function 'local)
#'allout-widgets-after-copy-or-kill-function 'local)
(remove-hook 'before-change-functions
'allout-widgets-before-change-handler 'local)
#'allout-widgets-before-change-handler 'local)
(remove-hook 'post-command-hook
'allout-widgets-post-command-business 'local)
#'allout-widgets-post-command-business 'local)
(remove-hook 'pre-command-hook
'allout-widgets-pre-command-business 'local)
#'allout-widgets-pre-command-business 'local)
(assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist)
(set-buffer-modified-p was-modified))))
;;;_ > allout-widgets-mode-off
@ -710,7 +710,7 @@ Optional RECURSING is for internal use, to limit recursion."
(when allout-widgets-reenable-before-change-handler
(add-hook 'before-change-functions
'allout-widgets-before-change-handler
#'allout-widgets-before-change-handler
nil 'local)
(setq allout-widgets-reenable-before-change-handler nil))
@ -879,7 +879,7 @@ encompassing condition-case."
(message header) (sit-for allout-widgets-hook-error-post-time)
;; reraise the error, or one concerning this function if unexpected:
(if (equal mode 'error)
(apply 'signal args)
(apply #'signal args)
(error "%s: unexpected mode, %s %s" this mode args))))
;;;_ > allout-widgets-changes-exceed-threshold-p ()
(defun allout-widgets-adjusting-message (message)
@ -973,9 +973,8 @@ Generally invoked via `allout-exposure-change-functions'."
deactivate-mark)
(dolist (change changes)
(let (handling
(from (cadr change))
bucket got
(let ((from (cadr change))
bucket
(to (caddr change))
(flag (cadddr change))
parent)
@ -986,10 +985,11 @@ Generally invoked via `allout-exposure-change-functions'."
from bucket))
;; have we already handled exposure changes in this region?
(setq handling (if flag 'handled-conceal 'handled-expose)
got (allout-range-overlaps from to (symbol-value handling))
covered (car got))
(set handling (cadr got))
(cl-callf (lambda (x)
(let ((got (allout-range-overlaps from to x)))
(setq covered (car got))
(cadr got)))
(if flag handled-conceal handled-expose))
(when (not covered)
(save-excursion
@ -1825,7 +1825,7 @@ reapplying this method will rectify the glyphs."
(if (> increment 1) (setq increment 1))
(when extenders
;; paint extenders after a connector, else leave spaces.
(dotimes (i extenders)
(dotimes (_ extenders)
(put-text-property
position (setq position (1+ position))
'display (allout-fetch-icon-image

131
lisp/allout.el
View file

@ -1,6 +1,6 @@
;;; allout.el --- extensive outline mode for use alone and with other modes
;;; allout.el --- extensive outline mode for use alone and with other modes -*- lexical-binding: t; -*-
;; Copyright (C) 1992-1994, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Created: Dec 1991 -- first release to usenet
@ -133,13 +133,14 @@ respective allout-mode keybinding variables, `allout-command-prefix',
(when (boundp 'allout-unprefixed-keybindings)
(dolist (entry allout-unprefixed-keybindings)
(define-key map (car (read-from-string (car entry))) (cadr entry))))
(substitute-key-definition 'beginning-of-line 'allout-beginning-of-line
(substitute-key-definition #'beginning-of-line #'allout-beginning-of-line
map global-map)
(substitute-key-definition 'move-beginning-of-line 'allout-beginning-of-line
(substitute-key-definition #'move-beginning-of-line
#'allout-beginning-of-line
map global-map)
(substitute-key-definition 'end-of-line 'allout-end-of-line
(substitute-key-definition #'end-of-line #'allout-end-of-line
map global-map)
(substitute-key-definition 'move-end-of-line 'allout-end-of-line
(substitute-key-definition #'move-end-of-line #'allout-end-of-line
map global-map)
(allout-institute-keymap map)))
;;;_ > allout-institute-keymap (map)
@ -169,7 +170,7 @@ Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
willing to let allout use a bunch of \C-c keybindings."
:type 'string
:group 'allout-keybindings
:set 'allout-compose-and-institute-keymap)
:set #'allout-compose-and-institute-keymap)
;;;_ = allout-keybindings-binding
(define-widget 'allout-keybindings-binding 'lazy
"Structure of allout keybindings customization items."
@ -230,7 +231,7 @@ prevails."
:version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
:set 'allout-compose-and-institute-keymap
:set #'allout-compose-and-institute-keymap
)
;;;_ = allout-unprefixed-keybindings
(defcustom allout-unprefixed-keybindings
@ -254,7 +255,7 @@ See the existing keys for examples."
:version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
:set 'allout-compose-and-institute-keymap
:set #'allout-compose-and-institute-keymap
)
;;;_ > allout-auto-activation-helper (var value)
@ -276,8 +277,8 @@ Establishes allout processing as part of visiting a file if
The proper way to use this is through customizing the setting of
`allout-auto-activation'."
(if (not allout-auto-activation)
(remove-hook 'find-file-hook 'allout-find-file-hook)
(add-hook 'find-file-hook 'allout-find-file-hook)))
(remove-hook 'find-file-hook #'allout-find-file-hook)
(add-hook 'find-file-hook #'allout-find-file-hook)))
;;;_ = allout-auto-activation
;;;###autoload
(defcustom allout-auto-activation nil
@ -298,7 +299,7 @@ With value \"activate\", only auto-mode-activation is enabled.
Auto-layout is not.
With value nil, inhibit any automatic allout-mode activation."
:set 'allout-auto-activation-helper
:set #'allout-auto-activation-helper
;; FIXME: Using strings here is unusual and less efficient than symbols.
:type '(choice (const :tag "On" t)
(const :tag "Ask about layout" "ask")
@ -405,7 +406,7 @@ where auto-fill occurs."
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
(put 'allout-use-hanging-indents 'safe-local-variable #'booleanp)
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@ -434,7 +435,7 @@ just the header."
:group 'allout)
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
(put 'allout-show-bodies 'safe-local-variable 'booleanp)
(put 'allout-show-bodies 'safe-local-variable #'booleanp)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@ -507,7 +508,7 @@ character, which is typically set to the `allout-primary-bullet'."
:group 'allout)
(make-variable-buffer-local 'allout-header-prefix)
;;;###autoload
(put 'allout-header-prefix 'safe-local-variable 'stringp)
(put 'allout-header-prefix 'safe-local-variable #'stringp)
;;;_ = allout-primary-bullet
(defcustom allout-primary-bullet "*"
"Bullet used for top-level outline topics.
@ -524,7 +525,7 @@ bullets."
:group 'allout)
(make-variable-buffer-local 'allout-primary-bullet)
;;;###autoload
(put 'allout-primary-bullet 'safe-local-variable 'stringp)
(put 'allout-primary-bullet 'safe-local-variable #'stringp)
;;;_ = allout-plain-bullets-string
(defcustom allout-plain-bullets-string ".,"
"The bullets normally used in outline topic prefixes.
@ -540,7 +541,7 @@ of this var to take effect."
:group 'allout)
(make-variable-buffer-local 'allout-plain-bullets-string)
;;;###autoload
(put 'allout-plain-bullets-string 'safe-local-variable 'stringp)
(put 'allout-plain-bullets-string 'safe-local-variable #'stringp)
;;;_ = allout-distinctive-bullets-string
(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
"Persistent outline header bullets used to distinguish special topics.
@ -588,7 +589,7 @@ strings."
:group 'allout)
(make-variable-buffer-local 'allout-distinctive-bullets-string)
;;;###autoload
(put 'allout-distinctive-bullets-string 'safe-local-variable 'stringp)
(put 'allout-distinctive-bullets-string 'safe-local-variable #'stringp)
;;;_ = allout-use-mode-specific-leader
(defcustom allout-use-mode-specific-leader t
@ -655,7 +656,7 @@ are always respected by the topic maneuvering functions."
:group 'allout)
(make-variable-buffer-local 'allout-old-style-prefixes)
;;;###autoload
(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
(put 'allout-old-style-prefixes 'safe-local-variable #'booleanp)
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"Do fancy stuff with topic prefix bullets according to level, etc.
@ -703,7 +704,7 @@ is non-nil."
:group 'allout)
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
(put 'allout-stylish-prefixes 'safe-local-variable #'booleanp)
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@ -717,7 +718,7 @@ disables numbering maintenance."
:group 'allout)
(make-variable-buffer-local 'allout-numbered-bullet)
;;;###autoload
(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
(put 'allout-numbered-bullet 'safe-local-variable #'string-or-null-p)
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
"Bullet signifying file cross-references, for `allout-resolve-xref'.
@ -726,7 +727,7 @@ Set this var to the bullet you want to use for file cross-references."
:type '(choice (const nil) string)
:group 'allout)
;;;###autoload
(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
(put 'allout-file-xref-bullet 'safe-local-variable #'string-or-null-p)
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
"Presentation-format white-space padding factor, for greater indent."
@ -735,7 +736,7 @@ Set this var to the bullet you want to use for file cross-references."
(make-variable-buffer-local 'allout-presentation-padding)
;;;###autoload
(put 'allout-presentation-padding 'safe-local-variable 'integerp)
(put 'allout-presentation-padding 'safe-local-variable #'integerp)
;;;_ = allout-flattened-numbering-abbreviation
(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering
@ -1056,7 +1057,7 @@ invoking it directly."
(setq allout-primary-bullet leader))
allout-header-prefix)))
(defalias 'allout-infer-header-lead
'allout-infer-header-lead-and-primary-bullet)
#'allout-infer-header-lead-and-primary-bullet)
;;;_ > allout-infer-body-reindent ()
(defun allout-infer-body-reindent ()
"Determine proper setting for `allout-reindent-bodies'.
@ -1196,7 +1197,7 @@ Also refresh various data structures that hinge on the regexp."
"[^" allout-primary-bullet "]"))
"\\)"
))))
(define-obsolete-function-alias 'set-allout-regexp 'allout-set-regexp "26.1")
(define-obsolete-function-alias 'set-allout-regexp #'allout-set-regexp "26.1")
;;;_ : Menu bar
(defvar allout-mode-exposure-menu)
(defvar allout-mode-editing-menu)
@ -1589,17 +1590,6 @@ non-nil in a lasting way.")
(defvar-local allout-explicitly-deactivated nil
"If t, `allout-mode's last deactivation was deliberate.
So `allout-post-command-business' should not reactivate it...")
;;;_ > allout-setup-menubar ()
(defun allout-setup-menubar ()
"Populate the current buffer's menubar with `allout-mode' stuff."
(let ((menus (list allout-mode-exposure-menu
allout-mode-editing-menu
allout-mode-navigation-menu
allout-mode-misc-menu))
cur)
(while menus
(setq cur (car menus)
menus (cdr menus)))))
;;;_ > allout-overlay-preparations
(defun allout-overlay-preparations ()
"Set the properties of the allout invisible-text overlay and others."
@ -1613,7 +1603,7 @@ So `allout-post-command-business' should not reactivate it...")
;; property controls the isearch _arrival_ behavior. This is the case at
;; least in emacs 21, 22.1, and xemacs 21.4.
(put 'allout-exposure-category 'isearch-open-invisible
'allout-isearch-end-handler)
#'allout-isearch-end-handler)
(put 'allout-exposure-category 'insert-in-front-hooks
'(allout-overlay-insert-in-front-handler))
(put 'allout-exposure-category 'modification-hooks
@ -1903,12 +1893,12 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(allout-do-resumptions)
(remove-from-invisibility-spec '(allout . t))
(remove-hook 'pre-command-hook 'allout-pre-command-business t)
(remove-hook 'post-command-hook 'allout-post-command-business t)
(remove-hook 'before-change-functions 'allout-before-change-handler t)
(remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
(remove-hook 'pre-command-hook #'allout-pre-command-business t)
(remove-hook 'post-command-hook #'allout-post-command-business t)
(remove-hook 'before-change-functions #'allout-before-change-handler t)
(remove-hook 'isearch-mode-end-hook #'allout-isearch-end-handler t)
(remove-hook 'write-contents-functions
'allout-write-contents-hook-handler t)
#'allout-write-contents-hook-handler t)
(remove-overlays (point-min) (point-max)
'category 'allout-exposure-category))
@ -1937,11 +1927,11 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(add-to-invisibility-spec '(allout . t))
(allout-add-resumptions '(line-move-ignore-invisible t))
(add-hook 'pre-command-hook 'allout-pre-command-business nil t)
(add-hook 'post-command-hook 'allout-post-command-business nil t)
(add-hook 'before-change-functions 'allout-before-change-handler nil t)
(add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
(add-hook 'write-contents-functions 'allout-write-contents-hook-handler
(add-hook 'pre-command-hook #'allout-pre-command-business nil t)
(add-hook 'post-command-hook #'allout-post-command-business nil t)
(add-hook 'before-change-functions #'allout-before-change-handler nil t)
(add-hook 'isearch-mode-end-hook #'allout-isearch-end-handler nil t)
(add-hook 'write-contents-functions #'allout-write-contents-hook-handler
nil t)
;; Stash auto-fill settings and adjust so custom allout auto-fill
@ -1966,8 +1956,6 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
;; allout-auto-fill will use the stashed values and so forth.
(allout-add-resumptions '(auto-fill-function allout-auto-fill)))
(allout-setup-menubar)
;; Do auto layout if warranted:
(when (and allout-layout
allout-auto-activation
@ -1987,7 +1975,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(allout-this-or-next-heading)
(condition-case err
(progn
(apply 'allout-expose-topic (list use-layout))
(apply #'allout-expose-topic (list use-layout))
(message "Adjusting `%s' exposure... done."
(buffer-name)))
;; Problem applying exposure -- notify user, but don't
@ -1999,7 +1987,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
) ; let (())
) ; define-minor-mode
;;;_ > allout-minor-mode alias
(defalias 'allout-minor-mode 'allout-mode)
(defalias 'allout-minor-mode #'allout-mode)
;;;_ > allout-unload-function
(defun allout-unload-function ()
"Unload the allout outline library."
@ -2068,7 +2056,7 @@ internal functions use this feature cohesively bunch changes."
(error "Concealed-text change abandoned, text reconcealed"))))
(goto-char start))))
;;;_ > allout-before-change-handler (beg end)
(defun allout-before-change-handler (beg end)
(defun allout-before-change-handler (_beg _end)
"Protect against changes to invisible text.
See `allout-overlay-interior-modification-handler' for details."
@ -2232,7 +2220,7 @@ Actually, returns prefix beginning point."
(or (not (allout-do-doublecheck))
(not (allout-aberrant-container-p)))))))
;;;_ > allout-on-heading-p ()
(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
(defalias 'allout-on-heading-p #'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
@ -2768,7 +2756,7 @@ of (before any) topics, in which case we return nil."
(goto-char (point-min))
nil))))
;;;_ > allout-back-to-heading ()
(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
(defalias 'allout-back-to-heading #'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
(defun allout-pre-next-prefix ()
"Skip forward to just before the next heading line.
@ -2850,7 +2838,7 @@ collapsed."
(allout-beginning-of-current-entry)
(search-forward "\n" nil t)
(forward-char -1))
(defalias 'allout-end-of-heading 'allout-end-of-current-heading)
(defalias 'allout-end-of-heading #'allout-end-of-current-heading)
;;;_ > allout-get-body-text ()
(defun allout-get-body-text ()
"Return the unmangled body text of the topic immediately containing point."
@ -3289,10 +3277,6 @@ Returns the qualifying command, if any, else nil."
(interactive)
(let* ((modified (event-modifiers last-command-event))
(key-num (cond ((numberp last-command-event) last-command-event)
;; for XEmacs character type:
((and (fboundp 'characterp)
(apply 'characterp (list last-command-event)))
(apply 'char-to-int (list last-command-event)))
(t 0)))
mapped-binding)
@ -5137,7 +5121,7 @@ Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
(if (and spec
(allout-descend-to-depth new-depth)
(not (allout-hidden-p)))
(progn (setq got (apply 'allout-old-expose-topic spec))
(progn (setq got (apply #'allout-old-expose-topic spec))
(if (and got (or (not max-pos) (> got max-pos)))
(setq max-pos got)))))))
(while (and followers
@ -5215,7 +5199,7 @@ Optional arg CONTEXT indicates interior levels to include."
(setq flat-index (cdr flat-index)))
;; Dispose of single extra delim:
(setq result (cdr result))))
(apply 'concat result)))
(apply #'concat result)))
;;;_ > allout-stringify-flat-index-plain (flat-index)
(defun allout-stringify-flat-index-plain (flat-index)
"Convert list representing section/subsection/... to document string."
@ -5226,7 +5210,7 @@ Optional arg CONTEXT indicates interior levels to include."
(if result
(cons delim result))))
(setq flat-index (cdr flat-index)))
(apply 'concat result)))
(apply #'concat result)))
;;;_ > allout-stringify-flat-index-indented (flat-index)
(defun allout-stringify-flat-index-indented (flat-index)
"Convert list representing section/subsection/... to document string."
@ -5255,7 +5239,7 @@ Optional arg CONTEXT indicates interior levels to include."
(setq flat-index (cdr flat-index)))
;; Dispose of single extra delim:
(setq result (cdr result))))
(apply 'concat result)))
(apply #'concat result)))
;;;_ > allout-listify-exposed (&optional start end format)
(defun allout-listify-exposed (&optional start end format)
@ -5381,7 +5365,7 @@ header and body. The elements of that list are:
;; Put the list with first at front, to last at back:
(nreverse result))))
(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1")
(define-obsolete-function-alias 'allout-region-active-p #'region-active-p "28.1")
;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
@ -5498,7 +5482,7 @@ alternate presentation format for the outline:
(beg (if arg (allout-back-to-current-heading) (point-min)))
(end (if arg (allout-end-of-current-subtree) (point-max)))
(buf (current-buffer))
(start-list ()))
) ;; (start-list ())
(if (eq format 'flat)
(setq format (if arg (save-excursion
(goto-char beg)
@ -5510,7 +5494,7 @@ alternate presentation format for the outline:
end
(current-buffer)
tobuf
format start-list)
format nil) ;; start-list
(goto-char (point-min))
(pop-to-buffer buf)
(goto-char start-pt)))
@ -5622,11 +5606,12 @@ environment. Leaves point at the end of the line."
(begindoc "\\begin{document}\n\\begin{center}\n")
(title (format "%s%s%s%s"
"\\titlecmd{"
(allout-latex-verb-quote (if allout-title
(condition-case nil
(eval allout-title)
(error "<unnamed buffer>"))
"Unnamed Outline"))
(allout-latex-verb-quote
(if allout-title
(condition-case nil
(eval allout-title t)
(error "<unnamed buffer>"))
"Unnamed Outline"))
"}\n"
"\\end{center}\n\n"))
(hsize "\\hsize = 7.5 true in\n")
@ -6219,7 +6204,7 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
;;;_ > outlineify-sticky ()
;; outlinify-sticky is correct spelling; provide this alias for sticklers:
;;;###autoload
(defalias 'outlinify-sticky 'outlineify-sticky)
(defalias 'outlinify-sticky #'outlineify-sticky)
;;;###autoload
(defun outlineify-sticky (&optional _arg)
"Activate outline mode and establish file var so it is started subsequently.
@ -6441,7 +6426,7 @@ If BEG is bigger than END we return 0."
;;;_ > allout-format-quote (string)
(defun allout-format-quote (string)
"Return a copy of string with all \"%\" characters doubled."
(apply 'concat
(apply #'concat
(mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
string)))
(define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1")

2
lisp/bs.el
View file

@ -120,8 +120,6 @@
;; can cycle through all file buffers and *scratch* although your current
;; configuration perhaps is "files" which ignores buffer *scratch*.
;;; History:
;;; Code:
;; ----------------------------------------------------------------------

2
lisp/calendar/timeclock.el
View file

@ -69,8 +69,6 @@
;; your average working time, and will make sure that the various
;; display functions return the correct value.
;;; History:
;;; Code:
(require 'cl-lib)

40
lisp/cedet/mode-local.el
View file

@ -91,13 +91,13 @@ MODES can be a symbol or a list of symbols.
FUNCTION does not have arguments."
(or (listp modes) (setq modes (list modes)))
(mode-local-map-file-buffers
function #'(lambda ()
(let ((mm (mode-local-equivalent-mode-p major-mode))
(ans nil))
(while (and (not ans) mm)
(setq ans (memq (car mm) modes)
mm (cdr mm)) )
ans))))
function (lambda ()
(let ((mm (mode-local-equivalent-mode-p major-mode))
(ans nil))
(while (and (not ans) mm)
(setq ans (memq (car mm) modes)
mm (cdr mm)) )
ans))))
;;; Hook machinery
;;
@ -323,14 +323,14 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one variable."
(dolist (mode modes)
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
#'(lambda (var)
(when (get var 'mode-variable-flag)
(let ((v (intern (symbol-name var))))
;; Save the current buffer-local value of the
;; mode-local variable.
(and (local-variable-p v (current-buffer))
(push (cons v (symbol-value v)) old-locals))
(set (make-local-variable v) (symbol-value var)))))
(lambda (var)
(when (get var 'mode-variable-flag)
(let ((v (intern (symbol-name var))))
;; Save the current buffer-local value of the
;; mode-local variable.
(and (local-variable-p v (current-buffer))
(push (cons v (symbol-value v)) old-locals))
(set (make-local-variable v) (symbol-value var)))))
table)))
old-locals)))
@ -348,9 +348,9 @@ If MODE is not specified it defaults to current `major-mode'."
(while mode
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
#'(lambda (var)
(when (get var 'mode-variable-flag)
(kill-local-variable (intern (symbol-name var)))))
(lambda (var)
(when (get var 'mode-variable-flag)
(kill-local-variable (intern (symbol-name var)))))
table))
(setq mode (get-mode-local-parent mode)))))
@ -428,7 +428,7 @@ Return the value of the last VAL."
;; Save mode bindings
(mode-local-bind (list ,@bl) '(mode-variable-flag t) ',mode)
;; Assign to local variables in all existing buffers in MODE
(mode-local-map-mode-buffers #'(lambda () ,@sl) ',mode)
(mode-local-map-mode-buffers (lambda () ,@sl) ',mode)
;; Return the last value
,tmp)
)))
@ -893,7 +893,7 @@ invoked interactively."
(interactive
(list (completing-read
"Mode: " obarray
#'(lambda (s) (get s 'mode-local-symbol-table))
(lambda (s) (get s 'mode-local-symbol-table))
t (symbol-name major-mode))))
(when (setq mode (intern-soft mode))
(mode-local-describe-bindings-1 mode (called-interactively-p 'any))))

3
lisp/cedet/pulse.el
View file

@ -153,7 +153,8 @@ Optional argument FACE specifies the face to do the highlighting."
;; with a reference face needed for the color.
(pulse-reset-face face)
(let* ((start (color-name-to-rgb
(face-background 'pulse-highlight-start-face)))
(face-background 'pulse-highlight-start-face
nil 'default)))
(stop (color-name-to-rgb (face-background 'default)))
(colors (mapcar (apply-partially 'apply 'color-rgb-to-hex)
(color-gradient start stop pulse-iterations))))

18
lisp/cedet/semantic.el
View file

@ -678,15 +678,15 @@ This function returns semantic tags without overlays."
(if tag
(if (car tag)
(setq tag (mapcar
#'(lambda (tag)
;; Set the 'reparse-symbol property to
;; NONTERM unless it was already setup
;; by a tag expander
(or (semantic--tag-get-property
tag 'reparse-symbol)
(semantic--tag-put-property
tag 'reparse-symbol nonterm))
tag)
(lambda (tag)
;; Set the 'reparse-symbol property to
;; NONTERM unless it was already setup
;; by a tag expander
(or (semantic--tag-get-property
tag 'reparse-symbol)
(semantic--tag-put-property
tag 'reparse-symbol nonterm))
tag)
(semantic--tag-expand tag))
result (append result tag))
;; No error in this case, a purposeful nil means don't

4
lisp/cedet/semantic/bovine/c.el
View file

@ -2244,8 +2244,8 @@ actually in their parent which is not accessible.")
(if (obarrayp semantic-lex-spp-project-macro-symbol-obarray)
(let ((macros nil))
(mapatoms
#'(lambda (symbol)
(setq macros (cons symbol macros)))
(lambda (symbol)
(setq macros (cons symbol macros)))
semantic-lex-spp-project-macro-symbol-obarray)
(dolist (S macros)
(princ " ")

3
lisp/cedet/semantic/bovine/grammar.el
View file

@ -25,9 +25,8 @@
;;
;; Major mode for editing Bovine's input grammar (.by) files.
;;; History:
;;; Code:
(require 'semantic)
(require 'semantic/grammar)
(require 'semantic/find)

2
lisp/cedet/semantic/db-ebrowse.el
View file

@ -274,7 +274,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
(insert-file-contents B)
(let ((ans nil)
(efcn (symbol-function 'ebrowse-show-progress)))
(fset 'ebrowse-show-progress #'(lambda (&rest _junk) nil))
(fset 'ebrowse-show-progress (lambda (&rest _junk) nil))
(unwind-protect ;; Protect against errors w/ ebrowse
(setq ans (list B (ebrowse-read)))
;; These items must always happen

2
lisp/cedet/semantic/db-global.el
View file

@ -56,7 +56,7 @@ values."
(interactive
(list (completing-read
"Enable in Mode: " obarray
#'(lambda (s) (get s 'mode-local-symbol-table))
(lambda (s) (get s 'mode-local-symbol-table))
t (symbol-name major-mode))))
;; First, make sure the version is ok.

4
lisp/cedet/semantic/edit.el
View file

@ -154,8 +154,8 @@ Optional argument BUFFER is the buffer to search for changes in."
(when (overlay-get (car ol) 'semantic-change)
(setq ret (cons (car ol) ret)))
(setq ol (cdr ol)))
(sort ret #'(lambda (a b) (< (overlay-start a)
(overlay-start b)))))))
(sort ret (lambda (a b) (< (overlay-start a)
(overlay-start b)))))))
(defun semantic-edits-change-function-handle-changes (start end _length)
"Run whenever a buffer controlled by `semantic-mode' change.

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

@ -270,11 +270,11 @@ later installation should be done in MODE hook."
(mode-local-bind
;; Add the semantic- prefix to OVERLOAD short names.
(mapcar
#'(lambda (e)
(let ((name (symbol-name (car e))))
(if (string-match "^semantic-" name)
e
(cons (intern (format "semantic-%s" name)) (cdr e)))))
(lambda (e)
(let ((name (symbol-name (car e))))
(if (string-match "^semantic-" name)
e
(cons (intern (format "semantic-%s" name)) (cdr e)))))
overrides)
(list 'constant-flag (not transient)
'override-flag t)))

46
lisp/cedet/semantic/grammar.el
View file

@ -23,9 +23,6 @@
;;
;; Major mode framework for editing Semantic's input grammar files.
;;; History:
;;
;;; Code:
(require 'semantic)
@ -143,12 +140,12 @@ It ignores whitespaces, newlines and comments."
ARGS are ASSOC's key value list."
(let ((key t))
`(semantic-tag-make-plist
,@(mapcar #'(lambda (i)
(prog1
(if key
(list 'quote i)
i)
(setq key (not key))))
,@(mapcar (lambda (i)
(prog1
(if key
(list 'quote i)
i)
(setq key (not key))))
args))))
(defsubst semantic-grammar-quote-p (sym)
@ -193,11 +190,11 @@ That is tag names plus names defined in tag attribute `:rest'."
class (current-buffer))))
(apply #'append
(mapcar
#'(lambda (tag)
(mapcar
#'intern
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
(lambda (tag)
(mapcar
#'intern
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
tags))))
(defsubst semantic-grammar-item-text (item)
@ -298,9 +295,9 @@ foo.by it is foo-by."
That is an alist of (VALUE . TOKEN) where VALUE is the string value of
the keyword and TOKEN is the terminal symbol identifying the keyword."
(mapcar
#'(lambda (key)
(cons (semantic-tag-get-attribute key :value)
(intern (semantic-tag-name key))))
(lambda (key)
(cons (semantic-tag-get-attribute key :value)
(intern (semantic-tag-name key))))
(semantic-find-tags-by-class 'keyword (current-buffer))))
(defun semantic-grammar-keyword-properties (keywords)
@ -600,9 +597,6 @@ Typically a DEFINE expression should look like this:
;; PLEASE DO NOT MANUALLY EDIT THIS FILE! It is automatically
;; generated from the grammar file " gram ".
;;; History:
;;
;;; Code:
(require 'semantic/lex)
@ -1069,7 +1063,7 @@ See also the variable `semantic-grammar-file-regexp'."
(setq semantic--grammar-macros-regexp-1
(concat "(\\s-*"
(regexp-opt
(mapcar #'(lambda (e) (symbol-name (car e)))
(mapcar (lambda (e) (symbol-name (car e)))
semantic-grammar-macros)
t)
"\\>"))
@ -1862,11 +1856,11 @@ Optional argument COLOR determines if color is added to the text."
(setq label "Keyword: ")
(let (summary)
(semantic--find-tags-by-function
#'(lambda (put)
(unless summary
(setq summary (cdr (assoc "summary"
(semantic-tag-get-attribute
put :value))))))
(lambda (put)
(unless summary
(setq summary (cdr (assoc "summary"
(semantic-tag-get-attribute
put :value))))))
;; Get `put' tag with TAG name.
(semantic-find-tags-by-name-regexp
(regexp-quote (semantic-tag-name tag))

12
lisp/cedet/semantic/idle.el
View file

@ -216,9 +216,9 @@ And also manages services that depend on tag values."
(let* ((inhibit-quit nil)
(buffers (delq (current-buffer)
(delq nil
(mapcar #'(lambda (b)
(and (buffer-file-name b)
b))
(mapcar (lambda (b)
(and (buffer-file-name b)
b))
(buffer-list)))))
;; safe ;; This safe is not used, but could be.
others
@ -356,9 +356,9 @@ Uses `semantic-idle-work-for-on-buffer' to do the work."
(cb (current-buffer))
(buffers (delq (current-buffer)
(delq nil
(mapcar #'(lambda (b)
(and (buffer-file-name b)
b))
(mapcar (lambda (b)
(and (buffer-file-name b)
b))
(buffer-list)))))
safe) ;; errbuf
;; First, handle long tasks in the current buffer.

12
lisp/cedet/semantic/imenu.el
View file

@ -429,12 +429,12 @@ Optional argument PARENT is a tag parent of STREAM."
Clears all imenu menus that may be depending on the database."
(require 'semantic/db-mode)
(semantic-map-buffers
#'(lambda ()
;; Set up semanticdb environment if enabled.
(if (semanticdb-minor-mode-p)
(semanticdb-semantic-init-hook-fcn))
;; Clear imenu cache to redraw the imenu.
(semantic-imenu-flush-fcn))))
(lambda ()
;; Set up semanticdb environment if enabled.
(if (semanticdb-minor-mode-p)
(semanticdb-semantic-init-hook-fcn))
;; Clear imenu cache to redraw the imenu.
(semantic-imenu-flush-fcn))))
(add-hook 'semanticdb-mode-hook #'semantic-imenu-semanticdb-hook)

50
lisp/cedet/semantic/java.el
View file

@ -395,11 +395,11 @@ receives two arguments: the javadoc keyword and its associated
removed from the result list."
(delq nil
(mapcar
#'(lambda (k)
(let* ((tag (semantic-java-doc-tag k))
(plist (semantic-lex-keyword-get tag 'javadoc)))
(if (or (not property) (plist-get plist property))
(funcall fun k plist))))
(lambda (k)
(let* ((tag (semantic-java-doc-tag k))
(plist (semantic-lex-keyword-get tag 'javadoc)))
(if (or (not property) (plist-get plist property))
(funcall fun k plist))))
semantic-java-doc-line-tags)))
@ -417,59 +417,59 @@ removed from the result list."
(or semantic-java-doc-with-name-tags
(setq semantic-java-doc-with-name-tags
(semantic-java-doc-keywords-map
#'(lambda (k _p) k)
(lambda (k _p) k)
'with-name)))
(or semantic-java-doc-with-ref-tags
(setq semantic-java-doc-with-ref-tags
(semantic-java-doc-keywords-map
#'(lambda (k _p) k)
(lambda (k _p) k)
'with-ref)))
(or semantic-java-doc-extra-type-tags
(setq semantic-java-doc-extra-type-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k))
(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-extra-function-tags
(setq semantic-java-doc-extra-function-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k))
(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-extra-variable-tags
(setq semantic-java-doc-extra-variable-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k))
(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-type-tags
(setq semantic-java-doc-type-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k)))))
(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k)))))
(or semantic-java-doc-function-tags
(setq semantic-java-doc-function-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k)))))
(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k)))))
(or semantic-java-doc-variable-tags
(setq semantic-java-doc-variable-tags
(semantic-java-doc-keywords-map
#'(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k)))))
(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k)))))
)

20
lisp/cedet/semantic/lex-spp.el
View file

@ -278,10 +278,10 @@ The return list is meant to be saved in a semanticdb table."
(let (macros)
(when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
(mapatoms
#'(lambda (symbol)
(setq macros (cons (cons (symbol-name symbol)
(symbol-value symbol))
macros)))
(lambda (symbol)
(setq macros (cons (cons (symbol-name symbol)
(symbol-value symbol))
macros)))
semantic-lex-spp-dynamic-macro-symbol-obarray))
macros))
@ -291,18 +291,18 @@ The value of each symbol is the replacement stream."
(let (macros)
(when (obarrayp semantic-lex-spp-macro-symbol-obarray)
(mapatoms
#'(lambda (symbol)
(setq macros (cons symbol macros)))
(lambda (symbol)
(setq macros (cons symbol macros)))
semantic-lex-spp-macro-symbol-obarray))
(when (obarrayp semantic-lex-spp-project-macro-symbol-obarray)
(mapatoms
#'(lambda (symbol)
(setq macros (cons symbol macros)))
(lambda (symbol)
(setq macros (cons symbol macros)))
semantic-lex-spp-project-macro-symbol-obarray))
(when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
(mapatoms
#'(lambda (symbol)
(setq macros (cons symbol macros)))
(lambda (symbol)
(setq macros (cons symbol macros)))
semantic-lex-spp-dynamic-macro-symbol-obarray))
macros))

10
lisp/cedet/semantic/lex.el
View file

@ -192,9 +192,9 @@ If optional PROPERTY is non-nil, call FUN only on every symbol which
as a PROPERTY value. FUN receives a symbol as argument."
(if (obarrayp table)
(mapatoms
#'(lambda (symbol)
(if (or (null property) (get symbol property))
(funcall fun symbol)))
(lambda (symbol)
(if (or (null property) (get symbol property))
(funcall fun symbol)))
table)))
;;; Lexical keyword table handling.
@ -286,7 +286,7 @@ If optional PROPERTY is non-nil, return only keywords which have a
PROPERTY set."
(let (keywords)
(semantic-lex-map-keywords
#'(lambda (symbol) (setq keywords (cons symbol keywords)))
(lambda (symbol) (setq keywords (cons symbol keywords)))
property)
keywords))
@ -462,7 +462,7 @@ If optional PROPERTY is non-nil, return only type symbols which have
PROPERTY set."
(let (types)
(semantic-lex-map-types
#'(lambda (symbol) (setq types (cons symbol types)))
(lambda (symbol) (setq types (cons symbol types)))
property)
types))

2
lisp/cedet/semantic/util-modes.el
View file

@ -162,7 +162,7 @@ too an interactive function used to toggle the mode."
;; Update the minor mode format.
(semantic-mode-line-update)
;; Then turn MODE on or off in every Semantic enabled buffer.
(semantic-map-buffers #'(lambda () (funcall mode arg))))
(semantic-map-buffers (lambda () (funcall mode arg))))
;;;;
;;;; Minor mode to highlight areas that a user edits.

5
lisp/cedet/semantic/wisent.el
View file

@ -22,13 +22,10 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Here are functions necessary to use the Wisent LALR parser from
;; Semantic environment.
;;; History:
;;
;;; Code:
(require 'semantic)

39
lisp/cedet/semantic/wisent/comp.el
View file

@ -35,9 +35,6 @@
;;
;; For more details on Wisent itself read the Wisent manual.
;;; History:
;;
;;; Code:
(require 'semantic/wisent)
(eval-when-compile (require 'cl-lib))
@ -69,7 +66,7 @@
"Define a context NAME that will bind variables VARS."
(declare (indent 1))
(let* ((context (wisent-context-name name))
(declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
(declarations (mapcar (lambda (v) (list 'defvar v)) vars)))
`(progn
,@declarations
(eval-when-compile
@ -3488,11 +3485,11 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
;; in local variable OBN.
,@(let (obcode)
(mapatoms
#'(lambda (s)
(setq obcode
(cons `(fset (intern ,(symbol-name s) ,obn)
#',(symbol-function s))
obcode)))
(lambda (s)
(setq obcode
(cons `(fset (intern ,(symbol-name s) ,obn)
#',(symbol-function s))
obcode)))
obv)
obcode)
;; Generate code to create the automaton.
@ -3504,18 +3501,18 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
,@(mapcar
;; Use name `st' rather than `state' since `state' is
;; defined as dynbound in `semantic-actions' context above :-( !
#'(lambda (st) ;; for each state
`(list
,@(mapcar
#'(lambda (tr) ;; for each transition
(let ((k (car tr)) ; token
(a (cdr tr))) ; action
(if (and (symbolp a)
(intern-soft (symbol-name a) obv))
`(cons ,(if (symbolp k) `(quote ,k) k)
(intern-soft ,(symbol-name a) ,obn))
`(quote ,tr))))
st)))
(lambda (st) ;; for each state
`(list
,@(mapcar
(lambda (tr) ;; for each transition
(let ((k (car tr)) ; token
(a (cdr tr))) ; action
(if (and (symbolp a)
(intern-soft (symbol-name a) obv))
`(cons ,(if (symbolp k) `(quote ,k) k)
(intern-soft ,(symbol-name a) ,obn))
`(quote ,tr))))
st)))
(aref automaton 0)))
;; The code of the goto table is unchanged.
,(aref automaton 1)

22
lisp/cedet/semantic/wisent/grammar.el
View file

@ -198,10 +198,10 @@ See also the function `wisent-skip-token'."
(defun wisent-grammar-assocs ()
"Return associativity and precedence level definitions."
(mapcar
#'(lambda (tag)
(cons (intern (semantic-tag-name tag))
(mapcar #'semantic-grammar-item-value
(semantic-tag-get-attribute tag :value))))
(lambda (tag)
(cons (intern (semantic-tag-name tag))
(mapcar #'semantic-grammar-item-value
(semantic-tag-get-attribute tag :value))))
(semantic-find-tags-by-class 'assoc (current-buffer))))
(defun wisent-grammar-terminals ()
@ -209,14 +209,14 @@ See also the function `wisent-skip-token'."
Keep order of declaration in the WY file without duplicates."
(let (terms)
(mapc
#'(lambda (tag)
(mapcar #'(lambda (name)
(add-to-list 'terms (intern name)))
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
(lambda (tag)
(mapcar (lambda (name)
(add-to-list 'terms (intern name)))
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
(semantic--find-tags-by-function
#'(lambda (tag)
(memq (semantic-tag-class tag) '(token keyword)))
(lambda (tag)
(memq (semantic-tag-class tag) '(token keyword)))
(current-buffer)))
(nreverse terms)))

3
lisp/cedet/semantic/wisent/java-tags.el
View file

@ -24,9 +24,6 @@
;;; Commentary:
;;
;;; History:
;;
;;; Code:
(require 'semantic/wisent)

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

@ -34,9 +34,6 @@
;;
;; For more details on Wisent itself read the Wisent manual.
;;; History:
;;
;;; Code:
(defgroup wisent nil

21
lisp/chistory.el
View file

@ -1,4 +1,4 @@
;;; chistory.el --- list command history
;;; chistory.el --- list command history -*- lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@ -71,8 +71,7 @@ If that function is given a list whose car is an element of this list,
then it will return non-nil (indicating the list should be discarded from
the history).
Initially, all commands related to the command history are discarded."
:type '(repeat symbol)
:group 'chistory)
:type '(repeat symbol))
(defvar list-command-history-filter 'default-command-history-filter
"Predicate to test which commands should be excluded from the history listing.
@ -90,8 +89,7 @@ from the command history."
(defcustom list-command-history-max 32
"If non-nil, maximum length of the listing produced by `list-command-history'."
:type '(choice integer (const nil))
:group 'chistory)
:type '(choice integer (const nil)))
;;;###autoload
(defun list-command-history ()
@ -127,10 +125,10 @@ The buffer is left in Command History mode."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap lisp-mode-shared-map
special-mode-map))
(define-key map "x" 'command-history-repeat)
(define-key map "\n" 'next-line)
(define-key map "\r" 'next-line)
(define-key map "\177" 'previous-line)
(define-key map "x" #'command-history-repeat)
(define-key map "\n" #'next-line)
(define-key map "\r" #'next-line)
(define-key map "\177" #'previous-line)
map)
"Keymap for `command-history-mode'.")
@ -145,8 +143,7 @@ Keybindings:
(defcustom command-history-hook nil
"If non-nil, its value is called on entry to `command-history-mode'."
:type 'hook
:group 'chistory)
:type 'hook)
(defun command-history-revert (_ignore-auto _noconfirm)
(list-command-history))
@ -165,7 +162,7 @@ The buffer for that command is the previous current buffer."
;;;###autoload
(defun command-history ()
"Examine commands from `command-history' in a buffer.
"Examine commands from variable `command-history' in a buffer.
The number of commands listed is controlled by `list-command-history-max'.
The command history is filtered by `list-command-history-filter' if non-nil.
Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.

80
lisp/completion.el
View file

@ -1,7 +1,6 @@
;;; completion.el --- dynamic word-completion code
;;; completion.el --- dynamic word-completion code -*- lexical-binding: t; -*-
;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
;; Copyright (C) 1990-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
@ -286,62 +285,52 @@
(defcustom enable-completion t
"Non-nil means enable recording and saving of completions.
If nil, no new words are added to the database or saved to the init file."
:type 'boolean
:group 'completion)
:type 'boolean)
(defcustom save-completions-flag t
"Non-nil means save most-used completions when exiting Emacs.
See also `save-completions-retention-time'."
:type 'boolean
:group 'completion)
:type 'boolean)
(defcustom save-completions-file-name
(locate-user-emacs-file "completions" ".completions")
"The filename to save completions to."
:type 'file
:group 'completion)
:type 'file)
(defcustom save-completions-retention-time 336
"Discard a completion if unused for this many hours.
\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
will not be saved unless these are used. Default is two weeks."
:type 'integer
:group 'completion)
:type 'integer)
(defcustom completion-on-separator-character nil
"Non-nil means separator characters mark previous word as used.
This means the word will be saved as a completion."
:type 'boolean
:group 'completion)
:type 'boolean)
(defcustom completions-file-versions-kept kept-new-versions
"Number of versions to keep for the saved completions file."
:type 'integer
:group 'completion)
:type 'integer)
(defcustom completion-prompt-speed-threshold 4800
"Minimum output speed at which to display next potential completion."
:type 'integer
:group 'completion)
:type 'integer)
(defcustom completion-cdabbrev-prompt-flag nil
"If non-nil, the next completion prompt does a cdabbrev search.
This can be time consuming."
:type 'boolean
:group 'completion)
:type 'boolean)
(defcustom completion-search-distance 15000
"How far to search in the buffer when looking for completions.
In number of characters. If nil, search the whole buffer."
:type 'integer
:group 'completion)
:type 'integer)
(defcustom completions-merging-modes '(lisp c)
"List of modes {`c' or `lisp'} for automatic completions merging.
Definitions from visited files which have these modes
are automatically added to the completion database."
:type '(set (const lisp) (const c))
:group 'completion)
:type '(set (const lisp) (const c)))
;;(defvar *completion-auto-save-period* 1800
;; "The period in seconds to wait for emacs to be idle before autosaving
@ -950,9 +939,9 @@ Each symbol is bound to a single completion entry.")
;; READER Macros
(defalias 'cmpl-prefix-entry-head 'car)
(defalias 'cmpl-prefix-entry-head #'car)
(defalias 'cmpl-prefix-entry-tail 'cdr)
(defalias 'cmpl-prefix-entry-tail #'cdr)
;; WRITER Macros
@ -978,31 +967,27 @@ Each symbol is bound to a single completion entry.")
(setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
(setq cmpl-obarray (make-vector cmpl-obarray-length 0)))
(defvar completions-list-return-value)
(defun list-all-completions ()
"Return a list of all the known completion entries."
(let ((completions-list-return-value nil))
(mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
completions-list-return-value))
(let ((return-value nil))
(mapatoms (lambda (prefix-symbol)
(if (boundp prefix-symbol)
(setq return-value
(append (cmpl-prefix-entry-head
(symbol-value prefix-symbol))
return-value))))
cmpl-prefix-obarray)
return-value))
(defun list-all-completions-1 (prefix-symbol)
(if (boundp prefix-symbol)
(setq completions-list-return-value
(append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
completions-list-return-value))))
(defun list-all-completions-by-hash-bucket ()
(defun list-all-completions-by-hash-bucket () ;FIXME: Unused!
"Return list of lists of known completion entries, organized by hash bucket."
(let ((completions-list-return-value nil))
(mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
completions-list-return-value))
(defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
(if (boundp prefix-symbol)
(setq completions-list-return-value
(cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
completions-list-return-value))))
(let ((return-value nil))
(mapatoms (lambda (prefix-symbol)
(if (boundp prefix-symbol)
(push (cmpl-prefix-entry-head (symbol-value prefix-symbol))
return-value)))
cmpl-prefix-obarray)
return-value))
;;-----------------------------------------------
@ -2155,7 +2140,6 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(define-minor-mode dynamic-completion-mode
"Toggle dynamic word-completion on or off."
:global t
:group 'completion
;; This is always good, not specific to dynamic-completion-mode.
(define-key function-key-map [C-return] [?\C-\r])
@ -2239,7 +2223,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(completion-def-wrapper 'delete-backward-char-untabify :backward)
;; Old name, non-namespace-clean.
(defalias 'initialize-completions 'completion-initialize)
(defalias 'initialize-completions #'completion-initialize)
(provide 'completion)

10
lisp/dirtrack.el
View file

@ -1,4 +1,4 @@
;;; dirtrack.el --- Directory Tracking by watching the prompt
;;; dirtrack.el --- Directory Tracking by watching the prompt -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@ -77,7 +77,7 @@
;; Running under tcsh:
;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
;;
;; It might be worth mentioning in your file that emacs sources start up
;; It might be worth mentioning in your file that Emacs sources start up
;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the
;; shell. So for example, I have the following in ~/.emacs_tcsh:
;;
@ -123,7 +123,6 @@
"List for directory tracking.
First item is a regexp that describes where to find the path in a prompt.
Second is a number, the regexp group to match."
:group 'dirtrack
:type '(sexp (regexp :tag "Prompt Expression")
(integer :tag "Regexp Group"))
:version "24.1")
@ -132,12 +131,10 @@ Second is a number, the regexp group to match."
(defcustom dirtrack-debug nil
"If non-nil, the function `dirtrack' will report debugging info."
:group 'dirtrack
:type 'boolean)
(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
"Buffer in which to write directory tracking debug information."
:group 'dirtrack
:type 'string)
(defcustom dirtrack-directory-function
@ -145,19 +142,16 @@ Second is a number, the regexp group to match."
'dirtrack-windows-directory-function
'file-name-as-directory)
"Function to apply to the prompt directory for comparison purposes."
:group 'dirtrack
:type 'function)
(defcustom dirtrack-canonicalize-function
(if (memq system-type '(ms-dos windows-nt cygwin))
'downcase 'identity)
"Function to apply to the default directory for comparison purposes."
:group 'dirtrack
:type 'function)
(defcustom dirtrack-directory-change-hook nil
"Hook that is called when a directory change is made."
:group 'dirtrack
:type 'hook)

4
lisp/double.el
View file

@ -1,4 +1,4 @@
;;; double.el --- support for keyboard remapping with double clicking
;;; double.el --- support for keyboard remapping with double clicking -*- lexical-binding: t -*-
;; Copyright (C) 1994, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
@ -67,7 +67,6 @@ Each entry is a list with three elements:
1. The key activating the translation.
2. The string to be inserted when the key is pressed once.
3. The string to be inserted when the key is pressed twice."
:group 'double
:type '(repeat (list (character :tag "Key")
(string :tag "Once")
(string :tag "Twice"))))
@ -76,7 +75,6 @@ Each entry is a list with three elements:
"Non-nil means that Double mode mapping only works for prefix keys.
That is, for any key `X' in `double-map', `X' alone will be mapped
but not `C-u X' or `ESC X' since the X is not the prefix key."
:group 'double
:type 'boolean)
;;; Read Event

4
lisp/dynamic-setting.el
View file

@ -1,4 +1,4 @@
;;; dynamic-setting.el --- Support dynamic changes
;;; dynamic-setting.el --- Support dynamic changes -*- lexical-binding: t -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@ -91,4 +91,4 @@ Changes can be
((eq type 'tool-bar-style) (force-mode-line-update t)))))
(define-key special-event-map [config-changed-event]
'dynamic-setting-handle-config-changed-event)
#'dynamic-setting-handle-config-changed-event)

90
lisp/ebuff-menu.el
View file

@ -1,4 +1,4 @@
;;; ebuff-menu.el --- electric-buffer-list mode
;;; ebuff-menu.el --- electric-buffer-list mode -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@ -34,55 +34,53 @@
(defvar electric-buffer-menu-mode-map
(let ((map (make-keymap)))
(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined)
(fillarray (car (cdr map)) #'Electric-buffer-menu-undefined)
(define-key map "\e" nil)
(define-key map "\C-z" 'suspend-frame)
(define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
(define-key map (char-to-string help-char) 'Helper-help)
(define-key map "?" 'Helper-describe-bindings)
(define-key map "\C-z" #'suspend-frame)
(define-key map "v" #'Electric-buffer-menu-mode-view-buffer)
(define-key map (char-to-string help-char) #'Helper-help)
(define-key map "?" #'Helper-describe-bindings)
(define-key map "\C-c" nil)
(define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
(define-key map "\C-]" 'Electric-buffer-menu-quit)
(define-key map "q" 'Electric-buffer-menu-quit)
(define-key map " " 'Electric-buffer-menu-select)
(define-key map "\C-m" 'Electric-buffer-menu-select)
(define-key map "\C-l" 'recenter)
(define-key map "s" 'Buffer-menu-save)
(define-key map "d" 'Buffer-menu-delete)
(define-key map "k" 'Buffer-menu-delete)
(define-key map "\C-d" 'Buffer-menu-delete-backwards)
;; (define-key map "\C-k" 'Buffer-menu-delete)
(define-key map "\177" 'Buffer-menu-backup-unmark)
(define-key map "~" 'Buffer-menu-not-modified)
(define-key map "u" 'Buffer-menu-unmark)
(define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
(define-key map "U" 'Buffer-menu-unmark-all)
(let ((i ?0))
(while (<= i ?9)
(define-key map (char-to-string i) 'digit-argument)
(define-key map (concat "\e" (char-to-string i)) 'digit-argument)
(setq i (1+ i))))
(define-key map "-" 'negative-argument)
(define-key map "\e-" 'negative-argument)
(define-key map "m" 'Buffer-menu-mark)
(define-key map "\C-u" 'universal-argument)
(define-key map "\C-p" 'previous-line)
(define-key map "\C-n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "n" 'next-line)
(define-key map "\C-v" 'scroll-up-command)
(define-key map "\ev" 'scroll-down-command)
(define-key map ">" 'scroll-right)
(define-key map "<" 'scroll-left)
(define-key map "\e\C-v" 'scroll-other-window)
(define-key map "\e>" 'end-of-buffer)
(define-key map "\e<" 'beginning-of-buffer)
(define-key map "\C-c\C-c" #'Electric-buffer-menu-quit)
(define-key map "\C-]" #'Electric-buffer-menu-quit)
(define-key map "q" #'Electric-buffer-menu-quit)
(define-key map " " #'Electric-buffer-menu-select)
(define-key map "\C-m" #'Electric-buffer-menu-select)
(define-key map "\C-l" #'recenter)
(define-key map "s" #'Buffer-menu-save)
(define-key map "d" #'Buffer-menu-delete)
(define-key map "k" #'Buffer-menu-delete)
(define-key map "\C-d" #'Buffer-menu-delete-backwards)
;; (define-key map "\C-k" #'Buffer-menu-delete)
(define-key map "\177" #'Buffer-menu-backup-unmark)
(define-key map "~" #'Buffer-menu-not-modified)
(define-key map "u" #'Buffer-menu-unmark)
(define-key map "\M-\177" #'Buffer-menu-unmark-all-buffers)
(define-key map "U" #'Buffer-menu-unmark-all)
(dotimes (i 10)
(define-key map (char-to-string i) #'digit-argument)
(define-key map (concat "\e" (char-to-string i)) #'digit-argument))
(define-key map "-" #'negative-argument)
(define-key map "\e-" #'negative-argument)
(define-key map "m" #'Buffer-menu-mark)
(define-key map "\C-u" #'universal-argument)
(define-key map "\C-p" #'previous-line)
(define-key map "\C-n" #'next-line)
(define-key map "p" #'previous-line)
(define-key map "n" #'next-line)
(define-key map "\C-v" #'scroll-up-command)
(define-key map "\ev" #'scroll-down-command)
(define-key map ">" #'scroll-right)
(define-key map "<" #'scroll-left)
(define-key map "\e\C-v" #'scroll-other-window)
(define-key map "\e>" #'end-of-buffer)
(define-key map "\e<" #'beginning-of-buffer)
(define-key map "\e\e" nil)
(define-key map "\e\e\e" 'Electric-buffer-menu-quit)
(define-key map "\e\e\e" #'Electric-buffer-menu-quit)
;; This binding prevents the "escape => ESC" function-key-map mapping from
;; kicking in!
;; (define-key map [escape escape escape] 'Electric-buffer-menu-quit)
(define-key map [mouse-2] 'Electric-buffer-menu-mouse-select)
;; (define-key map [escape escape escape] #'Electric-buffer-menu-quit)
(define-key map [mouse-2] #'Electric-buffer-menu-mouse-select)
map))
(put 'Electric-buffer-menu-quit :advertised-binding "\C-c\C-c")
@ -205,7 +203,7 @@ See the documentation of `electric-buffer-list' for details."
(setq-local Helper-return-blurb "return to buffer editing"))
(define-obsolete-function-alias 'Electric-buffer-menu-mode
'electric-buffer-menu-mode "24.3")
#'electric-buffer-menu-mode "24.3")
;; generally the same as Buffer-menu-mode-map
;; (except we don't indirect to global-map)

77
lisp/echistory.el
View file

@ -1,4 +1,4 @@
;;; echistory.el --- Electric Command History Mode
;;; echistory.el --- Electric Command History Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@ -44,44 +44,43 @@ With prefix arg NOCONFIRM, execute current line as-is without editing."
(defvar electric-history-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'Electric-history-undefined)
(define-key map [t] #'Electric-history-undefined)
(define-key map "\e" (make-sparse-keymap))
(define-key map [?\e t] 'Electric-history-undefined)
(define-key map "\C-u" 'universal-argument)
(define-key map " " 'Electric-command-history-redo-expression)
(define-key map "!" 'Electric-command-history-redo-expression)
(define-key map "\e\C-x" 'eval-sexp)
(define-key map "\e\C-d" 'down-list)
(define-key map "\e\C-u" 'backward-up-list)
(define-key map "\e\C-b" 'backward-sexp)
(define-key map "\e\C-f" 'forward-sexp)
(define-key map "\e\C-a" 'beginning-of-defun)
(define-key map "\e\C-e" 'end-of-defun)
(define-key map "\e\C-n" 'forward-list)
(define-key map "\e\C-p" 'backward-list)
(define-key map "q" 'Electric-history-quit)
(define-key map [?\e t] #'Electric-history-undefined)
(define-key map "\C-u" #'universal-argument)
(define-key map " " #'Electric-command-history-redo-expression)
(define-key map "!" #'Electric-command-history-redo-expression)
(define-key map "\e\C-d" #'down-list)
(define-key map "\e\C-u" #'backward-up-list)
(define-key map "\e\C-b" #'backward-sexp)
(define-key map "\e\C-f" #'forward-sexp)
(define-key map "\e\C-a" #'beginning-of-defun)
(define-key map "\e\C-e" #'end-of-defun)
(define-key map "\e\C-n" #'forward-list)
(define-key map "\e\C-p" #'backward-list)
(define-key map "q" #'Electric-history-quit)
(define-key map "\C-c" nil)
(define-key map "\C-c\C-c" 'Electric-history-quit)
(define-key map "\C-]" 'Electric-history-quit)
(define-key map "\C-z" 'suspend-frame)
(define-key map (char-to-string help-char) 'Helper-help)
(define-key map "?" 'Helper-describe-bindings)
(define-key map "\e>" 'end-of-buffer)
(define-key map "\e<" 'beginning-of-buffer)
(define-key map "\n" 'next-line)
(define-key map "\r" 'next-line)
(define-key map "\177" 'previous-line)
(define-key map "\C-n" 'next-line)
(define-key map "\C-p" 'previous-line)
(define-key map "\ev" 'scroll-down)
(define-key map "\C-v" 'scroll-up)
(define-key map [home] 'beginning-of-buffer)
(define-key map [down] 'next-line)
(define-key map [up] 'previous-line)
(define-key map [prior] 'scroll-down)
(define-key map [next] 'scroll-up)
(define-key map "\C-l" 'recenter)
(define-key map "\e\C-v" 'scroll-other-window)
(define-key map "\C-c\C-c" #'Electric-history-quit)
(define-key map "\C-]" #'Electric-history-quit)
(define-key map "\C-z" #'suspend-frame)
(define-key map (char-to-string help-char) #'Helper-help)
(define-key map "?" #'Helper-describe-bindings)
(define-key map "\e>" #'end-of-buffer)
(define-key map "\e<" #'beginning-of-buffer)
(define-key map "\n" #'next-line)
(define-key map "\r" #'next-line)
(define-key map "\177" #'previous-line)
(define-key map "\C-n" #'next-line)
(define-key map "\C-p" #'previous-line)
(define-key map "\ev" #'scroll-down)
(define-key map "\C-v" #'scroll-up)
(define-key map [home] #'beginning-of-buffer)
(define-key map [down] #'next-line)
(define-key map [up] #'previous-line)
(define-key map [prior] #'scroll-down)
(define-key map [next] #'scroll-up)
(define-key map "\C-l" #'recenter)
(define-key map "\e\C-v" #'scroll-other-window)
map)
"Keymap for Electric Command History mode.")
@ -141,7 +140,9 @@ The Command History listing is recomputed each time this mode is invoked."
(defun Electric-history-undefined ()
(interactive)
(ding)
(message "%s" (substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute"))
(message "%s" (substitute-command-keys "Type \\[Helper-help] for help, \
\\[Helper-describe-bindings] for commands, \\[Electric-history-quit] to quit, \
\\[Electric-command-history-redo-expression] to execute"))
(sit-for 4))
(defun Electric-history-quit ()

2
lisp/emulation/edt-mapper.el
View file

@ -101,6 +101,8 @@
(define-obsolete-variable-alias 'edt-window-system 'window-system "27.1")
(defconst edt-xserver (when (eq window-system 'x)
(declare-function x-server-vendor "xfns.c"
(&optional terminal))
;; The Cygwin window manager has a `/' in its
;; name, which breaks the generated file name of
;; the custom key map file. Replace `/' with a

2
lisp/emulation/edt.el
View file

@ -299,6 +299,8 @@ This means that an edt-user.el file was found in the user's `load-path'.")
;;; o edt-emulation-on o edt-load-keys
;;;
(defconst edt-xserver (when (eq window-system 'x)
(declare-function x-server-vendor "xfns.c"
(&optional terminal))
;; The Cygwin window manager has a `/' in its
;; name, which breaks the generated file name of
;; the custom key map file. Replace `/' with a

3
lisp/erc/erc.el
View file

@ -50,9 +50,6 @@
;; After you are connected to a server, you can use C-h m or have a look at
;; the ERC menu.
;;; History:
;;
;;; Code:
(load "erc-loaddefs" nil t)

6
lisp/faces.el
View file

@ -503,7 +503,8 @@ If INHERIT is t, and FACE doesn't define a foreground color, then any
foreground color that FACE inherits through its `:inherit' attribute
is considered as well; however the return value may still be nil.
If INHERIT is a face or a list of faces, then it is used to try to
resolve an unspecified foreground color.
resolve an unspecified foreground color, in addition to using any
inherited color.
To ensure that a valid color is always returned, use a value of
`default' for INHERIT; this will resolve any unspecified values by
@ -523,7 +524,8 @@ If INHERIT is t, and FACE doesn't define a background color, then any
background color that FACE inherits through its `:inherit' attribute
is considered as well; however the return value may still be nil.
If INHERIT is a face or a list of faces, then it is used to try to
resolve an unspecified background color.
resolve an unspecified background color, in addition to using any
inherited color.
To ensure that a valid color is always returned, use a value of
`default' for INHERIT; this will resolve any unspecified values by

19
lisp/foldout.el
View file

@ -230,14 +230,6 @@ An end marker of nil means the fold ends after (point-max).")
(setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))
))
;; outline-flag-region has different `flag' values in outline.el and
;; noutline.el for hiding and showing text.
(defconst foldout-hide-flag
(if (featurep 'noutline) t ?\^M))
(defconst foldout-show-flag
(if (featurep 'noutline) nil ?\n))
(defun foldout-zoom-subtree (&optional exposure)
@ -364,8 +356,7 @@ exited and text is left visible."
;; make sure the next heading is exposed
(if end-marker
(outline-flag-region end-of-subtree beginning-of-heading
foldout-show-flag)))
(outline-flag-region end-of-subtree beginning-of-heading nil)))
;; zap the markers so they don't slow down editing
(set-marker start-marker nil)
@ -551,6 +542,14 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
(define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit)
))
;; Obsolete.
(defconst foldout-hide-flag t)
(make-obsolete-variable 'foldout-hide-flag nil "28.1")
(defconst foldout-show-flag nil)
(make-obsolete-variable 'foldout-show-flag nil "28.1")
(provide 'foldout)
;;; foldout.el ends here

138
lisp/follow.el
View file

@ -1,4 +1,4 @@
;;; follow.el --- synchronize windows showing the same buffer
;;; follow.el --- synchronize windows showing the same buffer -*- lexical-binding: t -*-
;; Copyright (C) 1995-1997, 1999, 2001-2021 Free Software Foundation,
;; Inc.
@ -25,7 +25,7 @@
;;; Commentary:
;; `Follow mode' is a minor mode that combines windows into one tall
;; `follow-mode' is a minor mode that combines windows into one tall
;; virtual window.
;;
;; The feeling of a "virtual window" has been accomplished by the use
@ -81,7 +81,7 @@
;; text. Enter long lines spanning several lines, or several
;; windows.
;;
;; * Should you find `Follow' mode annoying, just type
;; * Should you find Follow mode annoying, just type
;; M-x follow-mode <RETURN>
;; to turn it off.
@ -93,25 +93,24 @@
;; key map. To do so, add the following lines (replacing `[f7]' and
;; `[f8]' with your favorite keys) to the init file:
;;
;; (global-set-key [f8] 'follow-mode)
;; (global-set-key [f7] 'follow-delete-other-windows-and-split)
;; (global-set-key [f8] #'follow-mode)
;; (global-set-key [f7] #'follow-delete-other-windows-and-split)
;; There exist two system variables that control the appearance of
;; lines wider than the window containing them. The default is to
;; truncate long lines whenever a window isn't as wide as the frame.
;;
;; To make sure lines are never truncated, please place the following
;; lines in your init file:
;; To make sure lines are never truncated, place the following lines
;; in your Init file:
;;
;; (setq truncate-lines nil)
;; (setq truncate-partial-width-windows nil)
;; The correct way to configure Follow mode, or any other mode for
;; that matter, is to create one or more functions that do
;; whatever you would like to do. These functions are then added to
;; a hook.
;; One way to configure Follow mode is to create one or more functions
;; that do whatever you would like to do. These functions are then
;; added to a hook.
;;
;; The keymap `follow-mode-map' contains key bindings activated by
;; `follow-mode'.
@ -120,8 +119,8 @@
;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
;;
;; (defun my-follow-mode-hook ()
;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
;; (define-key follow-mode-map "\C-cb" 'another-function))
;; (define-key follow-mode-map "\C-ca" #'your-favorite-function)
;; (define-key follow-mode-map "\C-cb" #'another-function))
;; Usage:
@ -129,60 +128,60 @@
;; To activate, issue the command "M-x follow-mode"
;; and press Return. To deactivate, do it again.
;;
;; The following is a list of commands useful when follow-mode is active.
;; The following is a list of commands useful when `follow-mode' is active.
;;
;; follow-scroll-up C-c . C-v
;; `follow-scroll-up' C-c . C-v
;; Scroll text in a Follow mode window chain up.
;;
;; follow-scroll-down C-c . v
;; `follow-scroll-down' C-c . v
;; Like `follow-scroll-up', but in the other direction.
;;
;; follow-delete-other-windows-and-split C-c . 1
;; `follow-delete-other-windows-and-split' C-c . 1
;; Maximize the visible area of the current buffer,
;; and enter Follow mode. This is a very convenient
;; and enter Follow mode. This is a very convenient
;; way to start Follow mode, hence we recommend that
;; this command be added to the global keymap.
;;
;; follow-recenter C-c . C-l
;; `follow-recenter' C-c . C-l
;; Place point in the center of the middle window,
;; or a specified number of lines from either top or bottom.
;;
;; follow-switch-to-buffer C-c . b
;; `follow-switch-to-buffer' C-c . b
;; Switch buffer in all windows displaying the current buffer
;; in this frame.
;;
;; follow-switch-to-buffer-all C-c . C-b
;; `follow-switch-to-buffer-all' C-c . C-b
;; Switch buffer in all windows in the selected frame.
;;
;; follow-switch-to-current-buffer-all
;; `follow-switch-to-current-buffer-all'
;; Show the current buffer in all windows on the current
;; frame and turn on `follow-mode'.
;;
;; follow-first-window C-c . <
;; `follow-first-window' C-c . <
;; Select the first window in the frame showing the same buffer.
;;
;; follow-last-window C-c . >
;; `follow-last-window' C-c . >
;; Select the last window in the frame showing the same buffer.
;;
;; follow-next-window C-c . n
;; `follow-next-window' C-c . n
;; Select the next window in the frame showing the same buffer.
;;
;; follow-previous-window C-c . p
;; `follow-previous-window' C-c . p
;; Select the previous window showing the same buffer.
;; Well, it seems ok, but what if I really want to look at two different
;; positions in the text? Here are two simple methods to use:
;; positions in the text? Here are two simple methods to use:
;;
;; 1) Use multiple frames; `follow' mode only affects windows displayed
;; in the same frame. (My apologies to you who can't use frames.)
;; in the same frame. (My apologies to you who can't use frames.)
;;
;; 2) Bind `follow-mode' to key so you can turn it off whenever
;; you want to view two locations. Of course, `follow' mode can
;; you want to view two locations. Of course, `follow-mode' can
;; be reactivated by hitting the same key again.
;;
;; Example from my ~/.emacs:
;; (global-set-key [f8] 'follow-mode)
;; (global-set-key [f8] #'follow-mode)
;; Implementation:
;;
@ -235,17 +234,17 @@ After that, changing the prefix key requires manipulating keymaps."
(defvar follow-mode-map
(let ((mainmap (make-sparse-keymap))
(map (make-sparse-keymap)))
(define-key map "\C-v" 'follow-scroll-up)
(define-key map "\M-v" 'follow-scroll-down)
(define-key map "v" 'follow-scroll-down)
(define-key map "1" 'follow-delete-other-windows-and-split)
(define-key map "b" 'follow-switch-to-buffer)
(define-key map "\C-b" 'follow-switch-to-buffer-all)
(define-key map "\C-l" 'follow-recenter)
(define-key map "<" 'follow-first-window)
(define-key map ">" 'follow-last-window)
(define-key map "n" 'follow-next-window)
(define-key map "p" 'follow-previous-window)
(define-key map "\C-v" #'follow-scroll-up)
(define-key map "\M-v" #'follow-scroll-down)
(define-key map "v" #'follow-scroll-down)
(define-key map "1" #'follow-delete-other-windows-and-split)
(define-key map "b" #'follow-switch-to-buffer)
(define-key map "\C-b" #'follow-switch-to-buffer-all)
(define-key map "\C-l" #'follow-recenter)
(define-key map "<" #'follow-first-window)
(define-key map ">" #'follow-last-window)
(define-key map "n" #'follow-next-window)
(define-key map "p" #'follow-previous-window)
(define-key mainmap follow-mode-prefix map)
@ -254,13 +253,13 @@ After that, changing the prefix key requires manipulating keymaps."
;; could be enhanced in Follow mode. End-of-buffer is a special
;; case since it is very simple to define and it greatly enhances
;; the look and feel of Follow mode.)
(define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
(define-key mainmap [remap end-of-buffer] #'follow-end-of-buffer)
(define-key mainmap [remap scroll-bar-toolkit-scroll] 'follow-scroll-bar-toolkit-scroll)
(define-key mainmap [remap scroll-bar-drag] 'follow-scroll-bar-drag)
(define-key mainmap [remap scroll-bar-scroll-up] 'follow-scroll-bar-scroll-up)
(define-key mainmap [remap scroll-bar-scroll-down] 'follow-scroll-bar-scroll-down)
(define-key mainmap [remap mwheel-scroll] 'follow-mwheel-scroll)
(define-key mainmap [remap scroll-bar-toolkit-scroll] #'follow-scroll-bar-toolkit-scroll)
(define-key mainmap [remap scroll-bar-drag] #'follow-scroll-bar-drag)
(define-key mainmap [remap scroll-bar-scroll-up] #'follow-scroll-bar-scroll-up)
(define-key mainmap [remap scroll-bar-scroll-down] #'follow-scroll-bar-scroll-down)
(define-key mainmap [remap mwheel-scroll] #'follow-mwheel-scroll)
mainmap)
"Minor mode keymap for Follow mode.")
@ -342,7 +341,7 @@ property `follow-mode-use-cache' to non-nil.")
;; Internal variables:
(defvar follow-internal-force-redisplay nil
"True when Follow mode should redisplay the windows.")
"Non-nil when Follow mode should redisplay the windows.")
(defvar follow-active-menu nil
"The menu visible when Follow mode is active.")
@ -369,7 +368,7 @@ This is typically set by explicit scrolling commands.")
(defsubst follow-debug-message (&rest args)
"Like `message', but only active when `follow-debug' is non-nil."
(if (and (boundp 'follow-debug) follow-debug)
(apply 'message args)))
(apply #'message args)))
;;; Cache
@ -1019,8 +1018,8 @@ returned by `follow-windows-start-end'."
(setq win-start-end (cdr win-start-end)))
result))
;; Check if point is visible in all windows. (So that
;; no one will be recentered.)
;; Check if point is visible in all windows.
;; (So that no one will be recentered.)
(defun follow-point-visible-all-windows-p (win-start-end)
"Non-nil when the `window-point' is visible in all windows."
@ -1069,11 +1068,11 @@ Return the selected window."
win))
;; Lets select a window showing the end. Make sure we only select it if
;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
;; point in the selected window.)
;;
;; (Compatibility kludge: in Emacs `window-end' is equal to `point-max';
;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
;; checking `window-end' now when I check `end-of-buffer' explicitly?)
(defun follow-select-if-end-visible (win-start-end)
@ -1097,7 +1096,7 @@ Return the selected window."
;; Select a window that will display point if the windows would
;; be redisplayed with the first window fixed. This is useful for
;; be redisplayed with the first window fixed. This is useful for
;; example when the user has pressed return at the bottom of a window
;; as point is not visible in any window.
@ -1202,7 +1201,7 @@ should be a member of WINDOWS, starts at position START."
(goto-char guess)
(while (not done)
(if (not (= (vertical-motion 1 (car windows)) 1))
;; Hit bottom! (Can we really do this?)
;; Hit bottom! (Can we really do this?)
;; We'll keep it, since it ensures termination.
(progn
(setq done t)
@ -1283,7 +1282,7 @@ non-first windows in Follow mode."
(defvar follow-prev-buffer nil
"The buffer current at the last call to `follow-adjust-window' or nil.
follow-mode is not necessarily enabled in this buffer.")
`follow-mode' is not necessarily enabled in this buffer.")
;; This function is added to `pre-display-function' and is thus called
;; before each redisplay operation. It supersedes (2018-09) the
@ -1331,7 +1330,7 @@ follow-mode is not necessarily enabled in this buffer.")
;; .
(defun follow-adjust-window (win)
;; Adjust the window WIN and its followers.
"Adjust the window WIN and its followers."
(cl-assert (eq (window-buffer win) (current-buffer)))
;; Have we moved out of or into a follow-mode window group?
@ -1646,17 +1645,17 @@ This is updated by redisplay or by calling
(defun follow-window-end (&optional window update)
"Return position at which display currently ends in the Follow
Mode group of windows which includes WINDOW.
Mode group of windows which includes WINDOW.
WINDOW must be a live window and defaults to the selected one.
This is updated by redisplay, when it runs to completion.
Simply changing the buffer text or setting `window-start' does
not update this value.
WINDOW must be a live window and defaults to the selected one.
This is updated by redisplay, when it runs to completion.
Simply changing the buffer text or setting `window-start' does
not update this value.
Return nil if there is no recorded value. (This can happen if
the last redisplay of WINDOW was preempted, and did not
finish.) If UPDATE is non-nil, compute the up-to-date position
if it isn't already recorded."
Return nil if there is no recorded value. (This can happen if
the last redisplay of WINDOW was preempted, and did not
finish.) If UPDATE is non-nil, compute the up-to-date position
if it isn't already recorded."
(let* ((windows (follow-all-followers window))
(last (car (last windows))))
(when (and update follow-start-end-invalid)
@ -1676,7 +1675,7 @@ overriding motion of point in order to display at this exact start."
(defun follow-pos-visible-in-window-p (&optional pos window partially)
"Return non-nil if position POS is currently on the frame in one of
the windows in the Follow Mode group which includes WINDOW.
the windows in the Follow Mode group which includes WINDOW.
WINDOW must be a live window and defaults to the selected one.
@ -1695,8 +1694,7 @@ omitted if the character after POS is fully visible; otherwise, RTOP
and RBOT are the number of pixels off-window at the top and bottom of
the screen line (\"row\") containing POS, ROWH is the visible height
of that row, and VPOS is the row number \(zero-based)."
(let* ((windows (follow-all-followers window))
(last (car (last windows))))
(let* ((windows (follow-all-followers window)))
(when follow-start-end-invalid
(follow-redisplay windows (car windows)))
(let* ((cache (follow-windows-start-end windows))
@ -1724,7 +1722,7 @@ zero means top of the first window in the group, negative means
(start-end (follow-windows-start-end windows))
(rev-start-end (reverse start-end))
(lines 0)
middle-window elt count)
elt count)
(select-window
(cond
((null arg)

11
lisp/frame.el
View file

@ -367,6 +367,7 @@ there (in decreasing order of priority)."
;; by the lines added in x-create-frame for the tab-bar and
;; switch `tab-bar-mode' off.
(when (display-graphic-p)
(declare-function tab-bar-height "xdisp.c" (&optional frame pixelwise))
(let* ((init-lines
(assq 'tab-bar-lines initial-frame-alist))
(other-lines
@ -708,9 +709,11 @@ Return nil if we don't know how to interpret DISPLAY."
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
The optional argument PARAMETERS specifies additional frame parameters."
(interactive (list (completing-read
(format "Make frame on display: ")
(x-display-list))))
(interactive (if (fboundp 'x-display-list)
(list (completing-read
(format "Make frame on display: ")
(x-display-list)))
(user-error "This Emacs build does not support X displays")))
(make-frame (cons (cons 'display display) parameters)))
(defun make-frame-on-current-monitor (&optional parameters)
@ -1370,7 +1373,7 @@ FRAME defaults to the selected frame."
FRAME defaults to the selected frame."
(setq frame (window-normalize-frame frame))
(- (frame-native-height frame)
(tab-bar-height frame t)
(if (fboundp 'tab-bar-height) (tab-bar-height frame t) 0)
(* 2 (frame-internal-border-width frame))))
(defun frame-outer-width (&optional frame)

8
lisp/gnus/gnus-util.el
View file

@ -1612,8 +1612,8 @@ empty directories from OLD-PATH."
"Rescale IMAGE to SIZE if possible.
SIZE is in format (WIDTH . HEIGHT). Return a new image.
Sizes are in pixels."
(if (not (display-graphic-p))
image
(when (display-images-p)
(declare-function image-size "image.c" (spec &optional pixels frame))
(let ((new-width (car size))
(new-height (cdr size)))
(when (> (cdr (image-size image t)) new-height)
@ -1621,8 +1621,8 @@ Sizes are in pixels."
:max-height new-height)))
(when (> (car (image-size image t)) new-width)
(setq image (create-image (plist-get (cdr image) :data) nil t
:max-width new-width)))
image)))
:max-width new-width)))))
image)
(defun gnus-recursive-directory-files (dir)
"Return all regular files below DIR.

1
lisp/gnus/nnimap.el
View file

@ -440,6 +440,7 @@ during splitting, which may be slow."
;; This is only needed for Windows XP or earlier
(defun nnimap-map-port (port)
(declare-function x-server-version "xfns.c" (&optional terminal))
(if (and (eq system-type 'windows-nt)
(<= (car (x-server-version)) 5)
(equal port "imaps"))

32
lisp/htmlfontify.el
View file

@ -983,19 +983,18 @@ merged by the user - `hfy-flatten-style' should do this."
(:italic (hfy-slant 'italic))))))
(setq that (hfy-face-to-style-i next))
;;(lwarn t :warning "%S => %S" fn (nconc this that parent))
(nconc this parent that))) )
(append this parent that))) )
(defun hfy-size-to-int (spec)
(defun hfy--size-to-int (spec)
"Convert SPEC, a CSS font-size specifier, to an Emacs :height attribute value.
Used while merging multiple font-size attributes."
;;(message "hfy-size-to-int");;DBUG
(list
(if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec)
(cond ((string= "%" (match-string 2 spec))
(/ (string-to-number (match-string 1 spec)) 100.0))
((string= "pt" (match-string 2 spec))
(* (string-to-number (match-string 1 spec)) 10)))
(string-to-number spec))) )
;;(message "hfy--size-to-int");;DBUG
(if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec)
(cond ((string= "%" (match-string 2 spec))
(/ (string-to-number (match-string 1 spec)) 100.0))
((string= "pt" (match-string 2 spec))
(* (string-to-number (match-string 1 spec)) 10)))
(string-to-number spec)) )
;; size is different, in that in order to get it right at all,
;; we have to trawl the inheritance path, accumulating modifiers,
@ -1006,19 +1005,18 @@ any multiple attributes appropriately. Currently only font-size is merged
down to a single occurrence - others may need special handling, but I
haven't encountered them yet. Returns a `hfy-style-assoc'."
;;(message "(hfy-flatten-style %S)" style) ;;DBUG
(let ((n 0)
(m (list 1))
(let ((m (list 1))
(x nil)
(r nil))
(dolist (css style)
(if (string= (car css) "font-size")
(progn
(when (not x) (setq m (nconc m (hfy-size-to-int (cdr css)))))
(when (not x) (push (hfy--size-to-int (cdr css)) m))
(when (string-match "pt" (cdr css)) (setq x t)))
(setq r (nconc r (list css)))))
(push css r)))
;;(message "r: %S" r)
(setq n (apply #'* m))
(nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
(let ((n (apply #'* m)))
(nconc (nreverse r) (hfy-size (if x (round n) (float n)))))))
(defun hfy-face-resolve-face (fn)
"For FN return a face specification.
@ -1052,7 +1050,7 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
;; text-decoration is not inherited.
;; but it's not wrong and if this ever changes it will
;; be needed, so I think it's better to leave it in? -- v
(nconc final-style '(("text-decoration" . "none"))))))
(push '("text-decoration" . "none") final-style))))
final-style))
;; strip redundant bits from a name. Technically, this could result in

1
lisp/image.el
View file

@ -1130,6 +1130,7 @@ default is 20%."
image))
(defun image--get-imagemagick-and-warn (&optional position)
(declare-function image-transforms-p "image.c" (&optional frame))
(unless (or (fboundp 'imagemagick-types) (image-transforms-p))
(error "Cannot rescale images on this terminal"))
(let ((image (image--get-image position)))

2
lisp/international/mule-diag.el
View file

@ -835,6 +835,8 @@ The IGNORED argument is ignored."
(list (completing-read
"Font name (default current choice for ASCII chars): "
(and window-system
;; Implied by `window-system'.
(fboundp 'x-list-fonts)
(fboundp 'fontset-list)
;; The final element in `fontset-list' is a default
;; (generic) one, so don't include that.

39
lisp/lpr.el
View file

@ -1,4 +1,4 @@
;;; lpr.el --- print Emacs buffer on line printer
;;; lpr.el --- print Emacs buffer on line printer -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@ -39,12 +39,10 @@
(memq system-type '(usg-unix-v hpux))
"Non-nil if running on a system type that uses the \"lp\" command.")
(defgroup lpr nil
"Print Emacs buffer on line printer."
:group 'text)
;;;###autoload
(defcustom printer-name
(and (eq system-type 'ms-dos) "PRN")
@ -65,8 +63,7 @@ file. If you want to discard the printed output, set this to \"NUL\"."
:tag "Printer Name"
(const :tag "Default" nil)
;; could use string but then we lose completion for files.
(file :tag "Name"))
:group 'lpr)
(file :tag "Name")))
;;;###autoload
(defcustom lpr-switches nil
@ -74,16 +71,14 @@ file. If you want to discard the printed output, set this to \"NUL\"."
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
See `lpr-command'."
:type '(repeat (string :tag "Argument"))
:group 'lpr)
:type '(repeat (string :tag "Argument")))
(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
"Non-nil means construct `-T' and `-J' options for the printer program.
These are made assuming that the program is `lpr';
if you are using some other incompatible printer program,
this variable should be nil."
:type 'boolean
:group 'lpr)
:type 'boolean)
(defcustom lpr-printer-switch
(if lpr-lp-system
@ -94,8 +89,7 @@ This switch is used in conjunction with `printer-name'."
:type '(choice :menu-tag "Printer Name Switch"
:tag "Printer Name Switch"
(const :tag "None" nil)
(string :tag "Printer Switch"))
:group 'lpr)
(string :tag "Printer Switch")))
;;;###autoload
(defcustom lpr-command
@ -116,8 +110,7 @@ Windows NT and Novell Netware respectively) are handled specially, using
`printer-name' as the destination for output; any other program is
treated like `lpr' except that an explicit filename is given as the last
argument."
:type 'string
:group 'lpr)
:type 'string)
;; Default is nil, because that enables us to use pr -f
;; which is more reliable than pr with no args, which is what lpr -p does.
@ -127,22 +120,21 @@ If nil, we run `lpr-page-header-program' to make page headings
and print the result."
:type '(choice (const nil)
(string :tag "Single argument")
(repeat :tag "Multiple arguments" (string :tag "Argument")))
:group 'lpr)
(repeat :tag "Multiple arguments" (string :tag "Argument"))))
(defcustom print-region-function
(if (memq system-type '(ms-dos windows-nt))
#'w32-direct-print-region-function
(progn
(declare-function w32-direct-print-region-function "w32-fns")
#'w32-direct-print-region-function)
#'call-process-region)
"Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
:type 'function
:group 'lpr)
:type 'function)
(defcustom lpr-page-header-program "pr"
"Name of program for adding page headers to a file."
:type 'string
:group 'lpr)
:type 'string)
;; Berkeley systems support -F, and GNU pr supports both -f and -F,
;; So it looks like -F is a better default.
@ -151,8 +143,7 @@ See definition of `print-region-1' for calling conventions."
If `%s' appears in any of the strings, it is substituted by the page title.
Note that for correct quoting, `%s' should normally be a separate element.
The variable `lpr-page-header-program' specifies the program to use."
:type '(repeat string)
:group 'lpr)
:type '(repeat string))
;;;###autoload
(defun lpr-buffer ()
@ -248,7 +239,7 @@ for further customization of the printer command."
nil
;; Run a separate program to get page headers.
(let ((new-coords (print-region-new-buffer start end)))
(apply 'call-process-region (car new-coords) (cdr new-coords)
(apply #'call-process-region (car new-coords) (cdr new-coords)
lpr-page-header-program t t nil
(mapcar (lambda (e) (format e name))
lpr-page-header-switches)))
@ -270,7 +261,7 @@ for further customization of the printer command."
(let ((retval
(let ((tempbuf (current-buffer)))
(with-current-buffer buf
(apply (or print-region-function 'call-process-region)
(apply (or print-region-function #'call-process-region)
start end lpr-command
nil tempbuf nil
(nconc (and name lpr-add-switches

14
lisp/mh-e/mh-inc.el
View file

@ -62,15 +62,11 @@
(defun mh-inc-spool-generator (folder spool)
"Create a command to inc into FOLDER from SPOOL file."
(let ((folder1 (make-symbol "folder"))
(spool1 (make-symbol "spool")))
(set folder1 folder)
(set spool1 spool)
(setf (symbol-function (intern (concat "mh-inc-spool-" folder)))
`(lambda ()
,(format "Inc spool file %s into folder %s." spool folder)
(interactive)
(mh-inc-folder ,spool1 (concat "+" ,folder1))))))
(defalias (symbol-function (intern (concat "mh-inc-spool-" folder)))
(lambda ()
(:documentation (format "Inc spool file %s into folder %s." spool folder))
(interactive)
(mh-inc-folder spool (concat "+" folder)))))
(defun mh-inc-spool-def-key (key folder)
"Define a KEY in `mh-inc-spool-map' to inc FOLDER and collect help string."

18
lisp/mh-e/mh-mime.el
View file

@ -487,15 +487,11 @@ decoding the same message multiple times."
(mh-display-emphasis)
(mm-handle-set-undisplayer
handle
`(lambda ()
(let (buffer-read-only)
(if (fboundp 'remove-specifier)
;; This is only valid on XEmacs.
(mapcar (lambda (prop)
(remove-specifier
(face-property 'default prop) (current-buffer)))
'(background background-pixmap foreground)))
(delete-region ,(point-min-marker) ,(point-max-marker)))))))))
(let ((beg (point-min-marker))
(end (point-max-marker)))
(lambda ()
(let ((inhibit-read-only t))
(delete-region beg end)))))))))
;;;###mh-autoload
(defun mh-decode-message-header ()
@ -781,7 +777,7 @@ This is only useful if a Content-Disposition header is not present."
(funcall media-test handle) ; Since mm-inline-large-images is T,
; this only tells us if the image is
; something that emacs can display
(let* ((image (mm-get-image handle)))
(let ((image (mm-get-image handle)))
(or (mh-do-in-xemacs
(and (mh-funcall-if-exists glyphp image)
(< (glyph-width image)
@ -790,7 +786,7 @@ This is only useful if a Content-Disposition header is not present."
(or mh-max-inline-image-height
(window-pixel-height)))))
(mh-do-in-gnu-emacs
(let ((size (mh-funcall-if-exists image-size image)))
(let ((size (and (fboundp 'image-size) (image-size image))))
(and size
(< (cdr size) (or mh-max-inline-image-height
(1- (window-height))))

5
lisp/net/dbus.el
View file

@ -2029,8 +2029,9 @@ either a method name, a signal name, or an error name."
",")
rule (or rule ""))
(unless (ignore-errors (dbus-get-unique-name bus-private))
(dbus-init-bus bus 'private))
(when (fboundp 'dbus-get-unique-name)
(unless (ignore-errors (dbus-get-unique-name bus-private))
(dbus-init-bus bus 'private)))
(dbus-call-method
bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
"BecomeMonitor" `(:array :string ,rule) :uint32 0)

1
lisp/net/newst-plainview.el
View file

@ -273,6 +273,7 @@ images."
(defvar newsticker--plainview-tool-bar-map
(when (boundp 'tool-bar-map)
(defvar tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "newsticker/prev-feed"
'newsticker-previous-feed

5
lisp/net/newst-treeview.el
View file

@ -30,10 +30,6 @@
;; See newsticker.el
;; ======================================================================
;;; History:
;;
;; ======================================================================
;;; Code:
(require 'cl-lib)
@ -1102,6 +1098,7 @@ Arguments are ignored."
;; ======================================================================
(defvar newsticker-treeview-tool-bar-map
(when (boundp 'tool-bar-map)
(defvar tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "newsticker/prev-feed"
'newsticker-treeview-prev-feed

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

@ -3654,6 +3654,8 @@ Fall back to normal file name handler if no Tramp handler exists."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
(let ((default-directory (file-name-directory file-name))
(process-environment
(cons "GIO_USE_FILE_MONITOR=help" process-environment))
command events filter p sequence)
(cond
;; "inotifywait".
@ -3718,10 +3720,6 @@ Fall back to normal file name handler if no Tramp handler exists."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
;; Set "gio-file-monitor" property if needed.
(when (string-equal (file-name-nondirectory command) "gio")
(tramp-set-connection-property
p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v)))
p))))
(defun tramp-sh-gio-monitor-process-filter (proc string)
@ -3742,41 +3740,64 @@ Fall back to normal file name handler if no Tramp handler exists."
"changes done" "changes-done-hint" string)
string (tramp-compat-string-replace
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
(string-match-p "Monitoring not supported\\|No locations given" string)
(delete-process proc))
;; Delete empty lines.
(setq string (tramp-compat-string-replace "\n\n" "\n" string))
(catch 'doesnt-work
;; https://bugs.launchpad.net/bugs/1742946
(when
(string-match-p "Monitoring not supported\\|No locations given" string)
(delete-process proc)
(throw 'doesnt-work nil))
(while (string-match
(eval-when-compile
(concat "^[^:]+:"
"[[:space:]]\\([^:]+\\):"
"[[:space:]]" (regexp-opt tramp-gio-events t)
"\\([[:space:]]\\([^:]+\\)\\)?$"))
string)
;; Determine monitor name.
(unless (tramp-connection-property-p proc "gio-file-monitor")
(cond
;; We have seen this only on cygwin gio, which uses the
;; GPollFileMonitor.
((string-match
"Can't find module 'help' specified in GIO_USE_FILE_MONITOR" string)
(tramp-set-connection-property
proc "gio-file-monitor" 'GPollFileMonitor))
;; TODO: What happens, if several monitor names are reported?
((string-match "\
Supported arguments for GIO_USE_FILE_MONITOR environment variable:
\\s-*\\([[:alpha:]]+\\) - 20" string)
(tramp-set-connection-property
proc "gio-file-monitor"
(intern
(format "G%sFileMonitor" (capitalize (match-string 1 string))))))
(t (throw 'doesnt-work nil)))
(setq string (replace-match "" nil nil string)))
(let* ((file (match-string 1 string))
(file1 (match-string 4 string))
(object
(list
proc
(list
(intern-soft (match-string 2 string)))
;; File names are returned as absolute paths. We must
;; add the remote prefix.
(concat remote-prefix file)
(when file1 (concat remote-prefix file1)))))
(setq string (replace-match "" nil nil string))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the handler directly.
(when (member (cl-caadr object) events)
(tramp-compat-funcall
(lookup-key special-event-map [file-notify])
`(file-notify ,object file-notify-callback)))))
;; Delete empty lines.
(setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
(eval-when-compile
(concat "^[^:]+:"
"[[:space:]]\\([^:]+\\):"
"[[:space:]]" (regexp-opt tramp-gio-events t)
"\\([[:space:]]\\([^:]+\\)\\)?$"))
string)
(let* ((file (match-string 1 string))
(file1 (match-string 4 string))
(object
(list
proc
(list
(intern-soft (match-string 2 string)))
;; File names are returned as absolute paths. We
;; must add the remote prefix.
(concat remote-prefix file)
(when file1 (concat remote-prefix file1)))))
(setq string (replace-match "" nil nil string))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the handler directly.
(when (member (cl-caadr object) events)
(tramp-compat-funcall
(lookup-key special-event-map [file-notify])
`(file-notify ,object file-notify-callback))))))
;; Save rest of the string.
(when (zerop (length string)) (setq string nil))
@ -5585,31 +5606,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `gio-monitor' command")
(tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
(defun tramp-get-remote-gio-file-monitor (vec)
"Determine remote GFileMonitor."
(with-tramp-connection-property vec "gio-file-monitor"
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-message vec 5 "Finding the used GFileMonitor")
(when-let ((gio (tramp-get-remote-gio-monitor vec)))
;; Search for the used FileMonitor. There is no known way to
;; get this information directly from gio, so we check for
;; linked libraries of libgio.
(when (tramp-send-command-and-check vec (concat "ldd " gio))
(goto-char (point-min))
(when (re-search-forward "\\S-+/\\(libgio\\|cyggio\\)\\S-+")
(when (tramp-send-command-and-check
vec (concat "strings " (match-string 0)))
(goto-char (point-min))
(re-search-forward
(format
"^%s$"
(regexp-opt
'("GFamFileMonitor" "GFamDirectoryMonitor" "GFenFileMonitor"
"GInotifyFileMonitor" "GKqueueFileMonitor"
"GPollFileMonitor")))
nil 'noerror)
(intern (match-string 0)))))))))
(defun tramp-get-remote-inotifywait (vec)
"Determine remote `inotifywait' command."
(with-tramp-connection-property vec "inotifywait"

29
lisp/obsolete/tpu-extras.el
View file

@ -368,34 +368,22 @@ A repeat count means scroll that many sections."
(and (< (point) top) (recenter (min beg top-margin))))))
;; Advise the newline, newline-and-indent, and do-auto-fill functions.
(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
(defun tpu--respect-bottom-scroll-margin (orig-fun &optional &rest args)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line))
(num (prefix-numeric-value (ad-get-arg 0))))
ad-do-it
(num (prefix-numeric-value (car args))))
(apply orig-fun args)
(tpu-bottom-check beg num)))
(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
ad-do-it
(tpu-bottom-check beg 1)))
(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
ad-do-it
(tpu-bottom-check beg 1)))
;;; Function to set scroll margins
;;;###autoload
(defun tpu-set-scroll-margins (top bottom)
(defun tpu-set-scroll-margins (top bottom &optional emit-msg)
"Set scroll margins."
(interactive
"sEnter top scroll margin (N lines or N%% or RETURN for current value): \
\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): \
\np")
;; set top scroll margin
(or (string= top "")
(setq tpu-top-scroll-margin
@ -411,10 +399,9 @@ A repeat count means scroll that many sections."
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
(dolist (f '(newline newline-and-indent do-auto-fill))
(ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
(ad-activate f))
(advice-add f :around #'tpu--respect-bottom-scroll-margin))
;; report scroll margin settings if running interactively
(and (called-interactively-p 'interactive)
(and emit-msg
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
tpu-top-scroll-margin tpu-bottom-scroll-margin)))

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

@ -869,7 +869,8 @@ delimiting S."
(let ((width (plist-get props :width)))
(and (wholenump width) width)))
(`(image . ,_)
(ceiling (car (image-size spec))))
(and (fboundp 'image-size)
(ceiling (car (image-size spec)))))
((pred stringp)
;; Displayed string could contain invisible parts,
;; but no nested display.

20
lisp/progmodes/cc-defs.el
View file

@ -691,14 +691,16 @@ whitespace.
LIMIT sets an upper limit of the forward movement, if specified. If
LIMIT or the end of the buffer is reached inside a comment or
preprocessor directive, the point will be left there.
preprocessor directive, the point will be left there. If point starts
on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(if limit
`(save-restriction
(narrow-to-region (point-min) (or ,limit (point-max)))
(c-forward-sws))
`(when (< (point) (or ,limit (point-max)))
(save-restriction
(narrow-to-region (point-min) (or ,limit (point-max)))
(c-forward-sws)))
'(c-forward-sws)))
(defmacro c-backward-syntactic-ws (&optional limit)
@ -710,14 +712,16 @@ whitespace.
LIMIT sets a lower limit of the backward movement, if specified. If
LIMIT is reached inside a line comment or preprocessor directive then
the point is moved into it past the whitespace at the end.
the point is moved into it past the whitespace at the end. If point
starts on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(if limit
`(save-restriction
(narrow-to-region (or ,limit (point-min)) (point-max))
(c-backward-sws))
`(when (> (point) (or ,limit (point-min)))
(save-restriction
(narrow-to-region (or ,limit (point-min)) (point-max))
(c-backward-sws)))
'(c-backward-sws)))
(defmacro c-forward-sexp (&optional count)

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

@ -8300,7 +8300,7 @@ comment at the start of cc-engine.el for more info."
;; o - nil if no name is found;
;; o - 'template if it's an identifier ending with an angle bracket
;; arglist;
;; o - 'operator of it's an operator identifier;
;; o - 'operator if it's an operator identifier;
;; o - t if it's some other kind of name.
;;
;; This function records identifier ranges on
@ -8320,6 +8320,7 @@ comment at the start of cc-engine.el for more info."
(lim+ (c-determine-+ve-limit 500)))
(while
(and
(< (point) lim+)
(looking-at c-identifier-key)
(progn
@ -8369,23 +8370,28 @@ comment at the start of cc-engine.el for more info."
;; '*', '&' or a name followed by ":: *",
;; where each can be followed by a sequence
;; of `c-opt-type-modifier-key'.
(while (cond ((looking-at "[*&]")
(goto-char (match-end 0))
t)
((looking-at c-identifier-start)
(and (c-forward-name)
(looking-at "::")
(progn
(goto-char (match-end 0))
(c-forward-syntactic-ws lim+)
(eq (char-after) ?*))
(progn
(forward-char)
t))))
(while
(and
(< (point) lim+)
(cond ((looking-at "[*&]")
(goto-char (match-end 0))
t)
((looking-at c-identifier-start)
(and (c-forward-name)
(looking-at "::")
(progn
(goto-char (match-end 0))
(c-forward-syntactic-ws lim+)
(eq (char-after) ?*))
(progn
(forward-char)
t)))))
(while (progn
(c-forward-syntactic-ws lim+)
(setq pos (point))
(looking-at c-opt-type-modifier-key))
(and
(<= (point) lim+)
(looking-at c-opt-type-modifier-key)))
(goto-char (match-end 1))))))
((looking-at c-overloadable-operators-regexp)
@ -8431,6 +8437,9 @@ comment at the start of cc-engine.el for more info."
;; Maybe an angle bracket arglist.
(when (let (c-last-identifier-range)
(c-forward-<>-arglist nil))
;; <> arglists can legitimately be very long, so recalculate
;; `lim+'.
(setq lim+ (c-determine-+ve-limit 500))
(c-forward-syntactic-ws lim+)
(unless (eq (char-after) ?\()

5
lisp/progmodes/compile.el
View file

@ -2844,8 +2844,9 @@ and overlay is highlighted between MK and END-MK."
(when (and (not pre-existing) w)
(compilation-set-window-height w))
(if from-compilation-buffer
;; If the compilation buffer window was selected,
(if (or from-compilation-buffer
(eq w (selected-window)))
;; If the compilation buffer window is selected,
;; keep the compilation buffer in this window;
;; display the source in another window.
(let ((pop-up-windows t))

2
lisp/progmodes/cwarn.el
View file

@ -1,4 +1,4 @@
;;; cwarn.el --- highlight suspicious C and C++ constructions
;;; cwarn.el --- highlight suspicious C and C++ constructions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.

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

@ -546,6 +546,7 @@ functions are annotated with \"<f>\" via the
((elisp--expect-function-p beg)
(list nil obarray
:predicate #'fboundp
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
@ -559,6 +560,7 @@ functions are annotated with \"<f>\" via the
(symbol-plist sym)))
:annotation-function
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
@ -569,6 +571,11 @@ functions are annotated with \"<f>\" via the
obarray
#'boundp
'strict))
:company-kind
(lambda (s)
(if (test-completion s elisp--local-variables-completion-table)
'value
'variable))
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location)))
@ -615,11 +622,13 @@ functions are annotated with \"<f>\" via the
(looking-at "\\_<let\\*?\\_>"))))
(list t obarray
:predicate #'boundp
:company-kind (lambda (_) 'variable)
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
(_ (list nil obarray
:predicate #'fboundp
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
@ -635,6 +644,16 @@ functions are annotated with \"<f>\" via the
" " (cadr table-etc)))
(cddr table-etc)))))))))
(defun elisp--company-kind (str)
(let ((sym (intern-soft str)))
(cond
((or (macrop sym) (special-form-p sym)) 'keyword)
((fboundp sym) 'function)
((boundp sym) 'variable)
((featurep sym) 'module)
((facep sym) 'color)
(t 'text))))
(defun lisp-completion-at-point (&optional _predicate)
(declare (obsolete elisp-completion-at-point "25.1"))
(elisp-completion-at-point))

2
lisp/progmodes/hideif.el
View file

@ -1600,7 +1600,7 @@ not be expanded."
(result (funcall hide-ifdef-evaluator expr))
(exprstring (replace-regexp-in-string
;; Trim off leading/trailing whites
"^[ \t]*\\([^ \t]+\\)[ \t]*" "\\1"
"^[ \t]*\\|[ \t]*$" ""
(replace-regexp-in-string
"\\(//.*\\)" "" ; Trim off end-of-line comments
(buffer-substring-no-properties start end)))))

5
lisp/progmodes/project.el
View file

@ -782,9 +782,12 @@ pattern to search for."
(user-error "No matches for: %s" regexp))
xrefs))
(defvar project-regexp-history-variable 'grep-regexp-history)
(defun project--read-regexp ()
(let ((sym (thing-at-point 'symbol t)))
(read-regexp "Find regexp" (and sym (regexp-quote sym)))))
(read-regexp "Find regexp" (and sym (regexp-quote sym))
project-regexp-history-variable)))
;;;###autoload
(defun project-find-file ()

465
lisp/progmodes/verilog-mode.el
View file

@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
;; Version: 2021.02.02.263931197
;; Version: 2021.03.30.243771231
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
(defconst verilog-mode-version "2021-02-02-fbb453d-vpo-GNU"
(defconst verilog-mode-version "2021-03-30-e87a75f-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@ -290,7 +290,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(concat open (mapconcat 'regexp-quote strings "\\|") close)))
)
;; Emacs.
(defalias 'verilog-regexp-opt 'regexp-opt)))
(defalias 'verilog-regexp-opt #'regexp-opt)))
;; emacs >=22 has looking-back, but older emacs and xemacs don't.
;; This function is lifted directly from emacs's subr.el
@ -300,7 +300,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(eval-and-compile
(cond
((fboundp 'looking-back)
(defalias 'verilog-looking-back 'looking-back))
(defalias 'verilog-looking-back #'looking-back))
(t
(defun verilog-looking-back (regexp limit &optional greedy)
"Return non-nil if text before point matches regular expression REGEXP.
@ -340,14 +340,14 @@ wherever possible, since it is slow."
(cond
((fboundp 'restore-buffer-modified-p)
;; Faster, as does not update mode line when nothing changes
(defalias 'verilog-restore-buffer-modified-p 'restore-buffer-modified-p))
(defalias 'verilog-restore-buffer-modified-p #'restore-buffer-modified-p))
(t
(defalias 'verilog-restore-buffer-modified-p 'set-buffer-modified-p))))
(defalias 'verilog-restore-buffer-modified-p #'set-buffer-modified-p))))
(eval-and-compile
(cond
((fboundp 'quit-window)
(defalias 'verilog-quit-window 'quit-window))
(defalias 'verilog-quit-window #'quit-window))
(t
(defun verilog-quit-window (_kill-ignored window)
"Quit WINDOW and bury its buffer. KILL-IGNORED is ignored."
@ -379,7 +379,7 @@ wherever possible, since it is slow."
;; Added in Emacs 25.1
(condition-case nil
(unless (fboundp 'forward-word-strictly)
(defalias 'forward-word-strictly 'forward-word))
(defalias 'forward-word-strictly #'forward-word))
(error nil)))
(eval-when-compile
@ -1483,48 +1483,48 @@ If set will become buffer local.")
(defvar verilog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map ";" 'electric-verilog-semi)
(define-key map [(control 59)] 'electric-verilog-semi-with-comment)
(define-key map ":" 'electric-verilog-colon)
(define-key map ";" #'electric-verilog-semi)
(define-key map [(control 59)] #'electric-verilog-semi-with-comment)
(define-key map ":" #'electric-verilog-colon)
;;(define-key map "=" 'electric-verilog-equal)
(define-key map "`" 'electric-verilog-tick)
(define-key map "\t" 'electric-verilog-tab)
(define-key map "\r" 'electric-verilog-terminate-line)
(define-key map "`" #'electric-verilog-tick)
(define-key map "\t" #'electric-verilog-tab)
(define-key map "\r" #'electric-verilog-terminate-line)
;; backspace/delete key bindings
(define-key map [backspace] 'backward-delete-char-untabify)
(define-key map [backspace] #'backward-delete-char-untabify)
(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
(define-key map [delete] 'delete-char)
(define-key map [(meta delete)] 'kill-word))
(define-key map "\M-\C-b" 'electric-verilog-backward-sexp)
(define-key map "\M-\C-f" 'electric-verilog-forward-sexp)
(define-key map "\M-\r" 'electric-verilog-terminate-and-indent)
(define-key map [delete] #'delete-char)
(define-key map [(meta delete)] #'kill-word))
(define-key map "\M-\C-b" #'electric-verilog-backward-sexp)
(define-key map "\M-\C-f" #'electric-verilog-forward-sexp)
(define-key map "\M-\r" #'electric-verilog-terminate-and-indent)
(define-key map "\M-\t" (if (fboundp 'completion-at-point)
'completion-at-point 'verilog-complete-word))
#'completion-at-point #'verilog-complete-word))
(define-key map "\M-?" (if (fboundp 'completion-help-at-point)
'completion-help-at-point 'verilog-show-completions))
#'completion-help-at-point #'verilog-show-completions))
;; Note \C-c and letter are reserved for users
(define-key map "\C-c`" 'verilog-lint-off)
(define-key map "\C-c*" 'verilog-delete-auto-star-implicit)
(define-key map "\C-c?" 'verilog-diff-auto)
(define-key map "\C-c\C-r" 'verilog-label-be)
(define-key map "\C-c\C-i" 'verilog-pretty-declarations)
(define-key map "\C-c=" 'verilog-pretty-expr)
(define-key map "\C-c\C-b" 'verilog-submit-bug-report)
(define-key map "\C-c/" 'verilog-star-comment)
(define-key map "\C-c\C-c" 'verilog-comment-region)
(define-key map "\C-c\C-u" 'verilog-uncomment-region)
(define-key map "\C-c`" #'verilog-lint-off)
(define-key map "\C-c*" #'verilog-delete-auto-star-implicit)
(define-key map "\C-c?" #'verilog-diff-auto)
(define-key map "\C-c\C-r" #'verilog-label-be)
(define-key map "\C-c\C-i" #'verilog-pretty-declarations)
(define-key map "\C-c=" #'verilog-pretty-expr)
(define-key map "\C-c\C-b" #'verilog-submit-bug-report)
(define-key map "\C-c/" #'verilog-star-comment)
(define-key map "\C-c\C-c" #'verilog-comment-region)
(define-key map "\C-c\C-u" #'verilog-uncomment-region)
(when (featurep 'xemacs)
(define-key map [(meta control h)] 'verilog-mark-defun)
(define-key map "\M-\C-a" 'verilog-beg-of-defun)
(define-key map "\M-\C-e" 'verilog-end-of-defun))
(define-key map "\C-c\C-d" 'verilog-goto-defun)
(define-key map "\C-c\C-k" 'verilog-delete-auto)
(define-key map "\C-c\C-a" 'verilog-auto)
(define-key map "\C-c\C-s" 'verilog-auto-save-compile)
(define-key map "\C-c\C-p" 'verilog-preprocess)
(define-key map "\C-c\C-z" 'verilog-inject-auto)
(define-key map "\C-c\C-e" 'verilog-expand-vector)
(define-key map "\C-c\C-h" 'verilog-header)
(define-key map [(meta control h)] #'verilog-mark-defun)
(define-key map "\M-\C-a" #'verilog-beg-of-defun)
(define-key map "\M-\C-e" #'verilog-end-of-defun))
(define-key map "\C-c\C-d" #'verilog-goto-defun)
(define-key map "\C-c\C-k" #'verilog-delete-auto)
(define-key map "\C-c\C-a" #'verilog-auto)
(define-key map "\C-c\C-s" #'verilog-auto-save-compile)
(define-key map "\C-c\C-p" #'verilog-preprocess)
(define-key map "\C-c\C-z" #'verilog-inject-auto)
(define-key map "\C-c\C-e" #'verilog-expand-vector)
(define-key map "\C-c\C-h" #'verilog-header)
map)
"Keymap used in Verilog mode.")
@ -1969,7 +1969,11 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
(unless (bolp) (insert "\n"))))
(defvar compile-command)
;; These are known to be from other packages and may not be defined
(defvar diff-command)
;; There are known to be from newer versions of Emacs
(defvar create-lockfiles) ; Emacs 24
(defvar which-func-modes)
;; compilation program
(defun verilog-set-compile-command ()
@ -2009,9 +2013,10 @@ portion, will be substituted."
(t
(set (make-local-variable 'compile-command)
(if verilog-tool
(if (string-match "%s" (eval verilog-tool))
(format (eval verilog-tool) (or buffer-file-name ""))
(concat (eval verilog-tool) " " (or buffer-file-name "")))
(let ((cmd (symbol-value verilog-tool)))
(if (string-match "%s" cmd)
(format cmd (or buffer-file-name ""))
(concat cmd " " (or buffer-file-name ""))))
""))))
(verilog-modify-compile-command))
@ -2098,7 +2103,7 @@ find the errors."
(interactive)
(when (boundp 'compilation-error-regexp-alist-alist)
(when (not (assoc 'verilog-xl-1 compilation-error-regexp-alist-alist))
(mapcar
(mapc
(lambda (item)
(push (car item) compilation-error-regexp-alist)
(push item compilation-error-regexp-alist-alist))
@ -5455,8 +5460,7 @@ becomes:
(let* ((code (match-string 2))
(file (match-string 3))
(line (match-string 4))
(buffer (get-file-buffer file))
dir filename)
(buffer (get-file-buffer file)))
(unless buffer
(progn
(setq buffer
@ -5468,9 +5472,8 @@ becomes:
(read-file-name
(format "Find this error in: (default %s) "
file)
dir file t))))
(if (file-directory-p name)
(setq name (expand-file-name filename name)))
nil ;; dir
file t))))
(setq buffer
(and (file-exists-p name)
(find-file-noselect name))))))))
@ -5613,12 +5616,11 @@ Save the result unless optional NO-SAVE is t."
;; Process the files
(mapc (lambda (buf)
(when (buffer-file-name buf)
(save-excursion
(if (not (file-exists-p (buffer-file-name buf)))
(error
"File not found: %s" (buffer-file-name buf)))
(message "Processing %s" (buffer-file-name buf))
(set-buffer buf)
(if (not (file-exists-p (buffer-file-name buf)))
(error
"File not found: %s" (buffer-file-name buf)))
(message "Processing %s" (buffer-file-name buf))
(with-current-buffer buf
(funcall funref)
(verilog-star-cleanup)
(when (and (not no-save)
@ -6648,14 +6650,9 @@ Return >0 for nested struct."
(defun verilog-at-close-struct-p ()
"If at the } that closes a struct, return true."
(if (and
(equal (char-after) ?\})
(verilog-in-struct-p))
;; true
(save-excursion
(if (looking-at "}\\(?:\\s-*\\w+\\s-*\\)?;") 1))
;; false
nil))
(and (equal (char-after) ?\})
(verilog-in-struct-p)
(looking-at "}\\(?:\\s-*\\w+\\s-*\\(?:,\\s-*\\w+\\s-*\\)*\\)?;")))
(defun verilog-parenthesis-depth ()
"Return non zero if in parenthetical-expression."
@ -6860,16 +6857,19 @@ Only look at a few lines to determine indent level."
(indent-line-to val)))
(t
(goto-char here)
(let ((val))
(verilog-beg-of-statement-1)
(if (and (< (point) here)
(verilog-re-search-forward "=[ \t]*" here 'move)
;; not at a |=>, #=#, or [=n] operator
(not (string-match "\\[=.\\|#=#\\||=>"
(or (buffer-substring (- (point) 2) (1+ (point)))
"")))) ; don't let buffer over/under-run spoil the party
(setq val (current-column))
(setq val (eval (cdr (assoc type verilog-indent-alist)))))
(verilog-beg-of-statement-1)
(let ((val
(if (and (< (point) here)
(verilog-re-search-forward "=[ \t]*" here 'move)
;; not at a |=>, #=#, or [=n] operator
(not (string-match "\\[=.\\|#=#\\||=>"
(or (buffer-substring
(- (point) 2) (1+ (point)))
;; Don't let buffer over/under
;; run spoil the party.
""))))
(current-column)
(eval (cdr (assoc type verilog-indent-alist))))))
(goto-char here)
(indent-line-to val))))))
@ -7305,7 +7305,8 @@ BASEIND is the base indent to offset everything."
(if (verilog-re-search-backward
(or (and verilog-indent-declaration-macros
verilog-declaration-re-1-macro)
verilog-declaration-re-1-no-macro) lim t)
verilog-declaration-re-1-no-macro)
lim t)
(progn
(goto-char (match-end 0))
(skip-chars-forward " \t")
@ -7423,9 +7424,7 @@ BEG and END."
;;
(defvar verilog-str nil)
(defvar verilog-all nil)
(defvar verilog-pred nil)
(defvar verilog-buffer-to-use nil)
(defvar verilog-flag nil)
(defvar verilog-toggle-completions nil
"True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
Repeated use of \\[verilog-complete-word] will show you all of them.
@ -7572,9 +7571,7 @@ TYPE is `module', `tf' for task or function, or t if unknown."
(while (verilog-re-search-forward verilog-str (point-max) t)
(progn (setq match (buffer-substring (match-beginning 2)
(match-end 2)))
(if (or (null verilog-pred)
(funcall verilog-pred match))
(setq verilog-all (cons match verilog-all)))))
(setq verilog-all (cons match verilog-all))))
(if (match-beginning 0)
(goto-char (match-beginning 0)))))
@ -7594,9 +7591,7 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(not (match-end 1)))
(setq match (buffer-substring (match-beginning 0) (match-end 0)))
(if (string-match (concat "\\<" verilog-str) match)
(if (or (null verilog-pred)
(funcall verilog-pred match))
(setq verilog-all (cons match verilog-all)))))
(setq verilog-all (cons match verilog-all))))
(forward-line 1)))
verilog-all)
@ -7611,28 +7606,25 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(defun verilog-keyword-completion (keyword-list)
"Give list of all possible completions of keywords in KEYWORD-LIST."
(mapcar (lambda (s)
(if (string-match (concat "\\<" verilog-str) s)
(if (or (null verilog-pred)
(funcall verilog-pred s))
(setq verilog-all (cons s verilog-all)))))
keyword-list))
(dolist (s keyword-list)
(if (string-match (concat "\\<" verilog-str) s)
(push s verilog-all))))
(defun verilog-completion (verilog-str verilog-pred verilog-flag)
"Function passed to `completing-read', `try-completion' or `all-completions'.
Called to get completion on VERILOG-STR. If VERILOG-PRED is non-nil, it
must be a function to be called for every match to check if this should
really be a match. If VERILOG-FLAG is t, the function returns a list of
all possible completions. If VERILOG-FLAG is nil it returns a string,
the longest possible completion, or t if VERILOG-STR is an exact match.
If VERILOG-FLAG is `lambda', the function returns t if VERILOG-STR is an
exact match, nil otherwise."
(save-excursion
(let ((verilog-all nil))
;; Set buffer to use for searching labels. This should be set
;; within functions which use verilog-completions
(set-buffer verilog-buffer-to-use)
(defun verilog-completion (str pred flag)
"Completion table for Verilog tokens.
Function passed to `completing-read', `try-completion' or `all-completions'.
Called to get completion on STR.
If FLAG is t, the function returns a list of all possible completions.
If FLAG is nil it returns a string, the longest possible completion,
or t if STR is an exact match.
If FLAG is `lambda', the function returns t if STR is an exact match,
nil otherwise."
(let ((verilog-str str)
(verilog-all nil))
;; Set buffer to use for searching labels. This should be set
;; within functions which use verilog-completions
(with-current-buffer verilog-buffer-to-use
;; Determine what should be completed
(let ((state (car (verilog-calculate-indent))))
@ -7674,43 +7666,47 @@ exact match, nil otherwise."
(verilog-keyword-completion verilog-separator-keywords))))
;; Now we have built a list of all matches. Give response to caller
(verilog-completion-response))))
(verilog--complete-with-action flag verilog-all verilog-str pred))))
(defun verilog-completion-response ()
(cond ((or (equal verilog-flag 'lambda) (null verilog-flag))
;; This was not called by all-completions
(if (null verilog-all)
;; Return nil if there was no matching label
nil
;; Get longest string common in the labels
;; FIXME: Why not use `try-completion'?
(let* ((elm (cdr verilog-all))
(match (car verilog-all))
(min (length match))
tmp)
(if (string= match verilog-str)
;; Return t if first match was an exact match
(setq match t)
(while (not (null elm))
;; Find longest common string
(if (< (setq tmp (verilog-string-diff match (car elm))) min)
(progn
(setq min tmp)
(setq match (substring match 0 min))))
;; Terminate with match=t if this is an exact match
(if (string= (car elm) verilog-str)
(progn
(setq match t)
(setq elm nil))
(setq elm (cdr elm)))))
;; If this is a test just for exact match, return nil ot t
(if (and (equal verilog-flag 'lambda) (not (equal match 't)))
nil
match))))
;; If flag is t, this was called by all-completions. Return
;; list of all possible completions
(verilog-flag
verilog-all)))
(defalias 'verilog--complete-with-action
(if (fboundp 'complete-with-action)
#'complete-with-action
(lambda (flag collection string _predicate)
(cond ((or (equal flag 'lambda) (null flag))
;; This was not called by all-completions
(if (null collection)
;; Return nil if there was no matching label
nil
;; Get longest string common in the labels
(let* ((elm (cdr collection))
(match (car collection))
(min (length match))
tmp)
(if (string= match string)
;; Return t if first match was an exact match
(setq match t)
(while (not (null elm))
;; Find longest common string
(if (< (setq tmp (verilog-string-diff match (car elm)))
min)
(progn
(setq min tmp)
(setq match (substring match 0 min))))
;; Terminate with match=t if this is an exact match
(if (string= (car elm) string)
(progn
(setq match t)
(setq elm nil))
(setq elm (cdr elm)))))
;; If this is a test just for exact match, return nil ot t
(if (and (equal flag 'lambda) (not (equal match 't)))
nil
match))))
;; If flag is t, this was called by all-completions. Return
;; list of all possible completions
(flag
collection)))))
(defvar verilog-last-word-numb 0)
(defvar verilog-last-word-shown nil)
@ -7728,7 +7724,7 @@ exact match, nil otherwise."
(allcomp (if (and verilog-toggle-completions
(string= verilog-last-word-shown verilog-str))
verilog-last-completions
(all-completions verilog-str 'verilog-completion))))
(all-completions verilog-str #'verilog-completion))))
(list b e allcomp)))
(defun verilog-complete-word ()
@ -7744,9 +7740,7 @@ and `verilog-separator-keywords'.)"
(verilog-str (buffer-substring b e))
(allcomp (nth 2 comp-info))
(match (if verilog-toggle-completions
"" (try-completion
verilog-str (mapcar (lambda (elm)
(cons elm 0)) allcomp)))))
"" (try-completion verilog-str allcomp))))
;; Delete old string
(delete-region b e)
@ -7818,39 +7812,38 @@ With optional second ARG non-nil, STR is the complete name of the instruction."
(setq str (concat str "[a-zA-Z0-9_]*")))
(concat "^\\s-*\\(function\\|task\\|module\\)[ \t]+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\(" str "\\)\\>"))
(defun verilog-comp-defun (verilog-str verilog-pred verilog-flag)
"Function passed to `completing-read', `try-completion' or `all-completions'.
Returns a completion on any function name based on VERILOG-STR prefix. If
VERILOG-PRED is non-nil, it must be a function to be called for every match
to check if this should really be a match. If VERILOG-FLAG is t, the
function returns a list of all possible completions. If it is nil it
returns a string, the longest possible completion, or t if VERILOG-STR is
an exact match. If VERILOG-FLAG is `lambda', the function returns t if
VERILOG-STR is an exact match, nil otherwise."
(save-excursion
(let ((verilog-all nil)
match)
(defun verilog-comp-defun (str pred flag)
"Completion table for function names.
Function passed to `completing-read', `try-completion' or `all-completions'.
Returns a completion on any function name based on STR prefix.
If FLAG is t, the function returns a list of all possible completions.
If it is nil it returns a string, the longest possible completion,
or t if STR is an exact match.
If FLAG is `lambda', the function returns t if STR is an exact match,
nil otherwise."
(let ((verilog-all nil)
(verilog-str str)
match)
;; Set buffer to use for searching labels. This should be set
;; within functions which use verilog-completions
(set-buffer verilog-buffer-to-use)
;; Set buffer to use for searching labels. This should be set
;; within functions which use verilog-completions
(with-current-buffer verilog-buffer-to-use
(let ((verilog-str verilog-str))
;; Build regular expression for functions
(if (string= verilog-str "")
(setq verilog-str (verilog-build-defun-re "[a-zA-Z_]"))
(setq verilog-str (verilog-build-defun-re verilog-str)))
(setq verilog-str
(verilog-build-defun-re (if (string= verilog-str "")
"[a-zA-Z_]"
verilog-str)))
(goto-char (point-min))
;; Build a list of all possible completions
(while (verilog-re-search-forward verilog-str nil t)
(setq match (buffer-substring (match-beginning 2) (match-end 2)))
(if (or (null verilog-pred)
(funcall verilog-pred match))
(setq verilog-all (cons match verilog-all)))))
(setq verilog-all (cons match verilog-all))))
;; Now we have built a list of all matches. Give response to caller
(verilog-completion-response))))
(verilog--complete-with-action flag verilog-all verilog-str pred))))
(defun verilog-goto-defun ()
"Move to specified Verilog module/interface/task/function.
@ -7865,10 +7858,10 @@ If search fails, other files are checked based on
;; Do completion with default
(completing-read (concat "Goto-Label: (default "
default ") ")
'verilog-comp-defun nil nil "")
#'verilog-comp-defun nil nil "")
;; There is no default value. Complete without it
(completing-read "Goto-Label: "
'verilog-comp-defun nil nil "")))
#'verilog-comp-defun nil nil "")))
pt)
;; Make sure library paths are correct, in case need to resolve module
(verilog-auto-reeval-locals)
@ -7927,10 +7920,9 @@ If search fails, other files are checked based on
(tag (format "%3d" linenum))
(empty (make-string (length tag) ?\ ))
tem)
(save-excursion
(setq tem (make-marker))
(set-marker tem (point))
(set-buffer standard-output)
(setq tem (make-marker))
(set-marker tem (point))
(with-current-buffer standard-output
(setq occur-pos-list (cons tem occur-pos-list))
(or first (zerop nlines)
(insert "--------\n"))
@ -8648,11 +8640,6 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(defvar sigs-out-i)
(defvar sigs-out-unk)
(defvar sigs-temp)
;; These are known to be from other packages and may not be defined
(defvar diff-command)
;; There are known to be from newer versions of Emacs
(defvar create-lockfiles)
(defvar which-func-modes)
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
@ -10099,7 +10086,7 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
;; Namespace intentionally short for AUTOs and compatibility
(let ((val (eval (intern (concat "vh-" symbol)))))
(let ((val (symbol-value (intern (concat "vh-" symbol)))))
(if (eq val nil)
(if wing-it symbol nil)
val))
@ -10138,7 +10125,7 @@ This function is intended for use in AUTO_TEMPLATE Lisp expressions."
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
;; Namespace intentionally short for AUTOs and compatibility
(setq val (eval (intern (concat "vh-" symbol)))))
(setq val (symbol-value (intern (concat "vh-" symbol)))))
(setq text (replace-match val nil nil text)))
(t (setq ok nil)))))
text)
@ -10493,7 +10480,7 @@ those clocking block's signals."
;; New scheme
;; Namespace intentionally short for AUTOs and compatibility
(let* ((enumvar (intern (concat "venum-" enum))))
(dolist (en (and (boundp enumvar) (eval enumvar)))
(dolist (en (and (boundp enumvar) (symbol-value enumvar)))
(let ((sig (list en)))
(unless (member sig out-list)
(push sig out-list)))))
@ -10698,9 +10685,7 @@ When MODI is non-null, also add to modi-cache, for tracking."
(verilog-insert "// " (verilog-sig-comment sig) "\n"))
(setq sigs (cdr sigs)))))
(defvar indent-pt) ;; Local used by `verilog-insert-indent'.
(defun verilog-insert-indent (&rest stuff)
(defun verilog--insert-indent (indent-pt &rest stuff)
"Indent to position stored in local `indent-pt' variable, then insert STUFF.
Presumes that any newlines end a list element."
(let ((need-indent t))
@ -10710,6 +10695,10 @@ Presumes that any newlines end a list element."
(verilog-insert (car stuff))
(setq need-indent (string-match "\n$" (car stuff))
stuff (cdr stuff)))))
(defmacro verilog-insert-indent (&rest stuff)
`(verilog--insert-indent indent-pt ,@stuff))
;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
(defun verilog-forward-or-insert-line ()
@ -11518,7 +11507,8 @@ See the example in `verilog-auto-inout-modport'."
(inst-name (nth 2 params))
(regexp (nth 3 params))
(prefix (nth 4 params))
direction-re submodi) ; direction argument not supported until requested
;; direction-re ; direction argument not supported until requested
submodi)
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
@ -11539,11 +11529,11 @@ See the example in `verilog-auto-inout-modport'."
(setq sig-list-i (verilog-signals-edit-wire-reg
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
"input" direction-re))
"input" nil)) ;; direction-re
sig-list-o (verilog-signals-edit-wire-reg
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
"output" direction-re)))
"output" nil))) ;; direction-re
(setq sig-list-i (sort (copy-alist sig-list-i) #'verilog-signals-sort-compare))
(setq sig-list-o (sort (copy-alist sig-list-o) #'verilog-signals-sort-compare))
(when (or sig-list-i sig-list-o)
@ -11684,7 +11674,7 @@ If PAR-VALUES replace final strings with these parameter values."
(setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
;; Insert it
(when (or tpl-ass (not verilog-auto-inst-template-required))
(verilog-auto-inst-first section)
(verilog--auto-inst-first indent-pt section)
(indent-to indent-pt)
(insert "." port)
(unless (and verilog-auto-inst-dot-name
@ -11723,7 +11713,7 @@ If PAR-VALUES replace final strings with these parameter values."
(defvar verilog-auto-inst-first-any nil
"Local first-in-any-section for `verilog-auto-inst-first'.")
(defun verilog-auto-inst-first (section)
(defun verilog--auto-inst-first (indent-pt section)
"Insert , and SECTION before port, as part of \\[verilog-auto-inst]."
;; Do we need a trailing comma?
;; There maybe an ifdef or something similar before us. What a mess. Thus
@ -12957,21 +12947,25 @@ that expression are included."
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
"input" direction-re) not-re))
"input" direction-re)
not-re))
sig-list-o (verilog-signals-edit-wire-reg
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
"output" direction-re) not-re))
"output" direction-re)
not-re))
sig-list-io (verilog-signals-edit-wire-reg
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-io regexp)
"inout" direction-re) not-re))
"inout" direction-re)
not-re))
sig-list-if (verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-if regexp)
"interface" direction-re) not-re))
"interface" direction-re)
not-re))
(when v2k (verilog-repair-open-comma))
(when (or sig-list-i sig-list-o sig-list-io sig-list-if)
(verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
@ -13257,7 +13251,8 @@ driver/monitor using AUTOINST in the testbench."
(modport-re (nth 1 params))
(regexp (nth 2 params))
(prefix (nth 3 params))
direction-re submodi) ; direction argument not supported until requested
;; direction-re ; direction argument not supported until requested
submodi)
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
@ -13288,7 +13283,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
"input" direction-re)
"input" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls)))
sig-list-o (verilog-signals-edit-wire-reg
@ -13296,7 +13291,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
"output" direction-re)
"output" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls)))
sig-list-io (verilog-signals-edit-wire-reg
@ -13304,7 +13299,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-io regexp)
"inout" direction-re)
"inout" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls))))
(when v2k (verilog-repair-open-comma))
@ -14275,37 +14270,37 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(defvar verilog-template-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'verilog-sk-always)
(define-key map "b" 'verilog-sk-begin)
(define-key map "c" 'verilog-sk-case)
(define-key map "f" 'verilog-sk-for)
(define-key map "g" 'verilog-sk-generate)
(define-key map "h" 'verilog-sk-header)
(define-key map "i" 'verilog-sk-initial)
(define-key map "j" 'verilog-sk-fork)
(define-key map "m" 'verilog-sk-module)
(define-key map "o" 'verilog-sk-ovm-class)
(define-key map "p" 'verilog-sk-primitive)
(define-key map "r" 'verilog-sk-repeat)
(define-key map "s" 'verilog-sk-specify)
(define-key map "t" 'verilog-sk-task)
(define-key map "u" 'verilog-sk-uvm-object)
(define-key map "w" 'verilog-sk-while)
(define-key map "x" 'verilog-sk-casex)
(define-key map "z" 'verilog-sk-casez)
(define-key map "?" 'verilog-sk-if)
(define-key map ":" 'verilog-sk-else-if)
(define-key map "/" 'verilog-sk-comment)
(define-key map "A" 'verilog-sk-assign)
(define-key map "F" 'verilog-sk-function)
(define-key map "I" 'verilog-sk-input)
(define-key map "O" 'verilog-sk-output)
(define-key map "S" 'verilog-sk-state-machine)
(define-key map "=" 'verilog-sk-inout)
(define-key map "U" 'verilog-sk-uvm-component)
(define-key map "W" 'verilog-sk-wire)
(define-key map "R" 'verilog-sk-reg)
(define-key map "D" 'verilog-sk-define-signal)
(define-key map "a" #'verilog-sk-always)
(define-key map "b" #'verilog-sk-begin)
(define-key map "c" #'verilog-sk-case)
(define-key map "f" #'verilog-sk-for)
(define-key map "g" #'verilog-sk-generate)
(define-key map "h" #'verilog-sk-header)
(define-key map "i" #'verilog-sk-initial)
(define-key map "j" #'verilog-sk-fork)
(define-key map "m" #'verilog-sk-module)
(define-key map "o" #'verilog-sk-ovm-class)
(define-key map "p" #'verilog-sk-primitive)
(define-key map "r" #'verilog-sk-repeat)
(define-key map "s" #'verilog-sk-specify)
(define-key map "t" #'verilog-sk-task)
(define-key map "u" #'verilog-sk-uvm-object)
(define-key map "w" #'verilog-sk-while)
(define-key map "x" #'verilog-sk-casex)
(define-key map "z" #'verilog-sk-casez)
(define-key map "?" #'verilog-sk-if)
(define-key map ":" #'verilog-sk-else-if)
(define-key map "/" #'verilog-sk-comment)
(define-key map "A" #'verilog-sk-assign)
(define-key map "F" #'verilog-sk-function)
(define-key map "I" #'verilog-sk-input)
(define-key map "O" #'verilog-sk-output)
(define-key map "S" #'verilog-sk-state-machine)
(define-key map "=" #'verilog-sk-inout)
(define-key map "U" #'verilog-sk-uvm-component)
(define-key map "W" #'verilog-sk-wire)
(define-key map "R" #'verilog-sk-reg)
(define-key map "D" #'verilog-sk-define-signal)
map)
"Keymap used in Verilog mode for smart template operations.")
@ -14696,13 +14691,13 @@ and the case items."
(let ((map (make-sparse-keymap))) ; as described in info pages, make a map
(set-keymap-parent map verilog-mode-map)
;; mouse button bindings
(define-key map "\r" 'verilog-load-file-at-point)
(define-key map "\r" #'verilog-load-file-at-point)
(define-key map
(if (featurep 'xemacs) 'button2 [mouse-2])
#'verilog-load-file-at-mouse)
(if (featurep 'xemacs)
(define-key map 'button2 'verilog-load-file-at-mouse);ffap-at-mouse ?
(define-key map [mouse-2] 'verilog-load-file-at-mouse))
(if (featurep 'xemacs)
(define-key map 'Sh-button2 'mouse-yank) ; you wanna paste don't you ?
(define-key map [S-mouse-2] 'mouse-yank-at-click))
(define-key map 'Sh-button2 #'mouse-yank) ; you wanna paste don't you ?
(define-key map [S-mouse-2] #'mouse-yank-at-click))
map)
"Map containing mouse bindings for `verilog-mode'.")
@ -14775,7 +14770,7 @@ Clicking on the middle-mouse button loads them in a buffer (as in dired)."
(verilog-highlight-region (point-min) (point-max) nil))
;; Deprecated, but was interactive, so we'll keep it around
(defalias 'verilog-colorize-include-files-buffer 'verilog-highlight-buffer)
(defalias 'verilog-colorize-include-files-buffer #'verilog-highlight-buffer)
;; ffap-at-mouse isn't useful for Verilog mode. It uses library paths.
;; so define this function to do more or less the same as ffap-at-mouse

3
lisp/recentf.el
View file

@ -33,9 +33,6 @@
;; To enable this package, add the following to your .emacs:
;; (recentf-mode 1)
;;; History:
;;
;;; Code:
(require 'tree-widget)
(require 'timer)

3
lisp/ruler-mode.el
View file

@ -100,10 +100,7 @@
;; To automatically display the ruler in specific major modes use:
;;
;; (add-hook '<major-mode>-hook 'ruler-mode)
;;
;;; History:
;;
;;; Code:
(eval-when-compile

21
lisp/scroll-all.el
View file

@ -1,4 +1,4 @@
;;; scroll-all.el --- scroll all buffers together minor mode
;;; scroll-all.el --- scroll all buffers together minor mode -*- lexical-binding: t -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
@ -47,38 +47,41 @@
(condition-case nil
(funcall func arg)
;; Ignore beginning- or end-of-buffer error in other windows.
(error nil)
)
(error nil))
(other-window 1)
(setq count (1+ count))))))
(defun scroll-all-scroll-down-all (arg)
"Scroll down in all visible windows."
"Scroll down ARG lines in all visible windows."
(interactive "p")
(scroll-all-function-all 'next-line arg))
(defun scroll-all-scroll-up-all (arg)
"Scroll up in all visible windows."
"Scroll up ARG lines in all visible windows."
(interactive "p")
(scroll-all-function-all 'previous-line arg))
(defun scroll-all-page-down-all (arg)
"Page down in all visible windows."
"Page down in all visible windows.
ARG is like in `scroll-up'."
(interactive "P")
(scroll-all-function-all 'scroll-up arg))
(defun scroll-all-page-up-all (arg)
"Page up in all visible windows."
"Page up in all visible windows.
ARG is like in `scroll-down'."
(interactive "P")
(scroll-all-function-all 'scroll-down arg))
(defun scroll-all-beginning-of-buffer-all (arg)
"Go to the beginning of the buffer in all visible windows."
"Go to the beginning of the buffer in all visible windows.
ARG is like in `beginning-of-buffer'."
(interactive "P")
(scroll-all-function-all 'beginning-of-buffer arg))
(defun scroll-all-end-of-buffer-all (arg)
"Go to the end of the buffer in all visible windows."
"Go to the end of the buffer in all visible windows.
ARG is like in `end-of-buffer'."
(interactive "P")
(scroll-all-function-all 'end-of-buffer arg))

11
lisp/simple.el
View file

@ -2005,9 +2005,14 @@ This function uses the `read-extended-command-predicate' user option."
(complete-with-action action obarray string pred)))
(lambda (sym)
(and (commandp sym)
(or (null read-extended-command-predicate)
(and (functionp read-extended-command-predicate)
(funcall read-extended-command-predicate sym buffer)))))
(cond ((null read-extended-command-predicate))
((functionp read-extended-command-predicate)
;; Don't let bugs break M-x completion; interpret
;; them as the absence of a predicate.
(condition-case-unless-debug err
(funcall read-extended-command-predicate sym buffer)
(error (message "read-extended-command-predicate: %s: %s"
sym (error-message-string err))))))))
t nil 'extended-command-history))))
(defun command-completion-using-modes-p (symbol buffer)

3
lisp/term/w32-win.el
View file

@ -556,6 +556,9 @@ be found in this alist.
This alist is used by w32font.c when it looks for fonts that can display
characters from scripts for which no USBs are defined.")
(declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width))
(defun w32-find-non-USB-fonts (&optional frame size)
"Compute the value of `w32-non-USB-fonts' for specified SIZE and FRAME.
FRAME defaults to the selected frame.

14
lisp/textmodes/reftex-auc.el
View file

@ -32,11 +32,12 @@
(optional prompt default &optional complete))
(declare-function TeX-argument-insert "ext:tex"
(name optional &optional prefix))
(declare-function LaTeX-add-labels "ext:tex" (&rest entries) t)
(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t)
(declare-function LaTeX-bibitem-list "ext:tex" () t)
(declare-function LaTeX-index-entry-list "ext:tex" () t)
(declare-function LaTeX-label-list "ext:tex" () t)
(declare-function LaTeX-add-labels "ext:latex" (&rest labels) t)
(declare-function LaTeX-add-index-entries "ext:latex" (&rest index-entries) t)
(declare-function LaTeX-add-bibitems "ext:latex" (&rest bibitems) t)
(declare-function LaTeX-bibitem-list "ext:latex" () t)
(declare-function LaTeX-index-entry-list "ext:latex" () t)
(declare-function LaTeX-label-list "ext:latex" () t)
(declare-function multi-prompt "ext:multi-prompt"
(separator unique prompt table &optional
mp-predicate require-match initial history))
@ -69,8 +70,6 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
(LaTeX-add-labels label))
(TeX-argument-insert label optional)))
(declare-function LaTeX-add-bibitems "latex") ;FIXME: Can't find the definition
;;;###autoload
(defun reftex-arg-cite (optional &optional prompt definition)
"Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument.
@ -88,7 +87,6 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
(TeX-argument-insert (mapconcat #'identity items reftex-cite-key-separator)
optional)))
;;;###autoload
(defun reftex-arg-index-tag (optional &optional prompt &rest _args)
"Prompt for an index tag with completion.

2
lisp/textmodes/remember.el
View file

@ -176,8 +176,6 @@
;;
;; 2003.08.12 Sacha's birthday
;;; History:
;;; Code:
(defconst remember-version "2.0"

3
lisp/thumbs.el
View file

@ -51,9 +51,6 @@
;; In thumbs-mode, pressing <return> on an image will bring you in image view
;; mode for that image. C-h m will give you a list of available keybinding.
;;; History:
;;
;;; Code:
(require 'dired)

4
lisp/tree-widget.el
View file

@ -110,10 +110,8 @@
;; `tree-widget-themes-directory', and `tree-widget-theme' options for
;; more details.
;;; History:
;;
;;; Code:
(require 'wid-edit)
;;; Customization

10
lisp/userlock.el
View file

@ -224,4 +224,14 @@ to get the latest version of the file, then make the change again."
revert-buffer-binding))
(help-mode)))))
;;;###autoload
(defun userlock--handle-unlock-error (error)
"Report an ERROR that occurred while unlocking a file."
(display-warning
'(unlock-file)
;; There is no need to explain that this is an unlock error because
;; ERR is a `file-error' condition, which explains this.
(message "%s, ignored" (error-message-string error))
:warning))
;;; userlock.el ends here

3
lisp/vc/vc-hg.el
View file

@ -97,9 +97,6 @@
;; without even using `hg' (this way even if you don't have `hg' installed,
;; Emacs is able to tell you this file is under mercurial's control).
;;; History:
;;
;;; Code:
(require 'cl-lib)

269
lisp/wdired.el
View file

@ -172,6 +172,7 @@ nonexistent directory will fail."
(define-key map [remap upcase-word] #'wdired-upcase-word)
(define-key map [remap capitalize-word] #'wdired-capitalize-word)
(define-key map [remap downcase-word] #'wdired-downcase-word)
(define-key map [remap self-insert-command] #'wdired--self-insert)
map)
"Keymap used in `wdired-mode'.")
@ -188,10 +189,11 @@ nonexistent directory will fail."
"Hooks run when changing to WDired mode.")
;; Local variables (put here to avoid compilation gripes)
(defvar wdired-col-perm) ;; Column where the permission bits start
(defvar wdired-old-content)
(defvar wdired-old-point)
(defvar wdired-old-marks)
(defvar wdired--perm-beg) ;; Column where the permission bits start
(defvar wdired--perm-end) ;; Column where the permission bits stop
(defvar wdired--old-content)
(defvar wdired--old-point)
(defvar wdired--old-marks)
(defun wdired-mode ()
"Writable Dired (WDired) mode.
@ -230,11 +232,12 @@ See `wdired-mode'."
(interactive)
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
(setq-local wdired-old-content
(setq-local wdired--old-content
(buffer-substring (point-min) (point-max)))
(setq-local wdired-old-marks
(setq-local wdired--old-marks
(dired-remember-marks (point-min) (point-max)))
(setq-local wdired-old-point (point))
(setq-local wdired--old-point (point))
(wdired--set-permission-bounds)
(setq-local query-replace-skip-read-only t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
@ -243,20 +246,11 @@ See `wdired-mode'."
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
(add-hook 'kill-buffer-hook #'wdired-check-kill-buffer nil t)
(add-hook 'before-change-functions #'wdired--before-change-fn nil t)
(add-hook 'after-change-functions #'wdired--restore-properties nil t)
(setq major-mode 'wdired-mode)
(setq mode-name "Editable Dired")
(add-function :override (local 'revert-buffer-function) #'wdired-revert)
;; I temp disable undo for performance: since I'm going to clear the
;; undo list, it can save more than a 9% of time with big
;; directories because setting properties modify the undo-list.
(buffer-disable-undo)
(wdired-preprocess-files)
(if wdired-allow-to-change-permissions
(wdired-preprocess-perms))
(if (fboundp 'make-symbolic-link)
(wdired-preprocess-symlinks))
(buffer-enable-undo) ; Performance hack. See above.
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-mode-hooks 'wdired-mode-hook)
@ -264,6 +258,63 @@ See `wdired-mode'."
"Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))
(defun wdired--set-permission-bounds ()
(save-excursion
(goto-char (point-min))
(if (not (re-search-forward dired-re-perms nil t 1))
(progn
(setq-local wdired--perm-beg nil)
(setq-local wdired--perm-end nil))
(goto-char (match-beginning 0))
;; Add 1 since the first char matched by `dired-re-perms' is the
;; one describing the nature of the entry (dir/symlink/...) rather
;; than its permissions.
(setq-local wdired--perm-beg (1+ (wdired--current-column)))
(goto-char (match-end 0))
(setq-local wdired--perm-end (wdired--current-column)))))
(defun wdired--current-column ()
(- (point) (line-beginning-position)))
(defun wdired--point-at-perms-p ()
(and wdired--perm-beg
(<= wdired--perm-beg (wdired--current-column) wdired--perm-end)))
(defun wdired--line-preprocessed-p ()
(get-text-property (line-beginning-position) 'front-sticky))
(defun wdired--self-insert ()
(interactive)
(if (wdired--line-preprocessed-p)
(call-interactively 'self-insert-command)
(wdired--before-change-fn (point) (point))
(let* ((map (get-text-property (point) 'keymap)))
(call-interactively (or (if map (lookup-key map (this-command-keys)))
#'self-insert-command)))))
(defun wdired--before-change-fn (beg end)
(save-excursion
;; Make sure to process entire lines.
(goto-char end)
(setq end (line-end-position))
(goto-char beg)
(forward-line 0)
(while (< (point) end)
(unless (wdired--line-preprocessed-p)
(with-silent-modifications
(put-text-property (point) (1+ (point)) 'front-sticky t)
(wdired--preprocess-files)
(when wdired-allow-to-change-permissions
(wdired--preprocess-perms))
(when (fboundp 'make-symbolic-link)
(wdired--preprocess-symlinks))))
(forward-line))
(when (eobp)
(with-silent-modifications
;; Is this good enough? Assumes no extra white lines from dired.
(put-text-property (1- (point-max)) (point-max) 'read-only t)))))
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
(not (text-property-not-all (min beg end) (max beg end)
@ -271,35 +322,28 @@ or \\[wdired-abort-changes] to abort changes")))
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
(defun wdired-preprocess-files ()
(put-text-property (point-min) (1+ (point-min))'front-sticky t)
(defun wdired--preprocess-files ()
(save-excursion
(goto-char (point-min))
(let ((b-protection (point))
(used-F (dired-check-switches dired-actual-switches "F" "classify"))
filename)
(while (not (eobp))
(setq filename (dired-get-filename nil t))
(when (and filename
(not (member (file-name-nondirectory filename) '("." ".."))))
(dired-move-to-filename)
;; The rear-nonsticky property below shall ensure that text preceding
;; the filename can't be modified.
(add-text-properties
(1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
(put-text-property b-protection (point) 'read-only t)
(dired-move-to-end-of-filename t)
(put-text-property (point) (1+ (point)) 'end-name t))
(when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
(when (save-excursion
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
(search-forward " -> " (line-end-position) t)))
(goto-char (line-end-position)))
(setq b-protection (point))
(forward-line))
(put-text-property b-protection (point-max) 'read-only t))))
(let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
(beg (point))
(filename (dired-get-filename nil t)))
(when (and filename
(not (member (file-name-nondirectory filename) '("." ".."))))
(dired-move-to-filename)
;; The rear-nonsticky property below shall ensure that text preceding
;; the filename can't be modified.
(add-text-properties
(1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
(put-text-property beg (point) 'read-only t)
(dired-move-to-end-of-filename t)
(put-text-property (point) (1+ (point)) 'end-name t))
(when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
(when (save-excursion
(and (re-search-backward
dired-permission-flags-regexp nil t)
(looking-at "l")
(search-forward " -> " (line-end-position) t)))
(goto-char (line-end-position))))))
;; This code is a copy of some dired-get-filename lines.
(defsubst wdired-normalize-filename (file unquotep)
@ -326,6 +370,7 @@ non-nil means return old filename."
;; FIXME: Use dired-get-filename's new properties.
(let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
beg end file)
(wdired--before-change-fn (point) (point))
(save-excursion
(setq end (line-end-position))
(beginning-of-line)
@ -362,7 +407,6 @@ non-nil means return old filename."
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
(defun wdired-change-to-dired-mode ()
"Change the mode back to dired."
(or (eq major-mode 'wdired-mode)
@ -380,16 +424,18 @@ non-nil means return old filename."
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
(remove-hook 'before-change-functions #'wdired--before-change-fn t)
(remove-hook 'after-change-functions #'wdired--restore-properties t)
(remove-function (local 'revert-buffer-function) #'wdired-revert))
(defun wdired-abort-changes ()
"Abort changes and return to dired mode."
(interactive)
(remove-hook 'before-change-functions #'wdired--before-change-fn t)
(let ((inhibit-read-only t))
(erase-buffer)
(insert wdired-old-content)
(goto-char wdired-old-point))
(insert wdired--old-content)
(goto-char wdired--old-point))
(wdired-change-to-dired-mode)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
@ -411,13 +457,14 @@ non-nil means return old filename."
(setq errors (cdr tmp-value))
(setq changes (car tmp-value)))
(when (and wdired-allow-to-change-permissions
(boundp 'wdired-col-perm)) ; could have been changed
wdired--perm-beg) ; could have been changed
(setq tmp-value (wdired-do-perm-changes))
(setq errors (+ errors (cdr tmp-value)))
(setq changes (or changes (car tmp-value))))
(goto-char (point-max))
(while (not (bobp))
(setq file-old (wdired-get-filename nil t))
(setq file-old (and (wdired--line-preprocessed-p)
(wdired-get-filename nil t)))
(when file-old
(setq file-new (wdired-get-filename))
(if (equal file-new file-old)
@ -429,11 +476,11 @@ non-nil means return old filename."
(let ((mark (cond ((integerp wdired-keep-marker-rename)
wdired-keep-marker-rename)
(wdired-keep-marker-rename
(cdr (assoc file-old wdired-old-marks)))
(cdr (assoc file-old wdired--old-marks)))
(t nil))))
(when mark
(push (cons (substitute-in-file-name file-new) mark)
wdired-old-marks))))
wdired--old-marks))))
(push (cons file-old (substitute-in-file-name file-new))
files-renamed))))
(forward-line -1)))
@ -458,7 +505,7 @@ non-nil means return old filename."
;; Re-sort the buffer.
(revert-buffer)
(let ((inhibit-read-only t))
(dired-mark-remembered wdired-old-marks)))
(dired-mark-remembered wdired--old-marks)))
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max)
'(old-name nil end-name nil old-link nil
@ -702,21 +749,17 @@ says how many lines to move; default is one line."
(dired-move-to-filename)))
;; Put the needed properties to allow the user to change links' targets
(defun wdired-preprocess-symlinks ()
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(when (looking-at dired-re-sym)
(re-search-forward " -> \\(.*\\)$")
(put-text-property (1- (match-beginning 1))
(match-beginning 1) 'old-link
(match-string-no-properties 1))
(put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
(unless wdired-allow-to-redirect-links
(put-text-property (match-beginning 0)
(match-end 1) 'read-only t)))
(forward-line)))))
(defun wdired--preprocess-symlinks ()
(save-excursion
(when (looking-at dired-re-sym)
(re-search-forward " -> \\(.*\\)$")
(put-text-property (1- (match-beginning 1))
(match-beginning 1) 'old-link
(match-string-no-properties 1))
(put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
(unless wdired-allow-to-redirect-links
(put-text-property (match-beginning 0)
(match-end 1) 'read-only t)))))
(defun wdired-get-previous-link (&optional old move)
"Return the next symlink target.
@ -800,7 +843,6 @@ Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'capitalize-word arg))
;; The following code deals with changing the access bits (or
;; permissions) of the files.
@ -822,34 +864,28 @@ Like original function but it skips read-only words."
;; Put a keymap property to the permission bits of the files, and store the
;; original name and permissions as a property
(defun wdired-preprocess-perms ()
(let ((inhibit-read-only t))
(setq-local wdired-col-perm nil)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(when (and (not (looking-at dired-re-sym))
(wdired-get-filename)
(re-search-forward dired-re-perms (line-end-position) 'eol))
(let ((begin (match-beginning 0))
(end (match-end 0)))
(unless wdired-col-perm
(setq wdired-col-perm (- (current-column) 9)))
(if (eq wdired-allow-to-change-permissions 'advanced)
(progn
(put-text-property begin end 'read-only nil)
;; make first permission bit writable
(put-text-property
(1- begin) begin 'rear-nonsticky '(read-only)))
;; avoid that keymap applies to text following permissions
(add-text-properties
(1+ begin) end
`(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
(put-text-property end (1+ end) 'end-perm t)
(put-text-property
begin (1+ begin) 'old-perm (match-string-no-properties 0))))
(forward-line)
(beginning-of-line)))))
(defun wdired--preprocess-perms ()
(save-excursion
(when (and (not (looking-at dired-re-sym))
(wdired-get-filename)
(re-search-forward dired-re-perms
(line-end-position) 'eol))
(let ((begin (match-beginning 0))
(end (match-end 0)))
(if (eq wdired-allow-to-change-permissions 'advanced)
(progn
(put-text-property begin end 'read-only nil)
;; make first permission bit writable
(put-text-property
(1- begin) begin 'rear-nonsticky '(read-only)))
;; avoid that keymap applies to text following permissions
(add-text-properties
(1+ begin) end
`(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
(put-text-property end (1+ end) 'end-perm t)
(put-text-property
begin (1+ begin)
'old-perm (match-string-no-properties 0))))))
(defun wdired-perm-allowed-in-pos (char pos)
(cond
@ -861,39 +897,30 @@ Like original function but it skips read-only words."
((memq char '(?t ?T)) (= pos 8))
((= char ?l) (= pos 5))))
(defun wdired-set-bit ()
(defun wdired-set-bit (&optional char)
"Set a permission bit character."
(interactive)
(if (wdired-perm-allowed-in-pos last-command-event
(- (current-column) wdired-col-perm))
(let ((new-bit (char-to-string last-command-event))
(interactive (list last-command-event))
(unless char (setq char last-command-event))
(if (wdired-perm-allowed-in-pos char
(- (wdired--current-column) wdired--perm-beg))
(let ((new-bit (char-to-string char))
(inhibit-read-only t)
(pos-prop (- (point) (- (current-column) wdired-col-perm))))
(put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
(put-text-property 0 1 'read-only t new-bit)
(pos-prop (+ (line-beginning-position) wdired--perm-beg)))
(set-text-properties 0 1 (text-properties-at (point)) new-bit)
(insert new-bit)
(delete-char 1)
(put-text-property (1- pos-prop) pos-prop 'perm-changed t)
(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
(put-text-property (1- pos-prop) pos-prop 'perm-changed t))
(forward-char 1)))
(defun wdired-toggle-bit ()
"Toggle the permission bit at point."
(interactive)
(let ((inhibit-read-only t)
(new-bit "-")
(pos-prop (- (point) (- (current-column) wdired-col-perm))))
(if (eq (char-after (point)) ?-)
(setq new-bit
(if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
(if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
"x"))))
(put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
(put-text-property 0 1 'read-only t new-bit)
(insert new-bit)
(delete-char 1)
(put-text-property (1- pos-prop) pos-prop 'perm-changed t)
(put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
(wdired-set-bit
(cond
((not (eq (char-after (point)) ?-)) ?-)
((= (% (- (wdired--current-column) wdired--perm-beg) 3) 0) ?r)
((= (% (- (wdired--current-column) wdired--perm-beg) 3) 1) ?w)
(t ?x))))
(defun wdired-mouse-toggle-bit (event)
"Toggle the permission bit that was left clicked."

211
lisp/woman.el
View file

@ -1,4 +1,4 @@
;;; woman.el --- browse UN*X manual pages `wo (without) man'
;;; woman.el --- browse UN*X manual pages `wo (without) man' -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -388,6 +388,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(defvar woman-version "0.551 (beta)" "WoMan version information.")
(make-obsolete-variable 'woman-version nil "28.1")
@ -418,14 +420,14 @@ As a special case, if PATHS is nil then replace it by calling
;; an empty substring of MANPATH denotes the default list.
(if (memq system-type '(windows-nt ms-dos))
(cond ((null paths)
(mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
(mapcar #'woman-Cyg-to-Win (woman-parse-man.conf)))
((string-match-p ";" paths)
;; Assume DOS-style path-list...
(mapcan ; splice list into list
(lambda (x)
(if x
(list x)
(mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))))
(mapcar #'woman-Cyg-to-Win (woman-parse-man.conf))))
(parse-colon-path paths)))
((string-match-p "\\`[a-zA-Z]:" paths)
;; Assume single DOS-style path...
@ -434,7 +436,7 @@ As a special case, if PATHS is nil then replace it by calling
;; Assume UNIX/Cygwin-style path-list...
(mapcan ; splice list into list
(lambda (x)
(mapcar 'woman-Cyg-to-Win
(mapcar #'woman-Cyg-to-Win
(if x (list x) (woman-parse-man.conf))))
(let ((path-separator ":"))
(parse-colon-path paths)))))
@ -509,7 +511,7 @@ Change only via `Customization' or the function `add-hook'."
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
(cond ((eq system-type 'windows-nt)
(mapcar 'woman-Cyg-to-Win path))
(mapcar #'woman-Cyg-to-Win path))
((eq system-type 'darwin)
(cons "/usr/share/misc" path))
(t path)))
@ -809,7 +811,7 @@ in the ncurses package include `toe.1m', `form.3x', etc.
Note: an optional compression regexp will be appended, so this regexp
MUST NOT end with any kind of string terminator such as $ or \\\\='."
:type 'regexp
:set 'set-woman-file-regexp
:set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-file-compression-regexp
@ -825,7 +827,7 @@ Should begin with \\. and end with \\\\=' and MUST NOT be optional."
;; not loaded by default!
:version "24.1" ; added xz
:type 'regexp
:set 'set-woman-file-regexp
:set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-use-own-frame nil
@ -1186,7 +1188,7 @@ Called both to generate and to check the cache!"
(setq dir (and (member (car dir) path) (cdr dir))))
(when dir
(cl-pushnew (substitute-in-file-name dir) lst :test #'equal))))
(mapcar 'substitute-in-file-name woman-path)))
(mapcar #'substitute-in-file-name woman-path)))
(defun woman-read-directory-cache ()
"Load the directory and topic cache.
@ -1501,14 +1503,14 @@ Also make each path-info component into a list.
(if (woman-not-member dir path) ; use each directory only once!
(setq files (nconc files
(directory-files dir t topic-regexp))))))
(mapcar 'list files)))
(mapcar #'list files)))
;;; dired support
(defun woman-dired-define-key (key)
"Bind the argument KEY to the command `woman-dired-find-file'."
(define-key dired-mode-map key 'woman-dired-find-file))
(define-key dired-mode-map key #'woman-dired-find-file))
(defsubst woman-dired-define-key-maybe (key)
"If KEY is undefined in Dired, bind it to command `woman-dired-find-file'."
@ -1520,7 +1522,7 @@ Also make each path-info component into a list.
"Define dired keys to run WoMan according to `woman-dired-keys'."
(if woman-dired-keys
(if (listp woman-dired-keys)
(mapc 'woman-dired-define-key woman-dired-keys)
(mapc #'woman-dired-define-key woman-dired-keys)
(woman-dired-define-key-maybe "w")
(woman-dired-define-key-maybe "W")))
(define-key-after (lookup-key dired-mode-map [menu-bar immediate])
@ -1528,7 +1530,7 @@ Also make each path-info component into a list.
(if (featurep 'dired)
(woman-dired-define-keys)
(add-hook 'dired-mode-hook 'woman-dired-define-keys))
(add-hook 'dired-mode-hook #'woman-dired-define-keys))
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
@ -1754,15 +1756,15 @@ Leave point at end of new text. Return length of inserted text."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map Man-mode-map)
(define-key map "R" 'woman-reformat-last-file)
(define-key map "w" 'woman)
(define-key map "\en" 'WoMan-next-manpage)
(define-key map "\ep" 'WoMan-previous-manpage)
(define-key map [M-mouse-2] 'woman-follow-word)
(define-key map "R" #'woman-reformat-last-file)
(define-key map "w" #'woman)
(define-key map "\en" #'WoMan-next-manpage)
(define-key map "\ep" #'WoMan-previous-manpage)
(define-key map [M-mouse-2] #'woman-follow-word)
;; We don't need to call `man' when we are in `woman-mode'.
(define-key map [remap man] 'woman)
(define-key map [remap man-follow] 'woman-follow)
(define-key map [remap man] #'woman)
(define-key map [remap man-follow] #'woman-follow)
map)
"Keymap for `woman-mode'.")
@ -1865,23 +1867,13 @@ See `Man-mode' for additional details.
\\{woman-mode-map}"
;; FIXME: Should all this just be re-arranged so that this can just
;; inherit `man-common' and be done with it?
(let ((Man-build-page-list (symbol-function 'Man-build-page-list))
(Man-strip-page-headers (symbol-function 'Man-strip-page-headers))
(Man-unindent (symbol-function 'Man-unindent))
(Man-goto-page (symbol-function 'Man-goto-page)))
(cl-letf (((symbol-function 'Man-build-page-list) #'ignore)
((symbol-function 'Man-strip-page-headers) #'ignore)
((symbol-function 'Man-unindent) #'ignore)
((symbol-function 'Man-goto-page) #'ignore))
;; Prevent inappropriate operations:
(fset 'Man-build-page-list 'ignore)
(fset 'Man-strip-page-headers 'ignore)
(fset 'Man-unindent 'ignore)
(fset 'Man-goto-page 'ignore)
(unwind-protect
(delay-mode-hooks (Man-mode))
;; Restore the status quo:
(fset 'Man-build-page-list Man-build-page-list)
(fset 'Man-strip-page-headers Man-strip-page-headers)
(fset 'Man-unindent Man-unindent)
(fset 'Man-goto-page Man-goto-page)
(setq tab-width woman-tab-width)))
(delay-mode-hooks (Man-mode)))
(setq tab-width woman-tab-width)
(setq major-mode 'woman-mode
mode-name "WoMan")
;; Don't show page numbers like Man-mode does. (Online documents do
@ -1892,7 +1884,7 @@ See `Man-mode' for additional details.
(setq imenu-generic-expression woman-imenu-generic-expression)
(setq-local imenu-space-replacement " ")
;; Bookmark support.
(setq-local bookmark-make-record-function 'woman-bookmark-make-record)
(setq-local bookmark-make-record-function #'woman-bookmark-make-record)
;; For reformat ...
;; necessary when reformatting a file in its old buffer:
(setq imenu--last-menubar-index-alist nil)
@ -2431,6 +2423,10 @@ Preserves location of `point'."
(defvar woman0-rename-alist) ; bound in woman0-roff-buffer
;; Bound locally by woman[012]-roff-buffer, and woman0-macro.
;; Use dynamically in woman-unquote and woman-forward-arg.
(defvar woman-request)
(defun woman0-roff-buffer (from)
"Process conditional-type requests and user-defined macros.
Start at FROM and re-scan new text as appropriate."
@ -2750,15 +2746,16 @@ Optional argument APPEND, if non-nil, means append macro."
;; request may be used dynamically (woman-interpolate-macro calls
;; woman-forward-arg).
(defun woman0-macro (woman-request)
"Process the macro call named WOMAN-REQUEST."
(defun woman0-macro (request)
"Process the macro call named REQUEST."
;; Leaves point at start of new text.
(let ((macro (assoc woman-request woman0-macro-alist)))
(let ((woman-request request)
(macro (assoc request woman0-macro-alist)))
(if macro
(woman-interpolate-macro (cdr macro))
;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
;; Output this message once only per call (cf. strings)?
(WoMan-warn "Undefined macro %s not interpolated!" woman-request))))
(WoMan-warn "Undefined macro %s not interpolated!" request))))
(defun woman-interpolate-macro (macro)
"Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
@ -2982,11 +2979,6 @@ Useful for constructing the alist variable `woman-special-characters'."
;;; Formatting macros that do not cause a break:
;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and
;; confusingly, as a function argument. Use dynamically in
;; woman-unquote and woman-forward-arg.
(defvar woman-request)
(defun woman-unquote (to)
"Delete any double-quote characters between point and TO.
Leave point at TO (which should be a marker)."
@ -3067,7 +3059,7 @@ B-OR-I is the appropriate complete control line."
".SM -- Set the current line in small font, i.e. IGNORE!"
nil)
(defalias 'woman1-SB 'woman1-B)
(defalias 'woman1-SB #'woman1-B)
;; .SB -- Set the current line in small bold font, i.e. just embolden!
;; (This is what /usr/local/share/groff/tmac/tmac.an does. The
;; Linux man.7 is wrong about this!)
@ -3197,27 +3189,27 @@ If optional arg CONCAT is non-nil then join arguments."
;;; Other non-breaking requests correctly ignored by nroff:
(put 'woman1-ps 'notfont t)
(defalias 'woman1-ps 'woman-delete-whole-line)
(defalias 'woman1-ps #'woman-delete-whole-line)
;; .ps -- Point size -- IGNORE!
(put 'woman1-ss 'notfont t)
(defalias 'woman1-ss 'woman-delete-whole-line)
(defalias 'woman1-ss #'woman-delete-whole-line)
;; .ss -- Space-character size -- IGNORE!
(put 'woman1-cs 'notfont t)
(defalias 'woman1-cs 'woman-delete-whole-line)
(defalias 'woman1-cs #'woman-delete-whole-line)
;; .cs -- Constant character space (width) mode -- IGNORE!
(put 'woman1-ne 'notfont t)
(defalias 'woman1-ne 'woman-delete-whole-line)
(defalias 'woman1-ne #'woman-delete-whole-line)
;; .ne -- Need vertical space -- IGNORE!
(put 'woman1-vs 'notfont t)
(defalias 'woman1-vs 'woman-delete-whole-line)
(defalias 'woman1-vs #'woman-delete-whole-line)
;; .vs -- Vertical base line spacing -- IGNORE!
(put 'woman1-bd 'notfont t)
(defalias 'woman1-bd 'woman-delete-whole-line)
(defalias 'woman1-bd #'woman-delete-whole-line)
;; .bd -- Embolden font -- IGNORE!
;;; Non-breaking SunOS-specific macros:
@ -3228,7 +3220,7 @@ If optional arg CONCAT is non-nil then join arguments."
(woman-forward-arg 'unquote 'concat))
(put 'woman1-IX 'notfont t)
(defalias 'woman1-IX 'woman-delete-whole-line)
(defalias 'woman1-IX #'woman-delete-whole-line)
;; .IX -- Index macro, for Sun internal use -- IGNORE!
@ -3577,7 +3569,7 @@ expression in parentheses. Leaves point after the value."
inc (cdr value)
;; eval internal (.X) registers
;; stored as lisp variable names:
value (eval (car value)))
value (eval (car value) t))
(if (and pm inc) ; auto-increment
(setq value
(funcall (intern-soft pm) value inc)
@ -3637,64 +3629,55 @@ expression in parentheses. Leaves point after the value."
"Process breaks. Format paragraphs and headings."
(let ((case-fold-search t)
(to (make-marker))
(canonically-space-region
(symbol-function 'canonically-space-region))
(insert-and-inherit (symbol-function 'insert-and-inherit))
(set-text-properties (symbol-function 'set-text-properties))
(woman-registers woman-registers)
fn woman-request woman-translations
tab-stop-list)
(set-marker-insertion-type to t)
;; ?roff does not squeeze multiple spaces, but does fill, so...
(fset 'canonically-space-region 'ignore)
;; Try to avoid spaces inheriting underlines from preceding text!
(fset 'insert-and-inherit (symbol-function 'insert))
(fset 'set-text-properties 'ignore)
(unwind-protect
(progn
(while
;; Find next control line:
(re-search-forward woman-request-regexp nil t)
(cond
;; Construct woman function to call:
((setq fn (intern-soft
(concat "woman2-"
(setq woman-request (match-string 1)))))
;; Delete request or macro name:
(woman-delete-match 0))
;; Unrecognized request:
((prog1 nil
;; (WoMan-warn ".%s request ignored!" woman-request)
(WoMan-warn-ignored woman-request "ignored!")
;; (setq fn 'woman2-LP)
;; AVOID LEAVING A BLANK LINE!
;; (setq fn 'woman2-format-paragraphs)
))
;; .LP assumes it is at eol and leaves a (blank) line,
;; so leave point at end of line before paragraph:
((or (looking-at "[ \t]*$") ; no argument
woman-ignore) ; ignore all
;; (beginning-of-line) (kill-line)
;; AVOID LEAVING A BLANK LINE!
(beginning-of-line) (woman-delete-line 1))
(t (end-of-line) (insert ?\n)))
(if (not (or fn
(and (not (memq (following-char) '(?. ?')))
(setq fn 'woman2-format-paragraphs))))
()
;; Find next control line:
(if (equal woman-request "TS")
(set-marker to (woman-find-next-control-line "TE"))
(set-marker to (woman-find-next-control-line)))
;; Call the appropriate function:
(funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
(woman2-format-paragraphs (copy-marker (point-max) t)
woman-left-margin)))
(fset 'canonically-space-region canonically-space-region)
(fset 'set-text-properties set-text-properties)
(fset 'insert-and-inherit insert-and-inherit)
(set-marker to nil))))
(cl-letf (((symbol-function 'canonically-space-region) #'ignore)
;; Try to avoid spaces inheriting underlines from preceding text!
((symbol-function 'insert-and-inherit) #'insert)
((symbol-function 'set-text-properties) #'ignore))
(while
;; Find next control line:
(re-search-forward woman-request-regexp nil t)
(cond
;; Construct woman function to call:
((setq fn (intern-soft
(concat "woman2-"
(setq woman-request (match-string 1)))))
;; Delete request or macro name:
(woman-delete-match 0))
;; Unrecognized request:
((prog1 nil
;; (WoMan-warn ".%s request ignored!" woman-request)
(WoMan-warn-ignored woman-request "ignored!")
;; (setq fn 'woman2-LP)
;; AVOID LEAVING A BLANK LINE!
;; (setq fn 'woman2-format-paragraphs)
))
;; .LP assumes it is at eol and leaves a (blank) line,
;; so leave point at end of line before paragraph:
((or (looking-at "[ \t]*$") ; no argument
woman-ignore) ; ignore all
;; (beginning-of-line) (kill-line)
;; AVOID LEAVING A BLANK LINE!
(beginning-of-line) (woman-delete-line 1))
(t (end-of-line) (insert ?\n)))
(if (not (or fn
(and (not (memq (following-char) '(?. ?')))
(setq fn 'woman2-format-paragraphs))))
()
;; Find next control line:
(if (equal woman-request "TS")
(set-marker to (woman-find-next-control-line "TE"))
(set-marker to (woman-find-next-control-line)))
;; Call the appropriate function:
(funcall fn to)))
(if (not (eobp)) ; This should not happen, but ...
(woman2-format-paragraphs (copy-marker (point-max) t)
woman-left-margin)))
(set-marker to nil)))
(defun woman-find-next-control-line (&optional pat)
"Find and return start of next control line.
@ -3805,8 +3788,8 @@ Leave 1 blank line. Format paragraphs upto TO."
(setq woman-prevailing-indent woman-default-indent)
(woman2-format-paragraphs to woman-left-margin))
(defalias 'woman2-PP 'woman2-LP)
(defalias 'woman2-P 'woman2-LP)
(defalias 'woman2-PP #'woman2-LP)
(defalias 'woman2-P #'woman2-LP)
(defun woman2-ns (to)
".ns -- Turn on no-space mode. Format paragraphs upto TO."
@ -4277,16 +4260,16 @@ Set prevailing indent to amount of starting .RS."
If no argument then use value of optional arg PREVIOUS if non-nil,
otherwise set PREVIOUS. Delete the whole remaining control line."
(if (eolp) ; space already skipped
(set arg (if previous (eval previous) 0))
(if previous (set previous (eval arg)))
(set arg (if previous (symbol-value previous) 0))
(if previous (set previous (symbol-value arg)))
(woman2-process-escapes-to-eol 'numeric)
(let ((pm (if (looking-at "[+-]")
(prog1 (following-char)
(forward-char 1))))
(i (woman-parse-numeric-arg)))
(cond ((null pm) (set arg i))
((= pm ?+) (set arg (+ (eval arg) i)))
((= pm ?-) (set arg (- (eval arg) i)))
((= pm ?+) (set arg (+ (symbol-value arg) i)))
((= pm ?-) (set arg (- (symbol-value arg) i)))
))
(beginning-of-line))
(woman-delete-line 1)) ; ignore any remaining arguments
@ -4483,7 +4466,7 @@ Format paragraphs upto TO."
(setq woman-nofill t)
(woman2-format-paragraphs to))
(defalias 'woman2-TE 'woman2-fi)
(defalias 'woman2-TE #'woman2-fi)
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.

6
src/coding.c
View file

@ -7799,7 +7799,13 @@ encode_coding (struct coding_system *coding)
coding_set_source (coding);
consume_chars (coding, translation_table, max_lookup);
coding_set_destination (coding);
/* The CODING_MODE_LAST_BLOCK flag should be set only for the last
iteration of the encoding. */
unsigned saved_mode = coding->mode;
if (coding->consumed_char < coding->src_chars)
coding->mode &= ~CODING_MODE_LAST_BLOCK;
(*(coding->encoder)) (coding);
coding->mode = saved_mode;
} while (coding->consumed_char < coding->src_chars);
if (BUFFERP (coding->dst_object) && coding->produced_char > 0)

1
src/data.c
View file

@ -1663,6 +1663,7 @@ All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */)
(Lisp_Object symbol, Lisp_Object watch_function)
{
symbol = Findirect_variable (symbol);
CHECK_SYMBOL (symbol);
set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
map_obarray (Vobarray, harmonize_variable_watchers, symbol);

26
src/filelock.c
View file

@ -719,8 +719,8 @@ lock_file (Lisp_Object fn)
}
}
void
unlock_file (Lisp_Object fn)
static Lisp_Object
unlock_file_body (Lisp_Object fn)
{
char *lfname;
USE_SAFE_ALLOCA;
@ -737,6 +737,23 @@ unlock_file (Lisp_Object fn)
report_file_errno ("Unlocking file", filename, err);
SAFE_FREE ();
return Qnil;
}
static Lisp_Object
unlock_file_handle_error (Lisp_Object err)
{
call1 (intern ("userlock--handle-unlock-error"), err);
return Qnil;
}
void
unlock_file (Lisp_Object fn)
{
internal_condition_case_1 (unlock_file_body,
fn,
list1(Qfile_error),
unlock_file_handle_error);
}
#else /* MSDOS */
@ -790,7 +807,10 @@ DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
0, 0, 0,
doc: /* Unlock the file visited in the current buffer.
If the buffer is not modified, this does nothing because the file
should not be locked in that case. */)
should not be locked in that case. It also does nothing if the
current buffer is not visiting a file, or is not locked. Handles file
system errors by calling `display-warning' and continuing as if the
error did not occur. */)
(void)
{
if (SAVE_MODIFF < MODIFF

10
src/fns.c
View file

@ -2369,7 +2369,10 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
\(PROP1 VALUE1 PROP2 VALUE2 ...).
The comparison with PROP is done using `eq'.
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
@ -3211,7 +3214,10 @@ suppressed. */)
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
doc: /* Return non-nil if PLIST has the property PROP.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
\(PROP1 VALUE1 PROP2 VALUE2 ...).
The comparison with PROP is done using `eq'.
Unlike `plist-get', this allows you to distinguish between a missing
property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)

6
src/pdumper.c
View file

@ -165,11 +165,7 @@ ptrdiff_t_to_dump_off (ptrdiff_t value)
static int
dump_get_page_size (void)
{
#if defined (WINDOWSNT) || defined (CYGWIN)
return 64 * 1024; /* Worst-case allocation granularity. */
#else
return getpagesize ();
#endif
return 64 * 1024;
}
#define dump_offsetof(type, member) \

2
src/xfns.c
View file

@ -2783,7 +2783,7 @@ xic_set_preeditarea (struct window *w, int x, int y)
XVaNestedList attr;
XPoint spot;
spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w) + WINDOW_LEFT_MARGIN_WIDTH(w);
spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);

3
test/infra/Dockerfile.emba
View file

@ -47,7 +47,8 @@ RUN make -j4
FROM emacs-base as emacs-filenotify-gio
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0 \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
libglib2.0-dev libglib2.0-bin libglib2.0-0 \
&& rm -rf /var/lib/apt/lists/*
COPY . /checkout

37
test/infra/gitlab-ci.yml
View file

@ -61,6 +61,8 @@ default:
- docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY}
.job-template:
variables:
test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA}
rules:
- changes:
- "**/Makefile.in"
@ -95,14 +97,18 @@ default:
artifacts:
expire_in: 24 hrs
paths: []
# - "test/**/*.log"
# - "**/*.log"
# using the variables for each job
script:
- docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
# TODO: with make -j4 several of the tests were failing, for example shadowfile-tests, but passed without it
- 'export PWD=$(pwd)'
- 'docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"'
- 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"'
after_script:
# - docker ps -a
# - printenv
# - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - )
- test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name}
- test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}
.build-template:
rules:
@ -133,6 +139,19 @@ default:
- docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba .
- docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
.test-template:
# Do not run fast and normal test jobs when scheduled
rules:
- if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"'
when: never
- when: always
artifacts:
name: ${test_name}
public: true
expire_in: 1 week
paths:
- "${test_name}/**/*.log"
.gnustep-template:
rules:
- if: '$CI_PIPELINE_SOURCE == "web"'
@ -185,7 +204,7 @@ build-image-inotify:
test-fast-inotify:
stage: fast
extends: [.job-template]
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check"
@ -204,14 +223,14 @@ build-image-gnustep:
test-lisp-inotify:
stage: normal
extends: [.job-template]
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-lisp"
test-lisp-net-inotify:
stage: normal
extends: [.job-template]
extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-lisp-net"
@ -219,10 +238,10 @@ test-lisp-net-inotify:
test-filenotify-gio:
# This tests file monitor libraries gfilemonitor and gio.
stage: platforms
extends: [.job-template, .filenotify-gio-template]
extends: [.job-template, .test-template, .filenotify-gio-template]
variables:
target: emacs-filenotify-gio
make_params: "-k -C test autorevert-tests filenotify-tests"
make_params: "-k -C test autorevert-tests.log filenotify-tests.log"
test-gnustep:
# This tests the GNUstep build process
@ -235,7 +254,7 @@ test-gnustep:
test-all-inotify:
# This tests also file monitor libraries inotify and inotifywatch.
stage: slow
extends: [.job-template]
extends: [.job-template, .test-template]
rules:
# note there's no "changes" section, so this always runs on a schedule
- if: '$CI_PIPELINE_SOURCE == "web"'

4
test/lisp/autorevert-tests.el
View file

@ -133,7 +133,9 @@ This expects `auto-revert--messages' to be bound by
(format-message
"Reverting buffer `%s'\\." (buffer-name buffer))
(or auto-revert--messages ""))))
(if (with-current-buffer buffer auto-revert-use-notify)
(if (and (or file-notify--library
(file-remote-p temporary-file-directory))
(with-current-buffer buffer auto-revert-use-notify))
(read-event nil nil 0.05)
(sleep-for 0.05)))))

247
test/lisp/filenotify-tests.el
View file

@ -107,19 +107,19 @@ There are different timeouts for local and remote file notification libraries."
(cond
;; gio/gpollfilemonitor.c declares POLL_TIME_SECS 5. So we must
;; wait at least this time in the GPollFileMonitor case. A
;; similar timeout seems to be needed in the GFamFileMonitor case,
;; at least on cygwin.
((memq (file-notify--test-monitor) '(GFamFileMonitor GPollFileMonitor)) 7)
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") 1)
;; similar timeout seems to be needed in the
;; GFam{File,Directory}Monitor case. So we use a large timeout
;; for any monitor.
((file-notify--test-monitor) 7)
((file-remote-p temporary-file-directory) 0.1)
(t 0.01))))
(defun file-notify--test-timeout ()
"Timeout to wait for arriving a bunch of events, in seconds."
(cond
((eq system-type 'cygwin) 10)
((file-remote-p temporary-file-directory) 6)
((string-equal (file-notify--test-library) "w32notify") 4)
((eq system-type 'cygwin) 6)
(t 3)))
(defmacro file-notify--test-wait-for-events (timeout until)
@ -256,24 +256,37 @@ remote host, or nil."
(defun file-notify--test-monitor ()
"The used monitor for the test, as a symbol.
This returns only for the local case and gfilenotify; otherwise it is nil.
`file-notify--test-desc' must be a valid watch descriptor."
This returns only for (local) gfilenotify or (remote) gio library;
otherwise it is nil. `file-notify--test-desc' must be a valid
watch descriptor."
;; We cache the result, because after `file-notify-rm-watch',
;; `gfile-monitor-name' does not return a proper result anymore.
;; But we still need this information.
;; So far, we know the monitors GFamFileMonitor, GFenFileMonitor,
;; GInotifyFileMonitor, GKqueueFileMonitor and GPollFileMonitor.
(or (cdr (assq file-notify--test-desc file-notify--test-monitors))
(progn
(add-to-list
'file-notify--test-monitors
(cons file-notify--test-desc
(if (file-remote-p temporary-file-directory)
(tramp-get-connection-property
file-notify--test-desc "gio-file-monitor" nil)
(and (functionp 'gfile-monitor-name)
(gfile-monitor-name file-notify--test-desc)))))
(cdr (assq file-notify--test-desc file-notify--test-monitors)))))
;; But we still need this information. So far, we know the monitors
;; GFamFileMonitor (gfilenotify on cygwin), GFamDirectoryMonitor
;; (gfilenotify on Solaris), GInotifyFileMonitor (gfilenotify and
;; gio on GNU/Linux), GKqueueFileMonitor (gfilenotify and gio on
;; FreeBSD) and GPollFileMonitor (gio on cygwin).
(when file-notify--test-desc
(or (alist-get file-notify--test-desc file-notify--test-monitors)
(when (member (file-notify--test-library) '("gfilenotify" "gio"))
(add-to-list
'file-notify--test-monitors
(cons file-notify--test-desc
(if (file-remote-p temporary-file-directory)
;; `file-notify--test-desc' is the connection process.
(progn
(while (not (tramp-connection-property-p
file-notify--test-desc "gio-file-monitor"))
(accept-process-output file-notify--test-desc 0))
(tramp-get-connection-property
file-notify--test-desc "gio-file-monitor" nil))
(and (functionp 'gfile-monitor-name)
(gfile-monitor-name file-notify--test-desc)))))
;; If we don't know the monitor, there are good chances the
;; test will fail. We let it fail already here, in order to
;; know the real reason.
(should (alist-get file-notify--test-desc file-notify--test-monitors)))
(alist-get file-notify--test-desc file-notify--test-monitors))))
(defmacro file-notify--deftest-remote (test docstring &optional unstable)
"Define ert `TEST-remote' for remote files.
@ -484,6 +497,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'second-callback)))
;; `file-notify-rm-watch' confuses `file-notify--test-monitor'.
;; Initialize it in time.
(file-notify--test-monitor)
;; Remove first watch.
(file-notify-rm-watch file-notify--test-desc)
;; Only the second callback shall run.
@ -547,6 +563,10 @@ and the event to `file-notify--test-events'."
file-notify--test-results
(append file-notify--test-results `(,result))))))
(defun file-notify--test-event-actions ()
"Helper function to return retrieved actions, as list."
(mapcar #'file-notify--test-event-action file-notify--test-events))
(defun file-notify--test-with-actions-check (actions)
"Check whether received actions match one of the ACTIONS alternatives."
(let (result)
@ -555,22 +575,25 @@ and the event to `file-notify--test-events'."
(or result
(if (eq (car elt) :random)
(equal (sort (cdr elt) 'string-lessp)
(sort (mapcar #'file-notify--test-event-action
file-notify--test-events)
(sort (file-notify--test-event-actions)
'string-lessp))
(equal elt (mapcar #'file-notify--test-event-action
file-notify--test-events))))))))
(equal elt (file-notify--test-event-actions))))))
;; Do not report result in case we debug. Write messages instead.
(if file-notify-debug
(prog1 t
(if result
(message "Success\n%s" (file-notify--test-event-actions))
(message (file-notify--test-with-actions-explainer actions))))
result)))
(defun file-notify--test-with-actions-explainer (actions)
"Explain why `file-notify--test-with-actions-check' fails."
(if (null (cdr actions))
(format "Received actions do not match expected actions\n%s\n%s"
(mapcar #'file-notify--test-event-action file-notify--test-events)
(car actions))
(file-notify--test-event-actions) (car actions))
(format
"Received actions do not match any sequence of expected actions\n%s\n%s"
(mapcar #'file-notify--test-event-action file-notify--test-events)
actions)))
(file-notify--test-event-actions) actions)))
(put 'file-notify--test-with-actions-check 'ert-explainer
'file-notify--test-with-actions-explainer)
@ -592,6 +615,9 @@ delivered."
(mapcar
(lambda (x) (length (if (eq (car x) :random) (cdr x) x)))
actions)))
;; Don't stop while debugging.
(while-no-input-ignore-events
(cons 'file-notify while-no-input-ignore-events))
create-lockfiles)
;; Flush pending actions.
(file-notify--test-read-event)
@ -632,16 +658,11 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; cygwin does not raise a `changed' event.
((eq system-type 'cygwin)
'(created deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
;; GFam{File,Directory}Monitor, GKqueueFileMonitor and
;; GPollFileMonitor do not report the `changed' event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor
GKqueueFileMonitor GPollFileMonitor))
'(created deleted stopped))
(t '(created changed deleted stopped)))
(write-region
@ -668,13 +689,14 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `changed' event reliably.
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
;; GFam{File,Directory}Monitor and GPollFileMonitor do
;; not detect the `changed' event reliably.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'((deleted stopped)
(changed deleted stopped)))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
@ -709,25 +731,22 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed deleted))
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
((string-equal
(file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; On emba, `deleted' and `stopped' events of the
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed deleted))
;; There are two `deleted' events, for the file and for
;; the directory. Except for cygwin and kqueue. And
;; cygwin does not raise a `changed' event.
((eq system-type 'cygwin)
;; the directory. Except for
;; GFam{File,Directory}Monitor, GPollFileMonitor and
;; kqueue. And GFam{File,Directory}Monitor and
;; GPollFileMonitordo not raise a `changed' event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
@ -762,15 +781,12 @@ delivered."
'(created changed created changed
changed changed changed
deleted deleted))
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
((string-equal
(file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created created deleted stopped)))
;; There are three `deleted' events, for two files and
;; for the directory. Except for cygwin and kqueue.
((eq system-type 'cygwin)
;; for the directory. Except for
;; GFam{File,Directory}Monitor, GPollFileMonitor and
;; kqueue.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created created changed changed deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed created changed deleted stopped))
@ -779,7 +795,7 @@ delivered."
((getenv "EMACS_EMBA_CI")
'(created changed created changed deleted deleted))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created created deleted deleted deleted stopped))
(t '(created changed created changed
deleted deleted deleted stopped)))
@ -819,26 +835,23 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed renamed deleted))
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
((string-equal
(file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; On emba, `deleted' and `stopped' events of the
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed renamed deleted))
;; There are two `deleted' events, for the file and for
;; the directory. Except for cygwin and kqueue. And
;; cygwin raises `created' and `deleted' events instead
;; of a `renamed' event.
((eq system-type 'cygwin)
;; the directory. Except for
;; GFam{File,Directory}Monitor, GPollfileMonitor and
;; kqueue. And GFam{File,Directory}Monitor and
;; GPollFileMonitor raise `created' and `deleted' events
;; instead of a `renamed' event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created created deleted deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed renamed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created renamed deleted deleted stopped))
(t '(created changed renamed deleted deleted stopped)))
(write-region
@ -857,8 +870,8 @@ delivered."
(file-notify--test-cleanup))
(unwind-protect
;; Check attribute change. Does not work for cygwin.
(unless (eq system-type 'cygwin)
;; Check attribute change.
(progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@ -876,12 +889,21 @@ delivered."
((string-equal (file-notify--test-library) "w32notify")
'((changed changed)
(changed changed changed changed)))
;; GKqueueFileMonitor does not report the `attribute-changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
;; For kqueue and in the remote case, `write-region'
;; raises also an `attribute-changed' event.
((or (string-equal (file-notify--test-library) "kqueue")
(file-remote-p temporary-file-directory))
;; GFam{File,Directory}Monitor, GKqueueFileMonitor and
;; GPollFileMonitor do not report the `attribute-changed'
;; event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor
GKqueueFileMonitor GPollFileMonitor))
'())
;; For GInotifyFileMonitor,`write-region' raises
;; also an `attribute-changed' event on gio.
((and (string-equal (file-notify--test-library) "gio")
(eq (file-notify--test-monitor) 'GInotifyFileMonitor))
'(attribute-changed attribute-changed attribute-changed))
;; For kqueue, `write-region' raises also an
;; `attribute-changed' event.
((string-equal (file-notify--test-library) "kqueue")
'(attribute-changed attribute-changed attribute-changed))
(t '(attribute-changed attribute-changed)))
(write-region
@ -946,7 +968,7 @@ delivered."
;; GKqueueFileMonitor does not report the `changed' event.
(skip-unless
(not (equal (file-notify--test-monitor) 'GKqueueFileMonitor)))
(not (eq (file-notify--test-monitor) 'GKqueueFileMonitor)))
;; Check, that file notification has been used.
(should auto-revert-mode)
@ -1046,13 +1068,14 @@ delivered."
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
(cond
;; gvfs-monitor-dir on cygwin does not detect the
;; `changed' event reliably.
((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
;; GFam{File,Directory}Monitor do not
;; detect the `changed' event reliably.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor))
'((deleted stopped)
(changed deleted stopped)))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
@ -1090,21 +1113,18 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed deleted))
;; gvfs-monitor-dir on cygwin does not detect the
;; `created' event reliably.
((string-equal
(file-notify--test-library) "gvfs-monitor-dir.exe")
'((deleted stopped)
(created deleted stopped)))
;; There are two `deleted' events, for the file and for
;; the directory. Except for cygwin and kqueue. And
;; cygwin does not raise a `changed' event.
((eq system-type 'cygwin)
;; the directory. Except for
;; GFam{File,Directory}Monitor, GPollFileMonitor and
;; kqueue. And GFam{File,Directory}Monitor and
;; GPollfileMonitor do not raise a `changed' event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
@ -1205,7 +1225,7 @@ delivered."
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(unwind-protect
(let ((n 1000)
(let ((n 10);00)
source-file-list target-file-list
(default-directory file-notify--test-tmpfile))
(dotimes (i n)
@ -1234,9 +1254,11 @@ delivered."
(dotimes (_i n)
(setq r (append '(deleted renamed) r)))
r))
;; cygwin fires `changed' and `deleted' events, sometimes
;; in random order.
((eq system-type 'cygwin)
;; GFam{File,Directory}Monitor and GPollFileMonitor fire
;; `changed' and `deleted' events, sometimes in random
;; order.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
(let (r)
(dotimes (_i n)
(setq r (append '(changed deleted) r)))
@ -1285,7 +1307,7 @@ delivered."
(file-notify--test-with-actions
(cond
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor) '())
;; There could be one or two `changed' events.
(t '((changed)
(changed changed))))
@ -1323,11 +1345,13 @@ delivered."
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
(cond
;; On cygwin we only get the `changed' event.
((eq system-type 'cygwin)
'(changed))
;; GFam{File,Directory}Monitor and GPollFileMonitor
;; report only the `changed' event.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(changed))
;; GKqueueFileMonitor does not report the `changed' event.
((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(renamed created))
(t '(renamed created changed)))
;; The file is renamed when creating a backup. It shall
@ -1398,7 +1422,7 @@ the file watch."
(should (file-notify-valid-p file-notify--test-desc1))
(should (file-notify-valid-p file-notify--test-desc2))
(should-not (equal file-notify--test-desc1 file-notify--test-desc2))
(let ((n 100))
(let ((n 10));0))
;; Run the test.
(file-notify--test-with-actions
;; There could be one or two `changed' events.
@ -1455,10 +1479,13 @@ the file watch."
;; Now we delete the directory.
(file-notify--test-with-actions
(cond
;; In kqueue and for cygwin, just one `deleted' event for
;; the directory is received.
((or (eq system-type 'cygwin)
(string-equal (file-notify--test-library) "kqueue"))
;; GFam{File,Directory}Monitor, GPollFileMonitor and
;; kqueue raise just one `deleted' event for the
;; directory.
((memq (file-notify--test-monitor)
'(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(deleted stopped))
(t (append
;; The directory monitor raises a `deleted' event for

55
test/lisp/files-tests.el
View file

@ -192,14 +192,37 @@ form.")
(ert-deftest files-tests-bug-21454 ()
"Test for https://debbugs.gnu.org/21454 ."
(let ((input-result
'(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/"))
("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("//foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))
(if (memq system-type '(windows-nt ms-dos))
'(("x:/foo/bar//baz/;y:/bar/foo/baz//" nil
("x:/foo/bar/baz/" "y:/bar/foo/baz/"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x://foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo/" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
("x:/foo/bar/baz/" "z:/qux/foo/"))
("x://foo/bar/" "$FOO/baz/;z:/qux/foo/"
("x:/foo/bar/baz/" "z:/qux/foo/")))
'(("/foo/bar//baz/:/bar/foo/baz//" nil
("/foo/bar/baz/" "/bar/foo/baz/"))
("/foo/bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("//foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")))))
(foo-env (getenv "FOO"))
(bar-env (getenv "BAR")))
(unwind-protect
@ -857,10 +880,15 @@ unquoted file names."
(find-backup-file-name tmpfile)))))))
(ert-deftest files-tests-file-name-non-special-get-file-buffer ()
;; Make sure these buffers don't exist.
(files-tests--with-temp-non-special (tmpfile nospecial)
(should-not (get-file-buffer nospecial)))
(let ((fbuf (get-file-buffer nospecial)))
(if fbuf (kill-buffer fbuf))
(should-not (get-file-buffer nospecial))))
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
(should-not (get-file-buffer nospecial))))
(let ((fbuf (get-file-buffer nospecial)))
(if fbuf (kill-buffer fbuf))
(should-not (get-file-buffer nospecial)))))
(ert-deftest files-tests-file-name-non-special-insert-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
@ -1363,8 +1391,11 @@ See <https://debbugs.gnu.org/36401>."
(should (not (eq major-mode 'text-mode))))))
(ert-deftest files-colon-path ()
(should (equal (parse-colon-path "/foo//bar/baz")
'("/foo/bar/baz/"))))
(if (memq system-type '(windows-nt ms-dos))
(should (equal (parse-colon-path "x:/foo//bar/baz")
'("x:/foo/bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
'("/foo/bar/baz/")))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."

41
test/lisp/lpr-tests.el Normal file
View file

@ -0,0 +1,41 @@
;;; lpr-tests.el --- Tests for lpr.el -*- lexical-binding: t -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'lpr)
(ert-deftest lpr-test-printify-region ()
(with-temp-buffer
(insert "foo\^@-\^h\^k\^n-\^_\177bar")
(printify-region (point-min) (point-max))
(should (equal (buffer-string) "foo\\^@-\\^H\\^K\\^N-\\^_\\7fbar"))))
(ert-deftest lpr-test-lpr-eval-switch ()
(should (equal (lpr-eval-switch "foo") "foo"))
(should (equal (lpr-eval-switch (lambda () "foo")) "foo"))
(let ((v "foo"))
(should (equal (lpr-eval-switch v) "foo")))
(should (equal (lpr-eval-switch (list #'identity "foo")) "foo"))
(should (equal (lpr-eval-switch 1) nil)))
;;; lpr-tests.el ends here

23
test/src/data-tests.el
View file

@ -358,12 +358,35 @@ comparing the subr with a much slower lisp implementation."
(should (equal (symbol-value var) 42))
(should (equal (default-value var) (symbol-value var)))
(set var 123)
(should (not (local-variable-p var)))
(should (equal (symbol-value var) 123))
(should (equal (default-value var) (symbol-value var)))) ;bug#44733
(should (equal (symbol-value var) def))
(should (equal (default-value var) (symbol-value var))))
(should (equal (default-value var) def))))))
(ert-deftest data-tests--let-buffer-local-no-unwind-other-buffers ()
"Test that a let-binding for a buffer-local unwinds only current-buffer."
(let ((blvar (make-symbol "blvar")))
(set-default blvar 0)
(make-variable-buffer-local blvar)
(dolist (var (list blvar 'left-margin))
(let* ((def (default-value var))
(newdef (+ def 1))
(otherbuf (generate-new-buffer "otherbuf")))
(with-temp-buffer
(cl-progv (list var) (list newdef)
(with-current-buffer otherbuf
(set var 123)
(should (local-variable-p var))
(should (equal (symbol-value var) 123))
(should (equal (default-value var) newdef))))
(with-current-buffer otherbuf
(should (local-variable-p var))
(should (equal (symbol-value var) 123))
(should (equal (default-value var) def)))
)))))
(ert-deftest binding-test-makunbound ()
"Tests of makunbound, from the manual."
(with-current-buffer binding-test-buffer-B

183
test/src/filelock-tests.el Normal file
View file

@ -0,0 +1,183 @@
;;; filelock-tests.el --- test file locking -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file tests code in src/filelock.c and, to some extent, the
;; related code in src/fileio.c.
;;
;; See also (info "(emacs)Interlocking") and (info "(elisp)File Locks")
;;; Code:
(require 'cl-macs)
(require 'ert)
(require 'seq)
(defun filelock-tests--fixture (test-function)
"Call TEST-FUNCTION under a test fixture.
Create a test directory and a buffer whose `buffer-file-name' and
`buffer-file-truename' are a file within it, then call
TEST-FUNCTION. Finally, delete the buffer and the test
directory."
(let* ((temp-dir (make-temp-file "filelock-tests" t))
(name (concat (file-name-as-directory temp-dir)
"userfile"))
(create-lockfiles t))
(unwind-protect
(with-temp-buffer
(setq buffer-file-name name
buffer-file-truename name)
(unwind-protect
(save-current-buffer
(funcall test-function))
;; Set `buffer-file-truename' nil to prevent unlocking,
;; which might prompt the user and/or signal errors.
(setq buffer-file-name nil
buffer-file-truename nil)))
(delete-directory temp-dir t nil))))
(defun filelock-tests--make-lock-name (file-name)
"Return the lock file name for FILE-NAME.
Equivalent logic in Emacs proper is implemented in C and
unavailable to Lisp."
(concat (file-name-directory (expand-file-name file-name))
".#"
(file-name-nondirectory file-name)))
(defun filelock-tests--spoil-lock-file (file-name)
"Spoil the lock file for FILE-NAME.
Cause Emacs to report errors for various file locking operations
on FILE-NAME going forward. Create a file that is incompatible
with Emacs' file locking protocol, but uses the same name as
FILE-NAME's lock file. A directory file is used, which is
portable in practice."
(make-directory (filelock-tests--make-lock-name file-name)))
(defun filelock-tests--unspoil-lock-file (file-name)
"Remove the lock file spoiler for FILE-NAME.
See `filelock-tests--spoil-lock-file'."
(delete-directory (filelock-tests--make-lock-name file-name) t))
(defun filelock-tests--should-be-locked ()
"Abort the current test if the current buffer is not locked.
Exception: on systems without lock file support, aborts the
current test if the current file is locked (which should never
the case)."
(if (eq system-type 'ms-dos)
(should-not (file-locked-p buffer-file-truename))
(should (file-locked-p buffer-file-truename))))
(ert-deftest filelock-tests-lock-unlock-no-errors ()
"Check that locking and unlocking works without error."
(filelock-tests--fixture
(lambda ()
(should-not (file-locked-p (buffer-file-name)))
;; inserting text should lock the buffer's file.
(insert "this locks the buffer's file")
(filelock-tests--should-be-locked)
(unlock-buffer)
(set-buffer-modified-p nil)
(should-not (file-locked-p (buffer-file-name)))
;; `set-buffer-modified-p' should lock the buffer's file.
(set-buffer-modified-p t)
(filelock-tests--should-be-locked)
(unlock-buffer)
(should-not (file-locked-p (buffer-file-name)))
(should-not (file-locked-p (buffer-file-name))))))
(ert-deftest filelock-tests-lock-spoiled ()
"Check `lock-buffer' ."
(skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
(filelock-tests--fixture
(lambda ()
(filelock-tests--spoil-lock-file buffer-file-truename)
;; FIXME: errors when locking a file are ignored; should they be?
(set-buffer-modified-p t)
(filelock-tests--unspoil-lock-file buffer-file-truename)
(should-not (file-locked-p buffer-file-truename)))))
(ert-deftest filelock-tests-file-locked-p-spoiled ()
"Check that `file-locked-p' fails if the lockfile is \"spoiled\"."
(skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
(filelock-tests--fixture
(lambda ()
(filelock-tests--spoil-lock-file buffer-file-truename)
(let ((err (should-error (file-locked-p (buffer-file-name)))))
(should (equal (seq-subseq err 0 2)
'(file-error "Testing file lock")))))))
(ert-deftest filelock-tests-unlock-spoiled ()
"Check that `unlock-buffer' fails if the lockfile is \"spoiled\"."
(skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
(filelock-tests--fixture
(lambda ()
;; Set the buffer modified with file locking temporarily
;; disabled.
(let ((create-lockfiles nil))
(set-buffer-modified-p t))
(should-not (file-locked-p buffer-file-truename))
(filelock-tests--spoil-lock-file buffer-file-truename)
;; Errors from `unlock-buffer' should call
;; `userlock--handle-unlock-error' (bug#46397).
(let (errors)
(cl-letf (((symbol-function 'userlock--handle-unlock-error)
(lambda (err) (push err errors))))
(unlock-buffer))
(should (consp errors))
(should (equal '(file-error "Unlocking file")
(seq-subseq (car errors) 0 2)))
(should (equal (length errors) 1))))))
(ert-deftest filelock-tests-kill-buffer-spoiled ()
"Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
(skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
(filelock-tests--fixture
(lambda ()
;; Set the buffer modified with file locking temporarily
;; disabled.
(let ((create-lockfiles nil))
(set-buffer-modified-p t))
(should-not (file-locked-p buffer-file-truename))
(filelock-tests--spoil-lock-file buffer-file-truename)
;; Kill the current buffer. Because the buffer is modified Emacs
;; will attempt to unlock it. Temporarily bind `yes-or-no-p' to
;; a function that fakes a "yes" answer for the "Buffer modified;
;; kill anyway?" prompt.
;;
;; File errors from unlocking files should call
;; `userlock--handle-unlock-error' (bug#46397).
(let (errors)
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (&rest _) t))
((symbol-function 'userlock--handle-unlock-error)
(lambda (err) (push err errors))))
(kill-buffer))
(should (consp errors))
(should (equal '(file-error "Unlocking file")
(seq-subseq (car errors) 0 2)))
(should (equal (length errors) 1))))))
(provide 'filelock-tests)
;;; filelock-tests.el ends here