Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs into feature/pgtk

Browse source
This commit is contained in:
Yuuki Harano 2021-03-21 15:54:46 +09:00
commit 5d2f319eec
214 changed files with 3168 additions and 2791 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
CONTRIBUTE
View file

@ -72,9 +72,12 @@ the copyright for your contributions. (To see how many lines were
non-trivially changed, count only added and modified lines in the
patched code. Consider an added or changed line non-trivial if it
includes at least one identifier, string, or substantial comment.)
Ask on emacs-devel@gnu.org, and we will send you the necessary form
together with the instructions to fill and email it, in order to start
this legal paperwork.
In most cases, to start the assignment process you should download
https://git.savannah.gnu.org/cgit/gnulib.git/plain/doc/Copyright/request-assign.future
and return the completed information to the address at the top.
(There are other assignment options, but they are much less commonly used.)
If you have questions about the assignment process, you can ask the
address listed on the form, and/or emacs-devel@gnu.org.
** Issue tracker (a.k.a. "bug tracker")

377
ChangeLog.3
View file

@ -1,3 +1,379 @@
2021-03-25 Eli Zaretskii <eliz@gnu.org>
* Version 27.2 released.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
* etc/HISTORY: Update for Emacs 27.2.
* README:
* configure.ac:
* nt/README.W32:
* msdos/sed2v2.inp: Set version to 27.2
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Document that `buffer-string' retains text properties
* doc/lispref/text.texi (Buffer Contents): Mention text properties
in the `buffer-string' documentation.
* src/editfns.c (Fbuffer_string): Mention text properties in the
doc string (bug#47220).
(cherry picked from commit 60af754170f22f5d25510af069ed0ebfec95f992)
2021-03-18 Fabrice Bauzac <noon@mykolab.com>
Remove duplicate @table item from ELisp manual
* doc/lispref/objects.texi (Special Read Syntax): Remove duplicate
item "#@N" from the table of Special Read Syntax. (Bug#47200)
2021-03-18 Daniel Martín <mardani29@yahoo.es>
Fix reference to 'diff-font-lock-syntax' in diff-mode documentation
* doc/emacs/files.texi (Diff Mode): Add the omitted name of the
variable. (Bug#47129)
2021-03-18 Alan Third <alan@idiocy.org>
Fix buffer overflow in xbm_scan (bug#47094)
* src/image.c (xbm_scan): Ensure reading a string doesn't overflow the
buffer.
(cherry picked from commit ebc3b25409dd614c1814a0643960452683e37aa3)
2021-03-18 Matt Armstrong <matt@rfc20.org>
Fix typos and omissions for (elisp)Button Buffer Commands
* doc/lispref/display.texi (Button Buffer Commands): Minor
typo and omission fixes `backward-button' and
`forward-button'. (Bug#47051)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Teach Rmail about NBSP in "Re:"
* lisp/mail/rmail.el (rmail-simplified-subject)
(rmail-reply-regexp): Allow NBSP in "RE:" prefixes.
2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
Revert "* lisp/mouse.el: Fix mouse-1-clock-follows-mouse = double"
This reverts commit 02a5cfce471613f671722b35536d2a78f17b0429.
That commit breaks because of a missing patch to `parse_modifiers_uncached`
in `src/keyboard.c`. IOW, too risky for `emacs-27`.
Don't merge to `master`.
2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/mouse.el: Fix mouse-1-clock-follows-mouse = double
This functionality was broken by commit 3d5e31eceb9dc1fb62b2b2,
the problem being that we end up considering as distinct the events
`down-double-mouse-1` and `double-down-mouse-1`.
Reported by Eyal Soha <eyalsoha@gmail.com>
(mouse--click-1-maybe-follows-link): Make sure the last element of
the list passed to `event-convert-list` is indeed a "basic" event.
2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/emacs-lisp/gv.el (edebug-after): Don't run the getter in the setter
This fixes bug#46573 which was introduced by commit
d79cf638f278e50c22feb53d6ba556f5ce9d7853.
The new code is a middle ground, which makes sure the instrumentation
point is used (so the coverage checker won't have ghost unreachable
instrumentation points) yet without artificially running the getter
when we only need to run the setter.
2021-03-18 Masahiro Nakamura <tsuucat@icloud.com>
* doc/misc/tramp.texi (Remote shell setup): Fix reference. (Do not merge)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Fix initialization of 'while-no-input-ignore-events'
* src/keyboard.c (syms_of_keyboard_for_pdumper): Don't reset
'while-no-input-ignore-events' after loading the dump file.
(Bug#46940)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Update documentation of reading passwords
* doc/emacs/mini.texi (Passwords): Update to match the modified
implementation. (Bug#46902) Add indexing.
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Improve the 'dired-do-kill-lines' doc string
* lisp/dired-aux.el (dired-do-kill-lines): Document the FMT
parameter (bug#46867).
(cherry picked from commit b9cb3b904008a80c69ab433f4851377967b100db)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Avoid crashes in Mew due to corrupted tool-bar label
* src/gtkutil.c (update_frame_tool_bar): Don't keep around a
'char *' pointer to a Lisp string's contents when calling Lisp,
because that could relocate string data; keep the Lisp string
itself instead. This avoids crashes in Mew. (Bug#46791)
2021-03-18 Stefan Kangas <stefan@marxist.se>
* lisp/tooltip.el (tooltip): Doc fix for GTK.
2021-03-18 Stefan Kangas <stefan@marxist.se>
* lisp/help.el (help-for-help-internal): Doc fix; use imperative.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
More accurate documentation of the "r" interactive spec
* doc/lispref/commands.texi (Interactive Codes): Describe the
effect of 'mark-even-if-inactive'.
2021-03-18 Stefan Kangas <stefan@marxist.se>
Mention the GNU Kind Communications Guidelines in the FAQ
* doc/misc/efaq.texi (Guidelines for newsgroup postings): Mention
the GNU Kind Communications Guidelines.
2021-03-18 Ryan Prior <rprior@protonmail.com> (tiny change)
Allow newlines in password prompts again in comint
* lisp/comint.el (comint-password-prompt-regexp): Match all
whitespace (including newline) at the end of the passphrase, not
just space and \t (bug#46609).
(comint-watch-for-password-prompt): Remove trailing newlines from
the prompt (bug#46609).
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Avoid point movement when visiting image files
* lisp/image-mode.el (image-toggle-display-image): Preserve point
around the call to exif-parse-buffer, to prevent it from moving
into the image data. (Bug#46552)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Avoid assertion violation in callproc.c
* src/callproc.c (call_process): Avoid assertion violation when
DESTINATION is a cons cell '(:file . "FOO")'. (Bug#46426)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Clarify "changes" in CONTRIBUTE
* CONTRIBUTE: Clarify that "changes" doesn't include removing code
(bug#44834).
(cherry picked from commit 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Clarify when activate-mark-hook is run
* doc/lispref/markers.texi (The Mark):
* lisp/simple.el (activate-mark-hook): Clarify when the hook is
run (bug#23444).
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Fix language-environment and font selection on MS-Windows
These changes improve setting the language-environment and font
selection when MS-Windows returns useless "ZZZ" as the "language
name", which then disrupts all the setup of the locale-dependent
stuff, and in particular font selection.
* lisp/w32-fns.el (w32-charset-info-alist): Add an element for
"iso8859-5", in case LANG is set to something unusable, like
"ZZZ". This allows fonts capable of displaying Cyrillic
characters to be used even when language preferences are screwed.
* src/w32.c (init_environment): If GetLocaleInfo returns "ZZZ" as
the "language name" for LOCALE_USER_DEFAULT, try again with locale
ID based on what GetUserDefaultUILanguage returns. (Bug#39286)
2021-03-18 Petteri Hintsanen <petterih@iki.fi>
Fix example in Sequence Functions node in the manual
* doc/lispref/sequences.texi (Sequence Functions): Fix the result
from the example.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Improve doc string of 'text-scale-adjust'
* lisp/face-remap.el (text-scale-adjust): Clarify that "default
face height" refers to the 'default' face. (Bug#25168)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Clarify the indent-rigidly doc string
* lisp/indent.el (indent-rigidly): Clarify exiting the transient
mode (bug#46296).
2021-03-18 Martin Rudalics <rudalics@gmx.at>
Fix two small tab bar issues
* lisp/cus-start.el (frame-inhibit-implied-resize): Update version tag.
* lisp/frame.el (frame-inner-height): Do not count in tab bar.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Fix last change in syntax.texi
* doc/lispref/syntax.texi (Syntax Properties): Fix wording in last
change. (Bug#46274)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Correct the lispref manual about flushing ppss info
* doc/lispref/syntax.texi (Syntax Properties): Correct the
information about flushing the state by copying the text from the
doc string (bug#46274).
(cherry picked from commit ff701ce2b261acce1dfcd1fe137268d87d5eab35)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Clarify how transient indentation modes are exited in the manual
* doc/emacs/indent.texi (Indentation Commands): Clarify that the
other keys don't just exit the transient mode, but are also
handled as normally (bug#46296).
2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
Fix the previous change
* lisp/progmodes/project.el (project-find-regexp):
Fix the previous change (project-root is not defined in this version).
(project-or-external-find-regexp): Same.
2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
Bind default-directory to the project root
* lisp/progmodes/project.el (project-find-regexp):
Bind default-directory to the project root, to save this value
in the resulting buffer (esp. if the project selector was used,
(https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg00140.html).
(project-or-external-find-regexp): Same.
(cherry picked from commit c07ebfcbe084e8219d8c2588f23f77ba4ef39087)
2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
Make sure default-directory relates to the originating buffer
* lisp/progmodes/xref.el (xref--show-xref-buffer):
Pick up default-directory value from the caller
(https://lists.gnu.org/archive/html/emacs-devel/2021-01/msg00551.html).
(xref-show-definitions-buffer-at-bottom): Same.
(cherry picked from commit 6e73e07a6f5cbdd1c5ae6e0f3fbd0f8f56813f1a)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Initialize signal descriptions after pdumping
* src/sysdep.c (init_signals) [!HAVE_DECL_SYS_SIGLIST]: Reinit
sys_siglist also after pdumping. (Bug#46284)
2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
Clarify the "Sentinels" node in the lispref manual
* doc/lispref/processes.texi (Sentinels): Mention "run" and that
the strings can be anything (bug#30461).
(cherry picked from commit 859a4cb6b22f75a3456e29d08fcfe9b8940fbe8b)
2021-03-18 Alexandre Duret-Lutz <adl@lrde.epita.fr> (tiny change)
Fix problem with non-ASCII characters in nnmaildir
* lisp/gnus/nnmaildir.el (nnmaildir-request-article): Enable
multipart 8bit-content-transfer-encoded files to be displayed
correctly by reading as `raw-text' instead of having Emacs
(incorrectly) decode the files (bug#44307).
2021-03-18 Eli Zaretskii <eliz@gnu.org>
* lisp/window.el (recenter-top-bottom): Clarify doc string.
2021-03-18 Thomas Fitzsimmons <fitzsim@fitzsim.org>
url-http.el: Special-case NTLM authentication
* lisp/url/url-http.el (url-http-handle-authentication): Do not
signal an error on NTLM authorization strings. (Bug#43566)
2021-03-18 Juri Linkov <juri@linkov.net>
* lisp/isearch.el (isearch-lazy-highlight): Fix defcustom type (bug#46208)
2021-03-18 Stefan Kangas <stefan@marxist.se>
Sync latest SKK-JISYO.L
* leim/SKK-DIC/SKK-JISYO.L: Sync to current upstream version.
2021-03-18 Alan Third <alan@idiocy.org>
Fix build failure on macOS 10.7 (bug#46036)
* src/nsfns.m (ns_set_represented_filename): Define the NSNumber in a
more compatible manner.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Improve documentation of auto-resize-tool/tab-bars
* src/xdisp.c (syms_of_xdisp) <auto-resize-tool-bars>
<auto-resize-tab-bars>: Doc fix. (Bug#46178)
2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
(xref-revert-buffer): Also 'erase-buffer' when handling a user-error
* lisp/progmodes/xref.el (xref-revert-buffer):
Also 'erase-buffer' when handling a user-error (bug#46042).
(cherry picked from commit e86b30d6fd04070b86560774ec82392dbe24ca1e)
2021-03-18 Eli Zaretskii <eliz@gnu.org>
Update files for 27.1.91 pretest
* ChangeLog.3:
* etc/AUTHORS
* lisp/ldefs-boot.el: Update.
2021-03-18 Eli Zaretskii <eliz@gnu.org>
2021-02-03 Eli Zaretskii <eliz@gnu.org>
Bump Emacs version to 27.1.91
@ -144446,6 +144822,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
2021-03-18bd67a4f40a733cb139ace3af4616bc2702282 (inclusive).
2021-02-03d9244f7cbef9f91e697ad5fc0ce49ec97 (inclusive).
commit 1ca4da054be7eb340c511d817f3ec89c8b819db7 (inclusive).
See ChangeLog.2 for earlier changes.

26
admin/make-tarball.txt
View file

@ -33,6 +33,11 @@ General steps (for each step, check for possible errors):
or some form of "git clean -x". It's probably simpler and safer to
make a new working directory exclusively for the release branch.
If the working directory has subdirectories created when making
previous releases or pretests, remove those subdirectories, as the
command which updates the ChangeLog file might attempt to recurse
there and scan any ChangeLog.* files there.
Make sure the tree is built, or at least configured. That's
because some of the commands below run Make, so they need
Makefiles to be present.
@ -68,20 +73,23 @@ General steps (for each step, check for possible errors):
3. Set the version number (M-x load-file RET admin/admin.el RET, then
M-x set-version RET). For a pretest, start at version .90. After
.99, use .990 (so that it sorts).
.99, use .990 (so that it sorts). Commit the resulting changes
as one, with nothing else included, and using a log message
of the format "Bump Emacs version to ...", so that the commit can
be skipped when merging branches (see admin/gitmerge.el).
The final pretest should be a release candidate.
Before a release candidate is made, the tasks listed in
admin/release-process must be completed.
Set the version number to that of the actual release. Pick a date
about a week from now when you intend to make the release. Use M-x
add-release-logs to add entries to etc/HISTORY and the ChangeLog
file. It's best not to commit these files until the release is
actually made. Merge the entries from (unversioned) ChangeLog
into the top of the current versioned ChangeLog.N and commit that
along with etc/HISTORY. Then you can tag that commit as the
release.
Set the version number to that of the actual release (commit in
one, as described above). Pick a date about a week from now when
you intend to make the release. Use M-x add-release-logs to add
entries to etc/HISTORY and the ChangeLog file. It's best not to
commit these files until the release is actually made. Merge the
entries from (unversioned) ChangeLog into the top of the current
versioned ChangeLog.N and commit that along with etc/HISTORY.
Then you can tag that commit as the release.
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

5
configure.ac
View file

@ -3972,6 +3972,11 @@ case $with_json,$HAVE_JSON in
WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";;
esac
if test "X${MISSING}" != X; then
# If we have a missing library, and we don't have pkg-config installed,
# the missing pkg-config may be the reason. Give the user a hint.
if test "X${PKG_CONFIG}" = X; then
AC_MSG_WARN([Unable to locate a usable pkg-config])
fi
AC_MSG_ERROR([The following required libraries were not found:
$MISSING
Maybe some development libraries/packages are missing?

5
doc/emacs/files.texi
View file

@ -1670,8 +1670,9 @@ modify the original (``old'') source files rather than the patched
(``new'') source files.
@vindex diff-font-lock-syntax
If non-@code{nil}, fragments of source in hunks are highlighted
according to the appropriate major mode.
If @code{diff-font-lock-syntax} is non-@code{nil}, fragments of
source in hunks are highlighted according to the appropriate major
mode.
@node Copying and Naming
@section Copying, Naming and Renaming Files

3
doc/lispref/debugging.texi
View file

@ -1041,7 +1041,8 @@ functions written in Lisp, it cannot profile Emacs primitives.
@cindex @file{benchmark.el}
@cindex benchmarking
You can measure the time it takes to evaluate individual Emacs Lisp
forms using the @file{benchmark} library. See the macros
forms using the @file{benchmark} library. See the function
@code{benchmark-call} as well as the macros
@code{benchmark-run}, @code{benchmark-run-compiled} and
@code{benchmark-progn} in @file{benchmark.el}. You can also use the
@code{benchmark} command for timing forms interactively.

6
doc/lispref/display.texi
View file

@ -7056,11 +7056,11 @@ end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
buttons can be found. If @var{no-error} in non-@code{nil}, return nil
buttons can be found. If @var{no-error} is non-@code{nil}, return nil
instead of signaling the error.
@end deffn
@deffn Command backward-button n &optional wrap display-message
@deffn Command backward-button n &optional wrap display-message no-error
Move to the @var{n}th previous button, or @var{n}th next button if
@var{n} is negative. If @var{n} is zero, move to the start of any
button at point. If @var{wrap} is non-@code{nil}, moving past either
@ -7068,7 +7068,7 @@ end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
buttons can be found. If @var{no-error} in non-@code{nil}, return nil
buttons can be found. If @var{no-error} is non-@code{nil}, return nil
instead of signaling the error.
@end deffn

12
doc/lispref/frames.texi
View file

@ -1120,9 +1120,9 @@ The optional fourth argument @var{pixelwise} non-@code{nil} means that
refuse to truly honor the request if it does not increase/decrease the
frame height to a multiple of its character height.
When used interactively, this command will set the height of the
currently selected frame to the number of lines specified by the
numeric prefix.
When used interactively, this command will ask the user for the number
of lines to set the height of the currently selected frame. You can
also provide this value with a numeric prefix.
@end defun
@defun set-frame-width frame width &optional pretend pixelwise
@ -1136,9 +1136,9 @@ The optional fourth argument @var{pixelwise} non-@code{nil} means that
refuse to fully honor the request if it does not increase/decrease the
frame width to a multiple of its character width.
When used interactively, this command will set the width of the
currently selected frame to the number of columns specified by the
numeric prefix.
When used interactively, this command will ask the user for the number
of columns to set the width of the currently selected frame. You can
also provide this value with a numeric prefix.
@end defun
None of these three functions will make a frame smaller than needed to

3
doc/lispref/modes.texi
View file

@ -3247,8 +3247,7 @@ set by means of @var{other-vars} in @code{font-lock-defaults}
@defvar font-lock-mark-block-function
If this variable is non-@code{nil}, it should be a function that is
called with no arguments, to choose an enclosing range of text for
refontification for the command @kbd{M-o M-o}
(@code{font-lock-fontify-block}).
refontification for the command @kbd{M-x font-lock-fontify-block}.
The function should report its choice by placing the region around it.
A good choice is a range of text large enough to give proper results,

3
doc/lispref/objects.texi
View file

@ -148,9 +148,6 @@ starting list count:
object, so when reading back the object, they will be the same object
instead of copies (@pxref{Circular Objects}).
@item #@@N
Skip the next @samp{N} characters (@pxref{Comments}).
@item #xN
@samp{N} represented as a hexadecimal number (@samp{#x2a}).

4
doc/lispref/text.texi
View file

@ -222,7 +222,9 @@ properties, just the characters themselves. @xref{Text Properties}.
@defun buffer-string
This function returns the contents of the entire accessible portion of
the current buffer, as a string.
the current buffer, as a string. If the text being copied has any
text properties, these are copied into the string along with the
characters they belong to.
@end defun
If you need to make sure the resulting string, when copied to a

5
doc/misc/modus-themes.org
View file

@ -10,10 +10,7 @@
#+macro: export-date (eval (format-time-string "%F %R %z" (current-time)))
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
# The "kbd" macro turns KBD into @kbd{KBD}. Additionally, it
# encloses case-sensitive special keys (SPC, RET...) within @key{...}.
# I got this from the Org source code.
#+macro: kbd (eval (let ((case-fold-search nil) (regexp (regexp-opt '("SPC" "RET" "LFD" "TAB" "BS" "ESC" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words))) (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (replace-regexp-in-string regexp "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
#+texinfo_filename: modus-themes.info
#+texinfo_dir_category: Emacs misc features

2
etc/HISTORY
View file

@ -222,6 +222,8 @@ GNU Emacs 26.3 (2019-08-28) emacs-26.3
GNU Emacs 27.1 (2020-08-10) emacs-27.1
GNU Emacs 27.2 (2021-03-25) emacs-27.2
----------------------------------------------------------------------
This file is part of GNU Emacs.

63
etc/NEWS
View file

@ -93,6 +93,10 @@ useful on systems such as FreeBSD which ships only with "etc/termcap".
* Changes in Emacs 28.1
+++
** New command 'font-lock-update', bound to 'C-x x f'.
This command updates the syntax highlighting in this buffer.
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+++
@ -250,8 +254,12 @@ search buffer due to too many matches being highlighted.
The 'C-x x' keymap now holds keystrokes for various buffer-oriented
commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t'
('toggle-truncate-lines').
('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t'
('toggle-truncate-lines') and 'C-x x f' ('font-lock-update').
---
** Commands 'set-frame-width' and 'set-frame-height' can now get their
input using the minibuffer.
* Editing Changes in Emacs 28.1
@ -385,6 +393,11 @@ major mode.
* Changes in Specialized Modes and Packages in Emacs 28.1
** Benchmark
*** New function 'benchmark-call' to measure the execution time of a function.
Additionally, the number of repetitions can be expressed as a minimal duration
in seconds.
** Macroexp
---
*** New function 'macroexp-file-name' to know the name of the current file.
@ -420,6 +433,9 @@ to nil. This was already sometimes the case, but it is now guaranteed.
This is like '(pred (lambda (x) (not (FUN x))))' but results
in better code.
---
*** New function 'pcase-compile-patterns' to write other macros.
+++
** profiler.el
The results displayed by 'profiler-report' now have the usage figures
@ -519,7 +535,7 @@ It can be used to enable/disable the tab bar individually on each frame
independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
---
*** New option 'tab-bar-format' defines a list of tab bar items.
*** New user option 'tab-bar-format' defines a list of tab bar items.
When it contains 'tab-bar-format-global' (possibly appended after
'tab-bar-format-align-right'), then after enabling 'display-time-mode'
(or any other mode that uses 'global-mode-string') it displays time
@ -545,6 +561,8 @@ It also supports a negative argument.
---
*** 'C-x t G' assigns a group name to the tab.
'tab-close-group' can close all tabs that belong to the selected group.
The user option 'tab-bar-new-tab-group' defines the default group of a
new tab.
---
*** New user option 'tab-bar-tab-name-format-function'.
@ -1919,6 +1937,12 @@ highlight the current error message in the 'next-error' buffer.
This user option can be also customized to keep highlighting on all
visited errors, so you can have an overview what errors were already visited.
---
*** New choice 'next-error-quit-window' for 'next-error-found-function'.
When 'next-error-found-function' is customized to 'next-error-quit-window',
then typing the numeric prefix argument 0 before the command 'next-error'
will quit the source window after visiting the next occurrence.
+++
*** New user option 'tab-first-completion'.
If 'tab-always-indent' is 'complete', this new user option can be used to
@ -2239,12 +2263,28 @@ first).
* Incompatible Editing Changes in Emacs 28.1
** The 'M-o' ('facemenu-keymap') global binding has been removed.
To restore the old binding, say something like:
(require 'facemenu)
(define-key global-map "\M-o" 'facemenu-keymap)
(define-key facemenu-keymap "\es" 'center-line)
(define-key facemenu-keymap "\eS" 'center-paragraph)
The last two lines are not strictly necessary if you don't care about
having those two commands on the 'M-o' keymap; see the next section.
** The 'M-o M-s' and 'M-o M-S' global bindings have been removed.
Use 'M-x center-line' and 'M-x center-paragraph' instead.
Use 'M-x center-line' and 'M-x center-paragraph' instead. See the
previous section for how to get back the old bindings. Alternatively,
if you only want these two commands to have global bindings they had
before, you can add the following to your init file:
** The 'M-o M-o' global binding have been removed.
Use 'M-x font-lock-fontify-block' instead.
(define-key global-map "\M-o\M-s" 'center-line)
(define-key global-map "\M-o\M-S" 'center-paragraph)
** The 'M-o M-o' global binding has been removed.
Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f'
command, which updates the syntax highlighting in the current buffer.
** In 'f90-mode', the backslash character ('\') no longer escapes.
For about a decade, the backslash character has no longer had a
@ -2263,6 +2303,12 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
** 'facemenu-color-alist' is now obsolete, and is not used.
** 'facemenu.el' is no longer preloaded.
To use functions/variables from the package, you now have to say
'(require 'facemenu)' or similar.
** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'.
** 'completions-annotations' face is not used when the caller puts own face.
@ -2804,6 +2850,11 @@ semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
these functions now accept top-level JSON values that are neither
arrays nor objects.
---
** 'while-no-input-ignore-events' accepts more special events.
The special events 'dbus-event' and 'file-notify' are now ignored in
'while-no-input' when added to this variable.
* Changes in Emacs 28.1 on Non-Free Operating Systems

24
etc/NEWS.27
View file

@ -15,18 +15,6 @@ in older Emacs versions.
You can narrow news to a specific version by calling 'view-emacs-news'
with a prefix argument or by typing 'C-u C-h C-n'.
Temporary note:
+++ indicates that all relevant manuals in doc/ have been updated.
--- means no change in the manuals is needed.
When you add a new item, use the appropriate mark if you are sure it
applies, and please also update docstrings as needed.
* Installation Changes in Emacs 27.2
* Startup Changes in Emacs 27.2
* Changes in Emacs 27.2
@ -40,9 +28,6 @@ If set to a non-nil value which isn't a function, resize the mini
frame using the new function 'fit-mini-frame-to-buffer' which won't
skip leading or trailing empty lines of the buffer.
* Editing Changes in Emacs 27.2
* Changes in Specialized Modes and Packages in Emacs 27.2
@ -50,15 +35,6 @@ skip leading or trailing empty lines of the buffer.
*** The user option 'tramp-completion-reread-directory-timeout' is now obsolete.
* New Modes and Packages in Emacs 27.2
* Incompatible Lisp Changes in Emacs 27.2
* Lisp Changes in Emacs 27.2
* Changes in Emacs 27.2 on Non-Free Operating Systems

16
etc/themes/modus-themes.el
View file

@ -4,7 +4,7 @@
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
;; Version: 1.2.3
;; Version: 1.2.4
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
@ -386,6 +386,20 @@
;; - modus-operandi-theme.el (Light theme)
;; - modus-vivendi-theme.el (Dark theme)
;;; News:
;;
;; Users updating from older versions to >= 1.0.0, are advised to read
;; the anouncement on the emacs-devel mailing list:
;; <https://lists.gnu.org/archive/html/emacs-devel/2021-03/msg00300.html>.
;;
;; The web page of the change log is also available:
;; <https://protesilaos.com/modus-themes-changelog/>.
;;
;; An Info manual should be distributed with the Modus themes.
;; Evaluate this form to access it directly:
;;
;; (info "(modus-themes) Top")
;;; Code:

3
lisp/bindings.el
View file

@ -1211,7 +1211,7 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key global-map [kp-9] 'function-key-error)
;; (define-key global-map [kp-equal] 'function-key-error)
;; X11R6 distinguishes these keys from the non-kp keys.
;; X11 distinguishes these keys from the non-kp keys.
;; Make them behave like the non-kp keys unless otherwise bound.
;; FIXME: rather than list such mappings for every modifier-combination,
;; we should come up with a way to do it generically, something like
@ -1432,6 +1432,7 @@ if `inhibit-field-text-motion' is non-nil."
(defvar ctl-x-x-map
(let ((map (make-sparse-keymap)))
(define-key map "f" #'font-lock-update)
(define-key map "g" #'revert-buffer)
(define-key map "r" #'rename-buffer)
(define-key map "u" #'rename-uniquely)

4
lisp/calendar/appt.el
View file

@ -700,7 +700,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
(remove-hook 'write-file-functions #'appt-update-list 'local)
(remove-hook 'write-file-functions #'appt-update-list)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@ -708,7 +708,7 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
(add-hook 'write-file-functions #'appt-update-list nil t)
(add-hook 'write-file-functions #'appt-update-list)
(setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))

2
lisp/cedet/cedet-cscope.el
View file

@ -1,6 +1,6 @@
;;; cedet-cscope.el --- CScope support for CEDET -*- lexical-binding: t; -*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet

46
lisp/cedet/ede/custom.el
View file

@ -133,47 +133,45 @@ OBJ is the target object to customize."
(defun ede-project-sort-targets-list ()
"Sort the target list while using `ede-project-sort-targets'."
(save-excursion
(let ((count 0)
(targets (oref ede-object-project targets))
(let ((targets (oref ede-object-project targets))
(inhibit-read-only t)
(inhibit-modification-hooks t))
(goto-char (point-min))
(forward-line 2)
(delete-region (point) (point-max))
(while (< count (length targets))
(dotimes (count (length targets))
(if (> count 0)
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(let ((cur ede-project-sort-targets-order))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth ,count cur)
(1- ,count))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth (1- ,count) cur) ,count))
(ede-project-sort-targets-list))
:notify (lambda (&rest _ignore)
(let ((cur ede-project-sort-targets-order))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth count cur)
(1- count))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth (1- count) cur) count))
(ede-project-sort-targets-list))
" Up ")
(widget-insert " "))
(if (< count (1- (length targets)))
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(let ((cur ede-project-sort-targets-order))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth ,count cur) (1+ ,count))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth (1+ ,count) cur) ,count))
(ede-project-sort-targets-list))
:notify (lambda (&rest _ignore)
(let ((cur ede-project-sort-targets-order))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth count cur) (1+ count))
(add-to-ordered-list
'ede-project-sort-targets-order
(nth (1+ count) cur) count))
(ede-project-sort-targets-list))
" Down ")
(widget-insert " "))
(widget-insert (concat " " (number-to-string (1+ count)) ".: "
(oref (nth (nth count ede-project-sort-targets-order)
targets)
name)
"\n"))
(setq count (1+ count))))))
"\n"))))))
;;; Customization hooks
;;

2
lisp/cedet/ede/make.el
View file

@ -1,6 +1,6 @@
;;; ede/make.el --- General information about "make" -*- lexical-binding: t -*-
;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>

3
lisp/cedet/ede/pconf.el
View file

@ -1,7 +1,6 @@
;;; ede/pconf.el --- configure.ac maintenance for EDE -*- lexical-binding: t; -*-
;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
;;; Inc.
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project

16
lisp/cedet/ede/pmake.el
View file

@ -266,14 +266,14 @@ Execute BODY in a location where a value can be placed."
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
(declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(unless
(save-excursion
(re-search-backward (concat "^" v "\\s-*=") nil t))
(insert v "=")
,@body
(when addcr (insert "\n"))
(goto-char (point-max)))))
`(let ((v ,varname))
(unless
(save-excursion
(re-search-backward (concat "^" v "\\s-*=") nil t))
(insert v "=")
,@body
(insert "\n")
(goto-char (point-max)))))
;;; SOURCE VARIABLE NAME CONSTRUCTION

7
lisp/cedet/ede/proj-comp.el
View file

@ -249,13 +249,12 @@ This will prevent rules from creating duplicate variables or rules."
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
(declare (indent 1) (debug (sexp body)))
`(let ((addcr t) (v ,varname))
`(let ((v ,varname))
(unless (re-search-backward (concat "^" v "\\s-*=") nil t)
(insert v "=")
,@body
(if addcr (insert "\n"))
(goto-char (point-max)))
))
(insert "\n")
(goto-char (point-max)))))
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."

3
lisp/cedet/ede/proj-info.el
View file

@ -1,7 +1,6 @@
;;; ede-proj-info.el --- EDE Generic Project texinfo support -*- lexical-binding: t; -*-
;;; Copyright (C) 1998-2001, 2004, 2007-2021 Free Software Foundation,
;;; Inc.
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make

3
lisp/cedet/ede/proj-obj.el
View file

@ -1,7 +1,6 @@
;;; ede/proj-obj.el --- EDE Generic Project Object code generation support -*- lexical-binding: t; -*-
;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
;;; Inc.
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make

2
lisp/cedet/ede/proj-shared.el
View file

@ -1,6 +1,6 @@
;;; ede-proj-shared.el --- EDE Generic Project shared library support -*- lexical-binding: t; -*-
;;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make

101
lisp/cedet/pulse.el
View file

@ -30,10 +30,9 @@
;;
;; The following are useful entry points:
;;
;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
;; `pulse-tick' - Cause `pulse-highlight-face' to shift toward background color.
;; Assumes you are using a version of Emacs that supports pulsing.
;;
;;
;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
;; `pulse-momentary-highlight-region' - Pulse a region.
;; `pulse-momentary-highlight-overlay' - Pulse an overlay.
@ -50,7 +49,9 @@
;;
;; Pulse is a part of CEDET. http://cedet.sf.net
(defun pulse-available-p ()
(require 'color)
(defun pulse-available-p ()
"Return non-nil if pulsing is available on the current frame."
(condition-case nil
(let ((v (color-values (face-background 'default))))
@ -90,69 +91,27 @@ Face used for temporary highlighting of tags for effect."
:group 'pulse)
;;; Code:
;;
(defun pulse-int-to-hex (int &optional nb-digits)
"Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
Each X in the output string is a hexadecimal digit.
NB-DIGITS is the number of hex digits. If INT is too large to be
represented with NB-DIGITS, then the result is truncated from the
left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
the hex equivalent of 256 decimal is 100, which is more than 2 digits.
This function was blindly copied from hexrgb.el by Drew Adams.
https://www.emacswiki.org/emacs/hexrgb.el"
(setq nb-digits (or nb-digits 4))
(substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
(defun pulse-color-values-to-hex (values)
"Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
Each X in the string is a hexadecimal digit.
Input VALUES is as for the output of `x-color-values'.
This function was blindly copied from hexrgb.el by Drew Adams.
https://www.emacswiki.org/emacs/hexrgb.el"
(concat "#"
(pulse-int-to-hex (nth 0 values) 4) ; red
(pulse-int-to-hex (nth 1 values) 4) ; green
(pulse-int-to-hex (nth 2 values) 4))) ; blue
(defcustom pulse-iterations 10
"Number of iterations in a pulse operation."
:group 'pulse
:type 'number)
(defcustom pulse-delay .03
"Delay between face lightening iterations."
:group 'pulse
:type 'number)
(defun pulse-lighten-highlight ()
"Lighten the face by 1/`pulse-iterations' toward the background color.
Return t if there is more drift to do, nil if completed."
(if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
nil
(let* ((frame (color-values (face-background 'default)))
(pulse-background (face-background
(get 'pulse-highlight-face
:startface)
nil t)));; can be nil
(when pulse-background
(let* ((start (color-values pulse-background))
(frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
(/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
(/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
(it (get 'pulse-highlight-face :iteration))
)
(set-face-background 'pulse-highlight-face
(pulse-color-values-to-hex
(list
(+ (nth 0 start) (* (nth 0 frac) it))
(+ (nth 1 start) (* (nth 1 frac) it))
(+ (nth 2 start) (* (nth 2 frac) it)))))
(put 'pulse-highlight-face :iteration (1+ it))
(if (>= (1+ it) pulse-iterations)
nil
t)))
)))
;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
"The current pulsing overlay.")
(defvar pulse-momentary-timer nil
"The current pulsing timer.")
(defvar pulse-momentary-iteration 0
"The current pulsing iteration.")
(defun pulse-reset-face (&optional face)
"Reset the pulse highlighting FACE."
@ -166,15 +125,7 @@ Return t if there is more drift to do, nil if completed."
(face-extend-p face nil t)))
(put 'pulse-highlight-face :startface (or face
'pulse-highlight-start-face))
(put 'pulse-highlight-face :iteration 0))
;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
"The current pulsing overlay.")
(defvar pulse-momentary-timer nil
"The current pulsing timer.")
(setq pulse-momentary-iteration 0))
(defun pulse-momentary-highlight-overlay (o &optional face)
"Pulse the overlay O, unhighlighting before next command.
@ -201,14 +152,22 @@ Optional argument FACE specifies the face to do the highlighting."
;; Thus above we put our face on the overlay, but pulse
;; with a reference face needed for the color.
(pulse-reset-face face)
(setq pulse-momentary-timer
(run-with-timer 0 pulse-delay #'pulse-tick
(time-add nil
(* pulse-delay pulse-iterations)))))))
(let* ((start (color-name-to-rgb
(face-background 'pulse-highlight-start-face)))
(stop (color-name-to-rgb (face-background 'default)))
(colors (mapcar (apply-partially 'apply 'color-rgb-to-hex)
(color-gradient start stop pulse-iterations))))
(setq pulse-momentary-timer
(run-with-timer 0 pulse-delay #'pulse-tick
colors
(time-add nil
(* pulse-delay pulse-iterations))))))))
(defun pulse-tick (stop-time)
(defun pulse-tick (colors stop-time)
(if (time-less-p nil stop-time)
(pulse-lighten-highlight)
(when-let (color (elt colors pulse-momentary-iteration))
(set-face-background 'pulse-highlight-face color)
(setq pulse-momentary-iteration (1+ pulse-momentary-iteration)))
(pulse-momentary-unhighlight)))
(defun pulse-momentary-unhighlight ()

17
lisp/cedet/semantic/analyze/debug.el
View file

@ -1,6 +1,6 @@
;;; semantic/analyze/debug.el --- Debug the analyzer -*- lexical-binding: t; -*-
;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -593,19 +593,20 @@ Look for key expressions, and add push-buttons near them."
(setq-local semantic-analyzer-debug-orig orig-buffer)
;; First, add do-in buttons to recommendations.
(while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
(let ((fcn (match-string 1)))
(when (not (fboundp (intern-soft fcn)))
(let* ((fcn (match-string 1))
(fsym (intern-soft fcn)))
(when (not (fboundp fsym))
(error "Help Err: Can't find %s" fcn))
(end-of-line)
(insert " ")
(insert-button "[ Do It ]"
'mouse-face 'custom-button-pressed-face
'do-fcn fcn
'action `(lambda (arg)
(let ((M semantic-analyzer-debug-orig))
(set-buffer (marker-buffer M))
(goto-char M))
(call-interactively (quote ,(intern-soft fcn))))))))
'action (lambda (_arg)
(let ((M semantic-analyzer-debug-orig))
(set-buffer (marker-buffer M))
(goto-char M))
(call-interactively fsym))))))
;; Do something else?
;; Clean up the mess
(set-buffer-modified-p nil))))

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

@ -218,7 +218,7 @@ Uses default implementation, and also gets a list of filenames."
;; but not actually parsed.
(file . "File"))
semantic-case-fold t
semantic-tag-expand-function 'semantic-make-expand-tag
semantic-tag-expand-function #'semantic-make-expand-tag
semantic-lex-syntax-modifications '((?. "_")
(?= ".")
(?/ "_")
@ -226,7 +226,7 @@ Uses default implementation, and also gets a list of filenames."
(?+ ".")
(?\\ ".")
)
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function #'semantic-create-imenu-index
)
(setq semantic-lex-analyzer #'semantic-make-lexer)
)

5
lisp/cedet/semantic/bovine/scm.el
View file

@ -1,6 +1,6 @@
;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile) -*- lexical-binding: t; -*-
;;; Copyright (C) 2001-2004, 2008-2021 Free Software Foundation, Inc.
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -102,8 +102,7 @@ syntax as specified by the syntax table."
(function . "Functions")
(include . "Loads")
(package . "DefineModule"))
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function #'semantic-create-imenu-index
)
(setq semantic-lex-analyzer #'semantic-scheme-lexer)
)

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

@ -1,4 +1,4 @@
;;; semantic/chart.el --- Utilities for use with semantic tag tables
;;; semantic/chart.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
@ -43,7 +43,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(interactive)
(let* ((stream (semantic-something-to-tag-table
(or tagtable (current-buffer))))
(names (mapcar 'cdr semantic-symbol->name-assoc-list))
(names (mapcar #'cdr semantic-symbol->name-assoc-list))
(nums (mapcar
(lambda (symname)
(length
@ -57,7 +57,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
nums "Volume")
))
(defun semantic-chart-database-size (&optional tagtable)
(defun semantic-chart-database-size (&optional _tagtable)
"Create a bar chart representing the size of each file in semanticdb.
Each bar represents how many toplevel tags in TAGTABLE
exist in each database entry.
@ -68,7 +68,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(error "Semanticdb is not enabled"))
(let* ((db semanticdb-current-database)
(dbt (semanticdb-get-database-tables db))
(names (mapcar 'car
(names (mapcar #'car
(object-assoc-list
'file
dbt)))
@ -84,8 +84,8 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(nums nil)
(fh (/ (- (frame-height) 7) 4)))
(setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b)))))
(setq names (mapcar 'cdr numnuts)
nums (mapcar 'car numnuts))
(setq names (mapcar #'cdr numnuts)
nums (mapcar #'car numnuts))
(if (> (length names) fh)
(progn
(setcdr (nthcdr fh names) nil)

123
lisp/cedet/semantic/complete.el
View file

@ -1,4 +1,4 @@
;;; semantic/complete.el --- Routines for performing tag completion
;;; semantic/complete.el --- Routines for performing tag completion -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2005, 2007-2021 Free Software Foundation, Inc.
@ -154,8 +154,8 @@ Presumably if you call this you will insert something new there."
(defun semantic-completion-message (fmt &rest args)
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
(apply 'message fmt args)
(apply 'message (concat "%s" fmt) (buffer-string) args)))
(apply #'message fmt args)
(apply #'message (concat "%s" fmt) (buffer-string) args)))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses
@ -171,14 +171,14 @@ Value should be a ... what?")
(defvar semantic-complete-key-map
(let ((km (make-sparse-keymap)))
(define-key km " " 'semantic-complete-complete-space)
(define-key km "\t" 'semantic-complete-complete-tab)
(define-key km "\C-m" 'semantic-complete-done)
(define-key km "\C-g" 'abort-recursive-edit)
(define-key km "\M-n" 'next-history-element)
(define-key km "\M-p" 'previous-history-element)
(define-key km "\C-n" 'next-history-element)
(define-key km "\C-p" 'previous-history-element)
(define-key km " " #'semantic-complete-complete-space)
(define-key km "\t" #'semantic-complete-complete-tab)
(define-key km "\C-m" #'semantic-complete-done)
(define-key km "\C-g" #'abort-recursive-edit)
(define-key km "\M-n" #'next-history-element)
(define-key km "\M-p" #'previous-history-element)
(define-key km "\C-n" #'next-history-element)
(define-key km "\C-p" #'previous-history-element)
;; Add history navigation
km)
"Keymap used while completing across a list of tags.")
@ -488,7 +488,7 @@ If PARTIAL, do partial completion stopping at spaces."
)
(t nil))))
(defun semantic-complete-do-completion (&optional partial inline)
(defun semantic-complete-do-completion (&optional partial _inline)
"Do a completion for the current minibuffer.
If PARTIAL, do partial completion stopping at spaces.
if INLINE, then completion is happening inline in a buffer."
@ -550,12 +550,12 @@ if INLINE, then completion is happening inline in a buffer."
;; push ourselves out of this mode on alternate keypresses.
(defvar semantic-complete-inline-map
(let ((km (make-sparse-keymap)))
(define-key km "\C-i" 'semantic-complete-inline-TAB)
(define-key km "\M-p" 'semantic-complete-inline-up)
(define-key km "\M-n" 'semantic-complete-inline-down)
(define-key km "\C-m" 'semantic-complete-inline-done)
(define-key km "\C-\M-c" 'semantic-complete-inline-exit)
(define-key km "\C-g" 'semantic-complete-inline-quit)
(define-key km "\C-i" #'semantic-complete-inline-TAB)
(define-key km "\M-p" #'semantic-complete-inline-up)
(define-key km "\M-n" #'semantic-complete-inline-down)
(define-key km "\C-m" #'semantic-complete-inline-done)
(define-key km "\C-\M-c" #'semantic-complete-inline-exit)
(define-key km "\C-g" #'semantic-complete-inline-quit)
(define-key km "?"
(lambda () (interactive)
(describe-variable 'semantic-complete-inline-map)))
@ -620,7 +620,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer."
"Exit inline completion mode."
(interactive)
;; Remove this hook FIRST!
(remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
(remove-hook 'pre-command-hook #'semantic-complete-pre-command-hook)
(condition-case nil
(progn
@ -649,7 +649,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer."
;; Remove this hook LAST!!!
;; This will force us back through this function if there was
;; some sort of error above.
(remove-hook 'post-command-hook 'semantic-complete-post-command-hook)
(remove-hook 'post-command-hook #'semantic-complete-post-command-hook)
;;(message "Exiting inline completion.")
)
@ -770,8 +770,8 @@ END is at the end of the current symbol being completed."
(overlay-put semantic-complete-inline-overlay
'semantic-original-start start)
;; Install our command hooks
(add-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
(add-hook 'post-command-hook 'semantic-complete-post-command-hook)
(add-hook 'pre-command-hook #'semantic-complete-pre-command-hook)
(add-hook 'post-command-hook #'semantic-complete-post-command-hook)
;; Go!
(semantic-complete-inline-force-display)
)
@ -929,8 +929,8 @@ The only options available for completion are those which can be logically
inserted into the current context.")
(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist."
((obj semantic-collector-analyze-completions) prefix _completionlist)
"calculate the completions for prefix from COMPLETIONLIST."
;; if there are no completions yet, calculate them.
(if (not (slot-boundp obj 'first-pass-completions))
(oset obj first-pass-completions
@ -943,7 +943,7 @@ inserted into the current context.")
prefix
(oref obj first-pass-completions)))))
(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
(cl-defmethod semantic-collector-cleanup ((_obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
@ -1004,7 +1004,7 @@ Output must be in semanticdb Find result format."
(list (cons table result)))))
(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
((obj semantic-collector-abstract) prefix _partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
(same-prefix-p (semantic-collector-last-prefix= obj prefix))
@ -1014,7 +1014,8 @@ Output must be in semanticdb Find result format."
(cond ((or same-prefix-p
(and last-prefix (eq (compare-strings
last-prefix 0 nil
prefix 0 (length last-prefix)) t)))
prefix 0 (length last-prefix))
t)))
;; We have the same prefix, or last-prefix is a
;; substring of the of new prefix, in which case we are
;; refining our symbol so just re-use cache.
@ -1023,7 +1024,8 @@ Output must be in semanticdb Find result format."
(> (length prefix) 1)
(eq (compare-strings
prefix 0 nil
last-prefix 0 (length prefix)) t))
last-prefix 0 (length prefix))
t))
;; The new prefix is a substring of the old
;; prefix, and it's longer than one character.
;; Perform a full search to pull in additional
@ -1134,7 +1136,7 @@ into a buffer."
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
(cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix)
((obj semantic-collector-abstract) _prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
matching PREFIX."
@ -1142,7 +1144,7 @@ matching PREFIX."
(oref obj last-all-completions)))
(cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix)
((obj semantic-collector-abstract) _prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
Return nil for no match.
@ -1153,7 +1155,7 @@ with that name."
(oref obj last-completion)))
(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
((_obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
@ -1176,7 +1178,7 @@ These collectors track themselves on a per-buffer basis."
:abstract t)
(cl-defmethod make-instance ((this (subclass semantic-collector-buffer-abstract))
&rest args)
&rest _args)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
(bl semantic-collector-per-buffer-list))
@ -1193,7 +1195,7 @@ These collectors track themselves on a per-buffer basis."
old))
;; Buffer specific collectors should flush themselves
(defun semantic-collector-buffer-flush (newcache)
(defun semantic-collector-buffer-flush (_newcache)
"Flush all buffer collector objects.
NEWCACHE is the new tag table, but we ignore it."
(condition-case nil
@ -1204,7 +1206,7 @@ NEWCACHE is the new tag table, but we ignore it."
(error nil)))
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-collector-buffer-flush)
#'semantic-collector-buffer-flush)
;;; DEEP BUFFER SPECIFIC COMPLETION
;;
@ -1246,8 +1248,8 @@ Uses semanticdb for searching all tags in the current project."
(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist."
((obj semantic-collector-project) prefix _completionlist)
"Calculate the completions for prefix from COMPLETIONLIST."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
;;; Brutish Project search
@ -1259,8 +1261,8 @@ Uses semanticdb for searching all tags in the current project."
"semantic/db-find")
(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
((obj semantic-collector-project-brutish) prefix _completionlist)
"Calculate the completions for prefix from COMPLETIONLIST."
(require 'semantic/db-find)
(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))
@ -1273,8 +1275,8 @@ Uses semanticdb for searching all tags in the current project."
"Completion engine for tags in a project.")
(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist."
((obj semantic-collector-local-members) prefix _completionlist)
"Calculate the completions for prefix from COMPLETIONLIST."
(let* ((scope (or (oref obj scope)
(oset obj scope (semantic-calculate-scope))))
(localstuff (oref scope scope)))
@ -1323,7 +1325,7 @@ a collector, and tracking tables of completion to display."
(define-obsolete-function-alias 'semantic-displayor-cleanup
#'semantic-displayer-cleanup "27.1")
(cl-defmethod semantic-displayer-cleanup ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-cleanup ((_obj semantic-displayer-abstract))
"Clean up any mess this displayer may have."
nil)
@ -1348,37 +1350,37 @@ a collector, and tracking tables of completion to display."
(define-obsolete-function-alias 'semantic-displayor-show-request
#'semantic-displayer-show-request "27.1")
(cl-defmethod semantic-displayer-show-request ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-show-request ((_obj semantic-displayer-abstract))
"A request to show the current tags table."
(ding))
(define-obsolete-function-alias 'semantic-displayor-focus-request
#'semantic-displayer-focus-request "27.1")
(cl-defmethod semantic-displayer-focus-request ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-focus-request ((_obj semantic-displayer-abstract))
"A request to for the displayer to focus on some tag option."
(ding))
(define-obsolete-function-alias 'semantic-displayor-scroll-request
#'semantic-displayer-scroll-request "27.1")
(cl-defmethod semantic-displayer-scroll-request ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-scroll-request ((_obj semantic-displayer-abstract))
"A request to for the displayer to scroll the completion list (if needed)."
(scroll-other-window))
(define-obsolete-function-alias 'semantic-displayor-focus-previous
#'semantic-displayer-focus-previous "27.1")
(cl-defmethod semantic-displayer-focus-previous ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-focus-previous ((_obj semantic-displayer-abstract))
"Set the current focus to the previous item."
nil)
(define-obsolete-function-alias 'semantic-displayor-focus-next
#'semantic-displayer-focus-next "27.1")
(cl-defmethod semantic-displayer-focus-next ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-focus-next ((_obj semantic-displayer-abstract))
"Set the current focus to the next item."
nil)
(define-obsolete-function-alias 'semantic-displayor-current-focus
#'semantic-displayer-current-focus "27.1")
(cl-defmethod semantic-displayer-current-focus ((obj semantic-displayer-abstract))
(cl-defmethod semantic-displayer-current-focus ((_obj semantic-displayer-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
@ -1452,7 +1454,7 @@ which have the same name."
(define-obsolete-function-alias 'semantic-displayor-set-completions
#'semantic-displayer-set-completions "27.1")
(cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-focus-abstract)
table prefix)
_table _prefix)
"Set the list of tags to be completed over to TABLE."
(cl-call-next-method)
(slot-makeunbound obj 'focus))
@ -1663,7 +1665,7 @@ This will not happen if you directly set this variable via `setq'."
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
(cl-defmethod initialize-instance :after ((obj semantic-displayer-tooltip) &rest args)
(cl-defmethod initialize-instance :after ((_obj semantic-displayer-tooltip) &rest _args)
"Make sure we have tooltips required."
(require 'tooltip))
@ -1681,16 +1683,16 @@ Display mechanism using tooltip for a list of possible completions.")
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayer-format-tag-function table))
(numcompl (length completions))
(typing-count (oref obj typing-count))
;; (typing-count (oref obj typing-count))
(mode (oref obj mode))
(max-tags (oref obj max-tags-initial))
(matchtxt (semantic-completion-text))
msg msg-tail)
;; Keep a count of the consecutive completion commands entered by the user.
(if (and (stringp (this-command-keys))
(string= (this-command-keys) "\C-i"))
(oset obj typing-count (1+ (oref obj typing-count)))
(oset obj typing-count 0))
(oset obj typing-count
(if (equal (this-command-keys) "\C-i")
(1+ (oref obj typing-count))
0))
(cond
((eq mode 'quiet)
;; Switch back to standard mode if user presses key more than 5 times.
@ -1730,7 +1732,7 @@ Display mechanism using tooltip for a list of possible completions.")
(when semantic-idle-scheduler-verbose-flag
(setq msg "[NO MATCH]"))))
;; Create the tooltip text.
(setq msg (concat msg (mapconcat 'identity completions "\n"))))
(setq msg (concat msg (mapconcat #'identity completions "\n"))))
;; Add any tail info.
(setq msg (concat msg msg-tail))
;; Display tooltip.
@ -1828,12 +1830,10 @@ text using overlay options.")
(define-obsolete-function-alias 'semantic-displayor-set-completions
#'semantic-displayer-set-completions "27.1")
(cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-ghost)
table prefix)
_table _prefix)
"Set the list of tags to be completed over to TABLE."
(cl-call-next-method)
(semantic-displayer-cleanup obj)
)
(semantic-displayer-cleanup obj))
(define-obsolete-function-alias 'semantic-displayor-show-request
@ -2058,9 +2058,8 @@ prompts. these are calculated from the CONTEXT variable passed in."
(semantic-displayer-traditional-with-focus-highlight)
(with-current-buffer (oref context buffer)
(goto-char (cdr (oref context bounds)))
(concat prompt (mapconcat 'identity syms ".")
(if syms "." "")
))
(concat prompt (mapconcat #'identity syms ".")
(if syms "." "")))
nil
inp
history)))

6
lisp/cedet/semantic/db-debug.el
View file

@ -1,6 +1,6 @@
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic -*- lexical-binding: t; -*-
;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -38,7 +38,7 @@
(data-debug-new-buffer "*SEMANTICDB*")
(data-debug-insert-stuff-list db "*")))
(defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary)
(defalias 'semanticdb-adebug-database-list #'semanticdb-dump-all-table-summary)
(defun semanticdb-adebug-current-database ()
"Run ADEBUG on the current database."

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

@ -1,4 +1,4 @@
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@ -135,8 +135,8 @@ is specified by `semanticdb-default-save-directory'."
(let* ((savein (semanticdb-ebrowse-file-for-directory dir))
(filebuff (get-buffer-create "*SEMANTICDB EBROWSE TMP*"))
(files (directory-files (expand-file-name dir) t))
(mma auto-mode-alist)
(regexp nil)
;; (mma auto-mode-alist)
;; (regexp nil)
)
;; Create the input to the ebrowse command
(with-current-buffer filebuff
@ -227,7 +227,7 @@ warn instead."
()
"Search Ebrowse for symbols.")
(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
(cl-defmethod semanticdb-needs-refresh-p ((_table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
@ -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
@ -341,10 +341,10 @@ If there is no database for DIRECTORY available, then
(while T
(let* ((tree (car T))
(class (ebrowse-ts-class tree)); root class of tree
;;(class (ebrowse-ts-class tree)); root class of tree
;; Something funny going on with this file thing...
(filename (or (ebrowse-cs-source-file class)
(ebrowse-cs-file class)))
;; (filename (or (ebrowse-cs-source-file class)
;; (ebrowse-cs-file class)))
)
(cond
((ebrowse-globals-tree-p tree)
@ -363,18 +363,18 @@ If there is no database for DIRECTORY available, then
;;; Filename based methods
;;
(defun semanticdb-ebrowse-add-globals-to-table (dbe tree)
(defun semanticdb-ebrowse-add-globals-to-table (_dbe tree)
"For database DBE, add the ebrowse TREE into the table."
(if (or (not (ebrowse-ts-p tree))
(not (ebrowse-globals-tree-p tree)))
(signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
(let* ((class (ebrowse-ts-class tree))
(fname (or (ebrowse-cs-source-file class)
(ebrowse-cs-file class)
;; Not def'd here, assume our current
;; file
(concat default-directory "/unknown-proxy.hh")))
;; (fname (or (ebrowse-cs-source-file class)
;; (ebrowse-cs-file class)
;; ;; Not def'd here, assume our current
;; ;; file
;; (concat default-directory "/unknown-proxy.hh")))
(vars (ebrowse-ts-member-functions tree))
(fns (ebrowse-ts-member-variables tree))
(toks nil)
@ -573,7 +573,7 @@ return that."
;; how your new search routines are implemented.
;;
(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
((_table semanticdb-table-ebrowse) _name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
@ -588,7 +588,7 @@ Return a list of tags."
)
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
((_table semanticdb-table-ebrowse) _regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@ -598,7 +598,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
((_table semanticdb-table-ebrowse) _prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@ -608,7 +608,7 @@ Returns a table of all matching tags."
))
(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-ebrowse) class &optional tags)
((_table semanticdb-table-ebrowse) _class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@ -625,7 +625,7 @@ Returns a table of all matching tags."
;;
(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
((_table semanticdb-table-ebrowse) _name &optional _tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
@ -633,7 +633,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse."
(cl-call-next-method))
(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
((_table semanticdb-table-ebrowse) _regex &optional _tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
@ -641,7 +641,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse."
(cl-call-next-method))
(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
((_table semanticdb-table-ebrowse) _prefix &optional _tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
@ -651,7 +651,7 @@ Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;; Advanced Searches
;;
(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-ebrowse) type &optional tags)
((_table semanticdb-table-ebrowse) _type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."

6
lisp/cedet/semantic/db-el.el
View file

@ -1,6 +1,6 @@
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp -*- lexical-binding: t; -*-
;;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@ -53,7 +53,7 @@ It does not need refreshing."
"Return nil, we never need a refresh."
nil)
(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-emacs-lisp))
(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-emacs-lisp))
(list "(proxy)"))
(cl-defmethod cl-print-object ((obj semanticdb-table-emacs-lisp) stream)

8
lisp/cedet/semantic/db-file.el
View file

@ -1,6 +1,6 @@
;;; semantic/db-file.el --- Save a semanticdb to a cache file.
;;; semantic/db-file.el --- Save a semanticdb to a cache file. -*- lexical-binding: t; -*-
;;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@ -358,13 +358,13 @@ Uses `semanticdb-persistent-path' to determine the return value."
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
(cl-defmethod semanticdb-file-name-non-directory
((dbclass (subclass semanticdb-project-database-file)))
((_dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
(cl-defmethod semanticdb-file-name-directory
((dbclass (subclass semanticdb-project-database-file)) directory)
((_dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory

17
lisp/cedet/semantic/db-find.el
View file

@ -1,4 +1,4 @@
;;; semantic/db-find.el --- Searching through semantic databases.
;;; semantic/db-find.el --- Searching through semantic databases. -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -209,14 +209,14 @@ This class will cache data derived during various searches.")
)
(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags)
_new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
(semantic-reset idx)
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
(lambda (tab me)
(lambda (tab _me)
(semantic-reset (semanticdb-get-table-index tab))))
)
@ -230,7 +230,7 @@ This class will cache data derived during various searches.")
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
(lambda (tab me)
(lambda (tab _me)
(semantic-reset (semanticdb-get-table-index tab))))
)
;; Else, not an include, by just a type.
@ -240,7 +240,7 @@ This class will cache data derived during various searches.")
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
(lambda (tab me)
(lambda (tab _me)
(let ((tab-idx (semanticdb-get-table-index tab)))
;; Not a full reset?
(when (oref tab-idx type-cache)
@ -791,7 +791,8 @@ PREBUTTONTEXT is some text between prefix and the overlay button."
(file (semantic-tag-file-name tag))
(str1 (format "%S %s" mode name))
(str2 (format " : %s" file))
(tip nil))
;; (tip nil)
)
(insert prefix prebuttontext str1)
(setq end (point))
(insert str2)
@ -807,7 +808,7 @@ PREBUTTONTEXT is some text between prefix and the overlay button."
(put-text-property start end 'ddebug (cdr consdata))
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
(put-text-property start end 'help-echo tip)
;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-tag-parts-from-point)
(insert "\n")
@ -1009,7 +1010,7 @@ is still made current."
(when norm
;; The normalized tags can now be found based on that
;; tags table.
(condition-case foo
(condition-case nil
(progn
(semanticdb-set-buffer (car norm))
;; Now reset ans

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

@ -1,4 +1,4 @@
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2006, 2008-2021 Free Software Foundation, Inc.
@ -69,7 +69,8 @@ values."
(let ((semanticdb--ih (mode-local-value mode 'semantic-init-mode-hook)))
(eval `(setq-mode-local
,mode semantic-init-mode-hook
(cons 'semanticdb-enable-gnu-global-hook semanticdb--ih))))
(cons 'semanticdb-enable-gnu-global-hook ',semanticdb--ih))
t))
t
)
)
@ -114,7 +115,7 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
)
"A table for returning search results from GNU Global.")
(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-global))
(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-global))
(list "(proxy)"))
(cl-defmethod cl-print-object ((obj semanticdb-table-global) stream)
@ -123,7 +124,7 @@ Adds the number of tags in this file to the object print name."
(princ (eieio-object-name obj (semanticdb-debug-info obj))
stream))
(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-global) &optional _buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@ -146,7 +147,7 @@ For each file hit, get the traditional semantic table from that file."
(cl-call-next-method))
(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) _filename)
"From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
@ -157,7 +158,7 @@ For each file hit, get the traditional semantic table from that file."
;; Only NAME based searches work with GLOBAL as that is all it tracks.
;;
(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
((_table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
@ -174,7 +175,7 @@ Return a list of tags."
)))
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
((_table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@ -187,7 +188,7 @@ Return a list of tags."
)))
(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
((_table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."

18
lisp/cedet/semantic/db-javascript.el
View file

@ -1,4 +1,4 @@
;;; semantic/db-javascript.el --- Semantic database extensions for javascript
;;; semantic/db-javascript.el --- Semantic database extensions for javascript -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@ -129,20 +129,20 @@ Create one of our special tables that can act as an intermediary."
(cl-call-next-method)
)
(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) _filename)
"From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj))
)
(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
(cl-defmethod semanticdb-get-tags ((_table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@ -193,7 +193,7 @@ database (if available.)"
result))
(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
((_table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
@ -203,7 +203,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
((_table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@ -214,7 +214,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
((_table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@ -224,7 +224,7 @@ Returns a table of all matching tags."
))
(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-javascript) class &optional tags)
((_table semanticdb-table-javascript) _class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@ -268,7 +268,7 @@ Like `semanticdb-find-tags-for-completion-method' for javascript."
;;; Advanced Searches
;;
(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-javascript) type &optional tags)
((_table semanticdb-table-javascript) _type &optional tags)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."

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

@ -1,4 +1,4 @@
;;; semantic/db-mode.el --- Semanticdb Minor Mode
;;; semantic/db-mode.el --- Semanticdb Minor Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.

8
lisp/cedet/semantic/db-ref.el
View file

@ -1,6 +1,6 @@
;;; semantic/db-ref.el --- Handle cross-db file references
;;; semantic/db-ref.el --- Handle cross-db file references -*- lexical-binding: t; -*-
;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -67,7 +67,7 @@ will be added to the database that INCLUDE-TAG refers to."
(object-add-to-list refdbt 'db-refs dbt)
t)))
(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
(cl-defmethod semanticdb-check-references ((_dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
@ -109,7 +109,7 @@ refers to DBT will be removed."
))
(setq refs (cdr refs)))))
(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
(cl-defmethod semanticdb-refresh-references ((_dbt semanticdb-abstract-table))
"Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed.
nil

26
lisp/cedet/semantic/db-typecache.el
View file

@ -1,4 +1,4 @@
;;; semantic/db-typecache.el --- Manage Datatypes
;;; semantic/db-typecache.el --- Manage Datatypes -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -74,14 +74,14 @@ Said object must support `semantic-reset' methods.")
(oset tc stream nil)
(mapc 'semantic-reset (oref tc dependants))
(mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
(cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on."
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
@ -90,7 +90,7 @@ Said object must support `semantic-reset' methods.")
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
@ -167,15 +167,15 @@ If there is no table, create one, and fill it in."
(oset tc stream nil)
)
(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
new-tags)
(cl-defmethod semanticdb-synchronize ((_cache semanticdb-database-typecache)
_new-tags)
"Synchronize a CACHE with some NEW-TAGS."
)
nil)
(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
new-tags)
(cl-defmethod semanticdb-partial-synchronize ((_cache semanticdb-database-typecache)
_new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
)
nil)
(cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB.
@ -312,7 +312,7 @@ If TAG has fully qualified names, expand it to a series of nested
namespaces instead."
tag)
(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
(cl-defmethod semanticdb-typecache-file-tags ((_table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
@ -338,7 +338,7 @@ all included files."
(oref cache filestream)
))
(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
(cl-defmethod semanticdb-typecache-include-tags ((_table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
@ -611,7 +611,7 @@ If there isn't one, create it.
(require 'data-debug)
(let* ((tab semanticdb-current-table)
(idx (semanticdb-get-table-index tab))
(junk (oset idx type-cache nil)) ;; flush!
(_ (oset idx type-cache nil)) ;; flush!
(start (current-time))
(tc (semanticdb-typecache-for-database (oref tab parent-db)))
(end (current-time))

52
lisp/cedet/semantic/debug.el
View file

@ -1,4 +1,4 @@
;;; semantic/debug.el --- Language Debugger framework
;;; semantic/debug.el --- Language Debugger framework -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2005, 2008-2021 Free Software Foundation, Inc.
@ -265,12 +265,12 @@ on different types of return values."
)
"One frame representation.")
(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
(cl-defmethod semantic-debug-frame-highlight ((_frame semantic-debug-frame))
"Highlight one parser frame."
)
(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
(cl-defmethod semantic-debug-frame-info ((_frame semantic-debug-frame))
"Display info about this one parser frame."
)
@ -279,21 +279,21 @@ on different types of return values."
;;
(defvar semantic-debug-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "n" 'semantic-debug-next)
(define-key km " " 'semantic-debug-next)
(define-key km "s" 'semantic-debug-step)
(define-key km "u" 'semantic-debug-up)
(define-key km "d" 'semantic-debug-down)
(define-key km "f" 'semantic-debug-fail-match)
(define-key km "h" 'semantic-debug-print-state)
(define-key km "s" 'semantic-debug-jump-to-source)
(define-key km "p" 'semantic-debug-jump-to-parser)
(define-key km "q" 'semantic-debug-quit)
(define-key km "a" 'semantic-debug-abort)
(define-key km "g" 'semantic-debug-go)
(define-key km "b" 'semantic-debug-set-breakpoint)
(define-key km "n" #'semantic-debug-next)
(define-key km " " #'semantic-debug-next)
(define-key km "s" #'semantic-debug-step)
(define-key km "u" #'semantic-debug-up)
(define-key km "d" #'semantic-debug-down)
(define-key km "f" #'semantic-debug-fail-match)
(define-key km "h" #'semantic-debug-print-state)
(define-key km "s" #'semantic-debug-jump-to-source)
(define-key km "p" #'semantic-debug-jump-to-parser)
(define-key km "q" #'semantic-debug-quit)
(define-key km "a" #'semantic-debug-abort)
(define-key km "g" #'semantic-debug-go)
(define-key km "b" #'semantic-debug-set-breakpoint)
;; Some boring bindings.
(define-key km "e" 'eval-expression)
(define-key km "e" #'eval-expression)
km)
"Keymap used when in semantic-debug-node.")
@ -514,49 +514,49 @@ by overriding one of the command methods. Be sure to use
down to your parser later."
:abstract t)
(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-next ((_parser semantic-debug-parser))
"Execute next for this PARSER."
(setq semantic-debug-user-command 'next)
)
(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-step ((_parser semantic-debug-parser))
"Execute a step for this PARSER."
(setq semantic-debug-user-command 'step)
)
(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-go ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go)
)
(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-fail ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail)
)
(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-quit ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit)
)
(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-abort ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort)
)
(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-print-state ((_parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface
(when current-frame
(semantic-debug-frame-info current-frame)
)))
(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-break ((_parser semantic-debug-parser))
"Set a breakpoint for this PARSER."
)
;; Stack stuff
(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
(cl-defmethod semantic-debug-parser-frames ((_parser semantic-debug-parser))
"Return a list of frames for the current parser.
A frame is of the form:
( .. .what ? .. )

11
lisp/cedet/semantic/decorate.el
View file

@ -1,7 +1,6 @@
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens. -*- lexical-binding: t; -*-
;;; Copyright (C) 1999-2003, 2005-2007, 2009-2021 Free Software
;;; Foundation, Inc.
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@ -51,7 +50,7 @@ Optional FACE specifies the face to use."
))
;;; Momentary Highlighting - One line
(defun semantic-momentary-highlight-one-tag-line (tag &optional face)
(defun semantic-momentary-highlight-one-tag-line (tag &optional _face)
"Highlight the first line of TAG, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
(save-excursion
@ -88,7 +87,7 @@ If VISIBLE is non-nil, make the text visible."
(overlay-get (semantic-tag-overlay tag) 'invisible))
(defun semantic-overlay-signal-read-only
(overlay after start end &optional len)
(overlay after start end &optional _len)
"Hook used in modification hooks to prevent modification.
Allows deletion of the entire text.
Argument OVERLAY, AFTER, START, END, and LEN are passed in by the system."
@ -261,7 +260,7 @@ nil implies the tag should be fully shown."
(declare-function semantic-current-tag "semantic/find")
(defun semantic-set-tag-folded-isearch (overlay)
(defun semantic-set-tag-folded-isearch (_overlay)
"Called by isearch if it discovers text in the folded region.
OVERLAY is passed in by isearch."
(semantic-set-tag-folded (semantic-current-tag) nil)

8
lisp/cedet/semantic/decorate/include.el
View file

@ -55,7 +55,7 @@ Used by the decoration style: `semantic-decoration-on-includes'."
(defvar semantic-decoration-on-include-map
(let ((km (make-sparse-keymap)))
(define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu)
(define-key km semantic-decoration-mouse-3 #'semantic-decoration-include-menu)
km)
"Keymap used on includes.")
@ -114,7 +114,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'."
(defvar semantic-decoration-on-unknown-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
(define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu)
(define-key km semantic-decoration-mouse-3 #'semantic-decoration-unknown-include-menu)
km)
"Keymap used on unparsed includes.")
@ -169,7 +169,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'."
(defvar semantic-decoration-on-fileless-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
(define-key km semantic-decoration-mouse-3 'semantic-decoration-fileless-include-menu)
(define-key km semantic-decoration-mouse-3 #'semantic-decoration-fileless-include-menu)
km)
"Keymap used on unparsed includes.")
@ -223,7 +223,7 @@ Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
(defvar semantic-decoration-on-unparsed-include-map
(let ((km (make-sparse-keymap)))
(define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu)
(define-key km semantic-decoration-mouse-3 #'semantic-decoration-unparsed-include-menu)
km)
"Keymap used on unparsed includes.")

20
lisp/cedet/semantic/decorate/mode.el
View file

@ -264,9 +264,9 @@ non-nil if the minor mode is enabled."
(buffer-name)))
;; Add hooks
(add-hook 'semantic-after-partial-cache-change-hook
'semantic-decorate-tags-after-partial-reparse nil t)
#'semantic-decorate-tags-after-partial-reparse nil t)
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-decorate-tags-after-full-reparse nil t)
#'semantic-decorate-tags-after-full-reparse nil t)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
;; However, don't do this immediately, because EDE will be
@ -282,9 +282,9 @@ non-nil if the minor mode is enabled."
(semantic-decorate-flush-decorations)
;; Remove hooks
(remove-hook 'semantic-after-partial-cache-change-hook
'semantic-decorate-tags-after-partial-reparse t)
#'semantic-decorate-tags-after-partial-reparse t)
(remove-hook 'semantic-after-toplevel-cache-change-hook
'semantic-decorate-tags-after-full-reparse t)))
#'semantic-decorate-tags-after-full-reparse t)))
(semantic-add-minor-mode 'semantic-decoration-mode
"")
@ -350,13 +350,11 @@ Return non-nil if the decoration style is enabled."
(defun semantic-decoration-build-style-menu (style)
"Build a menu item for controlling a specific decoration STYLE."
(vector (car style)
`(lambda () (interactive)
(semantic-toggle-decoration-style
,(car style)))
:style 'toggle
:selected `(semantic-decoration-style-enabled-p ,(car style))
))
(let ((s (car style)))
(vector s
(lambda () (interactive) (semantic-toggle-decoration-style s))
:style 'toggle
:selected `(semantic-decoration-style-enabled-p ',s))))
(defun semantic-build-decoration-mode-menu (&rest _ignore)
"Create a menu listing all the known decorations for toggling.

26
lisp/cedet/semantic/dep.el
View file

@ -1,4 +1,4 @@
;;; semantic/dep.el --- Methods for tracking dependencies (include files)
;;; semantic/dep.el --- Methods for tracking dependencies (include files) -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@ -123,12 +123,12 @@ Changes made by this function are not persistent."
(if (not mode) (setq mode major-mode))
(let ((dirtmp (file-name-as-directory dir))
(value
(mode-local-value mode 'semantic-dependency-system-include-path))
)
(add-to-list 'value dirtmp t)
(mode-local-value mode 'semantic-dependency-system-include-path)))
(eval `(setq-mode-local ,mode
semantic-dependency-system-include-path value))
))
semantic-dependency-system-include-path
',(if (member dirtmp value) value
(append value (list dirtmp))))
t)))
;;;###autoload
(defun semantic-remove-system-include (dir &optional mode)
@ -146,10 +146,10 @@ Changes made by this function are not persistent."
(value
(mode-local-value mode 'semantic-dependency-system-include-path))
)
(setq value (delete dirtmp value))
(setq value (remove dirtmp value))
(eval `(setq-mode-local ,mode semantic-dependency-system-include-path
value))
))
',value)
t)))
;;;###autoload
(defun semantic-reset-system-include (&optional mode)
@ -157,10 +157,10 @@ Changes made by this function are not persistent."
Modifies a mode-local version of
`semantic-dependency-system-include-path'."
(interactive)
(if (not mode) (setq mode major-mode))
(eval `(setq-mode-local ,mode semantic-dependency-system-include-path
nil))
)
(eval `(setq-mode-local ,(or mode major-mode)
semantic-dependency-system-include-path
nil)
t))
;;;###autoload
(defun semantic-customize-system-include-path (&optional mode)

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

@ -1,4 +1,4 @@
;;; semantic/doc.el --- Routines for documentation strings
;;; semantic/doc.el --- Routines for documentation strings -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2003, 2005, 2008-2021 Free Software Foundation,
;; Inc.
@ -85,7 +85,7 @@ just the lexical token and not the string."
))
(define-obsolete-function-alias
'semantic-documentation-comment-preceeding-tag
'semantic-documentation-comment-preceding-tag
#'semantic-documentation-comment-preceding-tag
"25.1")
(defun semantic-doc-snarf-comment-for-tag (nosnarf)

16
lisp/cedet/semantic/ede-grammar.el
View file

@ -1,4 +1,4 @@
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
@ -30,6 +30,7 @@
(require 'ede/pconf)
(require 'ede/proj-elisp)
(require 'semantic/grammar)
(eval-when-compile (require 'cl-lib))
;;; Code:
(defclass semantic-ede-proj-target-grammar (ede-proj-target-elisp)
@ -118,7 +119,7 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs.")
;;; Target options.
(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
(cl-defmethod ede-buffer-mine ((_this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it
@ -130,7 +131,7 @@ Lays claim to all -by.el, and -wy.el files."
(cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer))
(let* (;; (cb (current-buffer))
(proj (ede-target-parent obj))
(default-directory (oref proj directory))
(comp 0)
@ -141,11 +142,10 @@ Lays claim to all -by.el, and -wy.el files."
(fname (progn (string-match ".*/\\(.+\\.el\\)" package)
(match-string 1 package)))
(src (ede-expand-filename obj fname))
(csrc (concat (file-name-sans-extension src) ".elc")))
(with-no-warnings
(if (eq (byte-recompile-file src nil 0) t)
(setq comp (1+ comp))
(setq utd (1+ utd)))))))
;; (csrc (concat (file-name-sans-extension src) ".elc"))
)
(cl-incf (if (eq (byte-recompile-file src nil 0) t)
comp utd)))))
(oref obj source))
(message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))

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

@ -1,4 +1,4 @@
;;; semantic/edit.el --- Edit Management for Semantic
;;; semantic/edit.el --- Edit Management for Semantic -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@ -157,7 +157,7 @@ Optional argument BUFFER is the buffer to search for changes in."
(sort ret #'(lambda (a b) (< (overlay-start a)
(overlay-start b)))))))
(defun semantic-edits-change-function-handle-changes (start end length)
(defun semantic-edits-change-function-handle-changes (start end _length)
"Run whenever a buffer controlled by `semantic-mode' change.
Tracks when and how the buffer is re-parsed.
Argument START, END, and LENGTH specify the bounds of the change."
@ -356,7 +356,7 @@ See `semantic-edits-change-leaf-tag' for details on parents."
start end)))
(parent nil)
(overlapped-tags nil)
inner-start inner-end
inner-end ;; inner-start
(list-to-search nil))
;; By the time this is already called, we know that it is
;; not a leaf change, nor a between tag change. That leaves
@ -370,7 +370,7 @@ See `semantic-edits-change-leaf-tag' for details on parents."
(progn
;; We encompass one whole change.
(setq overlapped-tags (list (car tags))
inner-start (semantic-tag-start (car tags))
;; inner-start (semantic-tag-start (car tags))
inner-end (semantic-tag-end (car tags))
tags (cdr tags))
;; Keep looping while tags are inside the change.
@ -386,13 +386,14 @@ See `semantic-edits-change-leaf-tag' for details on parents."
;; This is a parent. Drop the children found
;; so far.
(setq overlapped-tags (list (car tags))
inner-start (semantic-tag-start (car tags))
;; inner-start (semantic-tag-start (car tags))
inner-end (semantic-tag-end (car tags))
)
;; It is not a parent encompassing tag
(setq overlapped-tags (cons (car tags)
overlapped-tags)
inner-start (semantic-tag-start (car tags))))
;; inner-start (semantic-tag-start (car tags))
))
(setq tags (cdr tags)))
(if (not tags)
;; There are no tags left, and all tags originally
@ -533,6 +534,7 @@ This function is for internal use by `semantic-edits-incremental-parser'."
;query this when debugging to find
;source of bugs.
)
(ignore last-cond) ;; Don't warn about the var not being used.
(or changes
;; If we were called, and there are no changes, then we
;; don't know what to do. Force a full reparse.

6
lisp/cedet/semantic/find.el
View file

@ -1,4 +1,4 @@
;;; semantic/find.el --- Search routines for Semantic
;;; semantic/find.el --- Search routines for Semantic -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2008-2021 Free Software Foundation, Inc.
@ -583,7 +583,7 @@ Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
)
(defun semantic-brute-find-tag-by-function
(function streamorbuffer &optional search-parts search-includes)
(function streamorbuffer &optional search-parts _search-includes)
"Find all tags for which FUNCTION's value is non-nil within STREAMORBUFFER.
FUNCTION must return non-nil if an element of STREAM will be included
in the new list.
@ -620,7 +620,7 @@ This parameter hasn't be active for a while and is obsolete."
nl))
(defun semantic-brute-find-first-tag-by-function
(function streamorbuffer &optional search-parts search-includes)
(function streamorbuffer &optional _search-parts _search-includes)
"Find the first tag which FUNCTION match within STREAMORBUFFER.
FUNCTION must return non-nil if an element of STREAM will be included
in the new list.

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

@ -1,4 +1,4 @@
;;; semantic/format.el --- Routines for formatting tags
;;; semantic/format.el --- Routines for formatting tags -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@ -162,7 +162,7 @@ COLOR specifies if color should be used."
(car args) nil color 'variable))
out)
(setq args (cdr args)))
(mapconcat 'identity (nreverse out) semantic-function-argument-separator)
(mapconcat #'identity (nreverse out) semantic-function-argument-separator)
))
;;; Data Type
@ -200,7 +200,7 @@ Argument COLOR specifies to colorize the text."
;;; Abstract formatting functions
;;
(defun semantic-format-tag-prin1 (tag &optional parent color)
(defun semantic-format-tag-prin1 (tag &optional _parent _color)
"Convert TAG to a string that is the print name for TAG.
PARENT and COLOR are ignored."
(format "%S" tag))
@ -237,7 +237,7 @@ The name is the shortest possible representation.
Optional argument PARENT is the parent type if TAG is a detail.
Optional argument COLOR means highlight the prototype with font-lock colors.")
(defun semantic-format-tag-name-default (tag &optional parent color)
(defun semantic-format-tag-name-default (tag &optional _parent color)
"Return an abbreviated string describing TAG.
Optional argument PARENT is the parent type if TAG is a detail.
Optional argument COLOR means highlight the prototype with font-lock colors."
@ -500,7 +500,7 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
args
(if (eq class 'type) "}" ")"))))
(when mods
(setq mods (concat (mapconcat 'identity mods " ") " ")))
(setq mods (concat (mapconcat #'identity mods " ") " ")))
(concat (or mods "")
(if type (concat type " "))
name

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

@ -1,6 +1,6 @@
;;; semantic/fw.el --- Framework for Semantic
;;; semantic/fw.el --- Framework for Semantic -*- lexical-binding: t; -*-
;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -34,29 +34,29 @@
;;; Compatibility
;;
(define-obsolete-function-alias 'semantic-overlay-live-p 'overlay-buffer "27.1")
(define-obsolete-function-alias 'semantic-make-overlay 'make-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlay-put 'overlay-put "27.1")
(define-obsolete-function-alias 'semantic-overlay-get 'overlay-get "27.1")
(define-obsolete-function-alias 'semantic-overlay-live-p #'overlay-buffer "27.1")
(define-obsolete-function-alias 'semantic-make-overlay #'make-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlay-put #'overlay-put "27.1")
(define-obsolete-function-alias 'semantic-overlay-get #'overlay-get "27.1")
(define-obsolete-function-alias 'semantic-overlay-properties
'overlay-properties "27.1")
(define-obsolete-function-alias 'semantic-overlay-move 'move-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlay-delete 'delete-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlays-at 'overlays-at "27.1")
(define-obsolete-function-alias 'semantic-overlays-in 'overlays-in "27.1")
(define-obsolete-function-alias 'semantic-overlay-buffer 'overlay-buffer "27.1")
(define-obsolete-function-alias 'semantic-overlay-start 'overlay-start "27.1")
(define-obsolete-function-alias 'semantic-overlay-end 'overlay-end "27.1")
#'overlay-properties "27.1")
(define-obsolete-function-alias 'semantic-overlay-move #'move-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlay-delete #'delete-overlay "27.1")
(define-obsolete-function-alias 'semantic-overlays-at #'overlays-at "27.1")
(define-obsolete-function-alias 'semantic-overlays-in #'overlays-in "27.1")
(define-obsolete-function-alias 'semantic-overlay-buffer #'overlay-buffer "27.1")
(define-obsolete-function-alias 'semantic-overlay-start #'overlay-start "27.1")
(define-obsolete-function-alias 'semantic-overlay-end #'overlay-end "27.1")
(define-obsolete-function-alias 'semantic-overlay-next-change
'next-overlay-change "27.1")
#'next-overlay-change "27.1")
(define-obsolete-function-alias 'semantic-overlay-previous-change
'previous-overlay-change "27.1")
(define-obsolete-function-alias 'semantic-overlay-lists 'overlay-lists "27.1")
(define-obsolete-function-alias 'semantic-overlay-p 'overlayp "27.1")
(define-obsolete-function-alias 'semantic-read-event 'read-event "27.1")
(define-obsolete-function-alias 'semantic-popup-menu 'popup-menu "27.1")
#'previous-overlay-change "27.1")
(define-obsolete-function-alias 'semantic-overlay-lists #'overlay-lists "27.1")
(define-obsolete-function-alias 'semantic-overlay-p #'overlayp "27.1")
(define-obsolete-function-alias 'semantic-read-event #'read-event "27.1")
(define-obsolete-function-alias 'semantic-popup-menu #'popup-menu "27.1")
(define-obsolete-function-alias 'semantic-buffer-local-value
'buffer-local-value "27.1")
#'buffer-local-value "27.1")
(defun semantic-event-window (event)
"Extract the window from EVENT."
@ -68,11 +68,11 @@
;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
;; run major mode hooks.
(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1")
(define-obsolete-function-alias 'semantic-run-mode-hooks #'run-mode-hooks "28.1")
;; Fancy compat usage now handled in cedet-compat
(define-obsolete-function-alias 'semantic-subst-char-in-string
'subst-char-in-string "28.1")
#'subst-char-in-string "28.1")
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
@ -111,7 +111,7 @@ Possible Lifespans are:
(setq semantic-cache-data-overlays
(cons o semantic-cache-data-overlays))
;;(message "Adding to cache: %s" o)
(add-hook 'post-command-hook 'semantic-cache-data-post-command-hook)
(add-hook 'post-command-hook #'semantic-cache-data-post-command-hook)
))
(defun semantic-cache-data-post-command-hook ()
@ -137,7 +137,7 @@ Remove self from `post-command-hook' if it is empty."
;; Remove ourselves if we have removed all overlays.
(unless semantic-cache-data-overlays
(remove-hook 'post-command-hook
'semantic-cache-data-post-command-hook)))
#'semantic-cache-data-post-command-hook)))
(defun semantic-get-cache-data (name &optional point)
"Get cached data with NAME from optional POINT."
@ -254,7 +254,7 @@ FUNCTION does not have arguments. When FUNCTION is entered
`current-buffer' is a selected Semantic enabled buffer."
(mode-local-map-file-buffers function #'semantic-active-p))
(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
(defalias 'semantic-map-mode-buffers #'mode-local-map-mode-buffers)
(defun semantic-install-function-overrides (overrides &optional transient)
"Install the function OVERRIDES in the specified environment.
@ -318,6 +318,12 @@ calling this one."
;;; Special versions of Find File
;;
(defvar recentf-exclude)
(defvar semantic-init-hook)
(defvar ede-auto-add-method)
(defvar flymake-start-syntax-check-on-find-file)
(defvar auto-insert)
(defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards)
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.

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

@ -1,4 +1,4 @@
;;; semantic/html.el --- Semantic details for html files
;;; semantic/html.el --- Semantic details for html files -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2005, 2007-2021 Free Software Foundation, Inc.
@ -59,14 +59,14 @@
"Alist of sectioning commands and their relative level.")
(define-mode-local-override semantic-parse-region
html-mode (&rest ignore)
html-mode (&rest _ignore)
"Parse the current html buffer for semantic tags.
IGNORE any arguments. Always parse the whole buffer.
Each tag returned is of the form:
(\"NAME\" section (:members CHILDREN))
or
(\"NAME\" anchor)"
(mapcar 'semantic-html-expand-tag
(mapcar #'semantic-html-expand-tag
(semantic-html-parse-headings)))
(define-mode-local-override semantic-parse-changes
@ -79,7 +79,7 @@ or
(let ((chil (semantic-html-components tag)))
(if chil
(semantic-tag-put-attribute
tag :members (mapcar 'semantic-html-expand-tag chil)))
tag :members (mapcar #'semantic-html-expand-tag chil)))
(car (semantic--tag-expand tag))))
(defun semantic-html-components (tag)
@ -233,7 +233,7 @@ tag with greater section value than LEVEL is found."
;; This will use our parser.
(setq semantic-parser-name "HTML"
semantic--parse-table t
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character ">"
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list '((section . "Section")

36
lisp/cedet/semantic/ia-sb.el
View file

@ -1,7 +1,6 @@
;;; semantic/ia-sb.el --- Speedbar analysis display interactor
;;; semantic/ia-sb.el --- Speedbar analysis display interactor -*- lexical-binding: t; -*-
;;; Copyright (C) 2002-2004, 2006, 2008-2021 Free Software Foundation,
;;; Inc.
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@ -30,18 +29,14 @@
(require 'speedbar)
;;; Code:
(defvar semantic-ia-sb-key-map nil
(defvar semantic-ia-sb-key-map
(let ((map (speedbar-make-specialized-keymap)))
;; Basic features.
(define-key map "\C-m" #'speedbar-edit-line)
(define-key map "I" #'semantic-ia-sb-show-tag-info)
map)
"Keymap used when in semantic analysis display mode.")
(if semantic-ia-sb-key-map
nil
(setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap))
;; Basic features.
(define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line)
(define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info)
)
(defvar semantic-ia-sb-easymenu-definition
'( "---"
; [ "Expand" speedbar-expand-line nil ]
@ -75,7 +70,7 @@ list of possible completions."
(speedbar-change-initial-expansion-list "Analyze")
)
(defun semantic-ia-speedbar (directory zero)
(defun semantic-ia-speedbar (_directory _zero)
"Create buttons in speedbar which define the current analysis at POINT.
DIRECTORY is the current directory, which is ignored, and ZERO is 0."
(let ((analysis nil)
@ -195,7 +190,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
;; An index for the argument the prefix is in:
(let ((arg (oref context argument))
(args (semantic-tag-function-arguments (car func)))
(idx 0)
;; (idx 0)
)
(speedbar-insert-separator
(format "Argument #%d" (oref context index)))
@ -275,7 +270,7 @@ See `semantic-ia-sb-tag-info' for more."
(setq tok (get-text-property (point) 'speedbar-token)))
(semantic-ia-sb-tag-info nil tok 0)))
(defun semantic-ia-sb-tag-info (text tag indent)
(defun semantic-ia-sb-tag-info (_text tag _indent)
"Display as much information as we can about tag.
Show the information in a shrunk split-buffer and expand
out as many details as possible.
@ -322,16 +317,15 @@ TEXT, TAG, and INDENT are speedbar function arguments."
(get-buffer-window "*Tag Information*")))
(select-frame speedbar-frame))))
(defun semantic-ia-sb-line-path (&optional depth)
(defun semantic-ia-sb-line-path (&optional _depth)
"Return the file name associated with DEPTH."
(save-match-data
(let* ((tok (speedbar-line-token))
(buff (if (semantic-tag-buffer tok)
(semantic-tag-buffer tok)
(current-buffer))))
(buff (or (semantic-tag-buffer tok)
(current-buffer))))
(buffer-file-name buff))))
(defun semantic-ia-sb-complete (text tag indent)
(defun semantic-ia-sb-complete (_text tag _indent)
"At point in the attached buffer, complete the symbol clicked on.
TEXT TAG and INDENT are the details."
;; Find the specified bounds from the current analysis.

13
lisp/cedet/semantic/ia.el
View file

@ -1,6 +1,6 @@
;;; semantic/ia.el --- Interactive Analysis functions
;;; semantic/ia.el --- Interactive Analysis functions -*- lexical-binding: t; -*-
;;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@ -79,13 +79,8 @@
(insert "("))
(t nil))))
(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
(make-obsolete 'semantic-ia-get-completions
#'semantic-analyze-possible-completions "28.1")
(defun semantic-ia-get-completions-deprecated (context point)
"A function to help transition away from `semantic-ia-get-completions'.
Return completions based on CONTEXT at POINT."
(defun semantic-ia-get-completions (context _point)
"Fetch the completion of CONTEXT at POINT."
(declare (obsolete semantic-analyze-possible-completions "28.1"))
(semantic-analyze-possible-completions context))

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

@ -1038,21 +1038,20 @@ be called."
(popup-menu semantic-idle-breadcrumbs-popup-menu)
(select-window old-window)))
(defmacro semantic-idle-breadcrumbs--tag-function (function)
(defun semantic-idle-breadcrumbs--tag-function (function)
"Return lambda expression calling FUNCTION when called from a popup."
`(lambda (event)
(interactive "e")
(let* ((old-window (selected-window))
(window (semantic-event-window event))
(column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
(tag (progn
(select-window window t)
(plist-get
(text-properties-at column header-line-format)
'tag))))
(,function tag)
(select-window old-window)))
)
(lambda (event)
(interactive "e")
(let* ((old-window (selected-window))
(window (semantic-event-window event))
(column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
(tag (progn
(select-window window t)
(plist-get
(text-properties-at column header-line-format)
'tag))))
(funcall function tag)
(select-window old-window))))
;; TODO does this work for mode-line case?
(defvar semantic-idle-breadcrumbs-popup-map
@ -1060,8 +1059,7 @@ be called."
;; mouse-1 goes to clicked tag
(define-key map
[ header-line mouse-1 ]
(semantic-idle-breadcrumbs--tag-function
semantic-go-to-tag))
(semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag))
;; mouse-3 pops up a context menu
(define-key map
[ header-line mouse-3 ]
@ -1077,8 +1075,7 @@ be called."
"Breadcrumb Tag"
(vector
"Go to Tag"
(semantic-idle-breadcrumbs--tag-function
semantic-go-to-tag)
(semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag)
:active t
:help "Jump to this tag")
;; TODO these entries need minor changes (optional tag argument) in
@ -1086,37 +1083,32 @@ be called."
;; (semantic-menu-item
;; (vector
;; "Copy Tag"
;; (semantic-idle-breadcrumbs--tag-function
;; senator-copy-tag)
;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag)
;; :active t
;; :help "Copy this tag"))
;; (semantic-menu-item
;; (vector
;; "Kill Tag"
;; (semantic-idle-breadcrumbs--tag-function
;; senator-kill-tag)
;; (semantic-idle-breadcrumbs--tag-function #'senator-kill-tag)
;; :active t
;; :help "Kill tag text to the kill ring, and copy the tag to
;; the tag ring"))
;; (semantic-menu-item
;; (vector
;; "Copy Tag to Register"
;; (semantic-idle-breadcrumbs--tag-function
;; senator-copy-tag-to-register)
;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag-to-register)
;; :active t
;; :help "Copy this tag"))
;; (semantic-menu-item
;; (vector
;; "Narrow to Tag"
;; (semantic-idle-breadcrumbs--tag-function
;; senator-narrow-to-defun)
;; (semantic-idle-breadcrumbs--tag-function #'senator-narrow-to-defun)
;; :active t
;; :help "Narrow to the bounds of the current tag"))
;; (semantic-menu-item
;; (vector
;; "Fold Tag"
;; (semantic-idle-breadcrumbs--tag-function
;; senator-fold-tag-toggle)
;; (semantic-idle-breadcrumbs--tag-function #'senator-fold-tag-toggle)
;; :active t
;; :style 'toggle
;; :selected '(let ((tag (semantic-current-tag)))

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

@ -1,4 +1,4 @@
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2008, 2010-2021 Free Software
;; Foundation, Inc.
@ -57,14 +57,12 @@
(defcustom semantic-imenu-summary-function 'semantic-format-tag-abbreviate
"Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
:group 'semantic-imenu
:type semantic-format-tag-custom-list)
(make-variable-buffer-local 'semantic-imenu-summary-function)
;;;###autoload
(defcustom semantic-imenu-bucketize-file t
"Non-nil if tags in a file are to be grouped into buckets."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-file)
@ -72,20 +70,17 @@ Some useful functions are found in `semantic-format-tag-functions'."
"Non-nil if types in a file should adopt externally defined members.
C++ and CLOS can define methods that are not in the body of a class
definition."
:group 'semantic-imenu
:type 'boolean)
(defcustom semantic-imenu-buckets-to-submenu t
"Non-nil if buckets of tags are to be turned into submenus.
This option is ignored if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-buckets-to-submenu)
;;;###autoload
(defcustom semantic-imenu-expand-type-members t
"Non-nil if types should have submenus with members in them."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
@ -93,7 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil."
"Non-nil if members of a type should be grouped into buckets.
A nil value means to keep them in the same order.
Overridden to nil if `semantic-imenu-bucketize-file' is nil."
:group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
@ -101,7 +95,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
"Function to use when sorting tags in the buckets of functions.
See `semantic-bucketize' and the FILTER argument for more details
on this function."
:group 'semantic-imenu
:type '(radio (const :tag "No Sorting" nil)
(const semantic-sort-tags-by-name-increasing)
(const semantic-sort-tags-by-name-decreasing)
@ -119,14 +112,12 @@ on this function."
Doesn't actually parse the entire directory, but displays tags for all files
currently listed in the current Semantic database.
This variable has no meaning if semanticdb is not active."
:group 'semantic-imenu
:type 'boolean)
(defcustom semantic-imenu-auto-rebuild-directory-indexes nil
"If non-nil automatically rebuild directory index imenus.
That is when a directory index imenu is updated, automatically rebuild
other buffer local ones based on the same semanticdb."
:group 'semantic-imenu
:type 'boolean)
(defvar semantic-imenu-directory-current-file nil
@ -206,7 +197,7 @@ Optional argument REST is some extra stuff."
(setq imenu--index-alist nil)))))
))
(defun semantic-imenu-flush-fcn (&optional ignore)
(defun semantic-imenu-flush-fcn (&optional _ignore)
"This function is called as a hook to clear the imenu cache.
It is cleared after any parsing.
IGNORE arguments."
@ -214,9 +205,9 @@ IGNORE arguments."
(setq imenu--index-alist nil
imenu-menubar-modified-tick 0))
(remove-hook 'semantic-after-toplevel-cache-change-hook
'semantic-imenu-flush-fcn t)
#'semantic-imenu-flush-fcn t)
(remove-hook 'semantic-after-partial-cache-change-hook
'semantic-imenu-flush-fcn t)
#'semantic-imenu-flush-fcn t)
)
;;;###autoload
@ -224,7 +215,7 @@ IGNORE arguments."
"Create an imenu index for any buffer which supports Semantic.
Uses the output of the Semantic parser to create the index.
Optional argument STREAM is an optional stream of tags used to create menus."
(setq imenu-default-goto-function 'semantic-imenu-goto-function)
(setq imenu-default-goto-function #'semantic-imenu-goto-function)
(prog1
(if (and semantic-imenu-index-directory
(featurep 'semantic/db)
@ -234,9 +225,9 @@ Optional argument STREAM is an optional stream of tags used to create menus."
(semantic-create-imenu-index-1
(or stream (semantic-fetch-tags-fast)) nil))
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-imenu-flush-fcn nil t)
#'semantic-imenu-flush-fcn nil t)
(add-hook 'semantic-after-partial-cache-change-hook
'semantic-imenu-flush-fcn nil t)))
#'semantic-imenu-flush-fcn nil t)))
(defun semantic-create-imenu-directory-index (&optional stream)
"Create an imenu tag index based on all files active in semanticdb.
@ -445,7 +436,7 @@ Clears all imenu menus that may be depending on the database."
;; Clear imenu cache to redraw the imenu.
(semantic-imenu-flush-fcn))))
(add-hook 'semanticdb-mode-hook 'semantic-imenu-semanticdb-hook)
(add-hook 'semanticdb-mode-hook #'semantic-imenu-semanticdb-hook)
;;; Interactive Utilities
;;
@ -484,7 +475,6 @@ Clears all imenu menus that may be depending on the database."
(defcustom semantic-which-function-use-color nil
"Use color when displaying the current function with `which-function'."
:group 'semantic-imenu
:type 'boolean)
(defun semantic-default-which-function (taglist)

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

@ -1,6 +1,6 @@
;;; semantic/java.el --- Semantic functions for Java
;;; semantic/java.el --- Semantic functions for Java -*- lexical-binding: t; -*-
;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@ -148,7 +148,7 @@ corresponding compound declaration."
(let* ((name (semantic-tag-name tag))
(rsplit (nreverse (split-string name "\\." t)))
(newclassname (car rsplit))
(newpkg (mapconcat 'identity (reverse (cdr rsplit)) ".")))
(newpkg (mapconcat #'identity (reverse (cdr rsplit)) ".")))
(semantic-tag-set-name tag newclassname)
(setq xpand
(list tag
@ -169,7 +169,7 @@ corresponding compound declaration."
(define-mode-local-override semantic-ctxt-scoped-types
java-mode (&optional point)
"Return a list of type names currently in scope at POINT."
(mapcar 'semantic-tag-name
(mapcar #'semantic-tag-name
(semantic-find-tags-by-class
'type (semantic-find-tag-by-overlay point))))
@ -184,7 +184,7 @@ Override function for `semantic-tag-protection'."
;; Prototype handler
;;
(defun semantic-java-prototype-function (tag &optional parent color)
(defun semantic-java-prototype-function (tag &optional _parent color)
"Return a function (method) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@ -212,7 +212,7 @@ See also `semantic-format-tag-prototype'."
(or type "") (if type " " "")
name "(" argp ")")))
(defun semantic-java-prototype-variable (tag &optional parent color)
(defun semantic-java-prototype-variable (tag &optional _parent color)
"Return a variable (field) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@ -227,7 +227,7 @@ See also `semantic-format-tag-prototype'."
(semantic--format-colorize-text name 'variable)
name))))
(defun semantic-java-prototype-type (tag &optional parent color)
(defun semantic-java-prototype-type (tag &optional _parent color)
"Return a type (class/interface) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@ -260,7 +260,7 @@ Optional argument COLOR indicates that color should be mixed in."
(define-mode-local-override semantic-tag-include-filename java-mode (tag)
"Return a suitable path for (some) Java imports."
(let ((name (semantic-tag-name tag)))
(concat (mapconcat 'identity (split-string name "\\.") "/") ".java")))
(concat (mapconcat #'identity (split-string name "\\.") "/") ".java")))
;; Documentation handler
;;
@ -417,15 +417,13 @@ 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

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

@ -850,7 +850,7 @@ Argument BEG and END specify the bounds of SYM in the buffer."
))
(define-obsolete-function-alias
'semantic-lex-spp-anlyzer-do-replace
'semantic-lex-spp-analyzer-do-replace "25.1")
#'semantic-lex-spp-analyzer-do-replace "25.1")
(defvar semantic-lex-spp-replacements-enabled t
"Non-nil means do replacements when finding keywords.
@ -1070,7 +1070,7 @@ and variable state from the current buffer."
(semantic-lex-init)
(semantic-clear-toplevel-cache)
(remove-hook 'semantic-lex-reset-functions
'semantic-lex-spp-reset-hook t)
#'semantic-lex-spp-reset-hook t)
))
;; Second Cheat: copy key variables regarding macro state from the

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

@ -469,7 +469,7 @@ PROPERTY set."
;;; Lexical Analyzer framework settings
;;
(defvar-local semantic-lex-analyzer 'semantic-lex
(defvar-local semantic-lex-analyzer #'semantic-lex
"The lexical analyzer used for a given buffer.
See `semantic-lex' for documentation.")

20
lisp/cedet/semantic/mru-bookmark.el
View file

@ -1,4 +1,4 @@
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@ -85,7 +85,7 @@ Nice values include the following:
)
"A single bookmark.")
(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest _fields)
"Initialize the bookmark SBM with details about :tag."
(condition-case nil
(save-excursion
@ -216,7 +216,7 @@ Cause tags in the ring to become unlinked."
(setq idx (1+ idx)))))
(add-hook 'semantic-before-toplevel-cache-flush-hook
'semantic-mrub-cache-flush-fcn)
#'semantic-mrub-cache-flush-fcn)
;;; EDIT tracker
;;
@ -246,8 +246,8 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]."
:group 'semantic-modes
:type 'boolean
:require 'semantic/util-modes
:initialize 'custom-initialize-default
:set (lambda (sym val)
:initialize #'custom-initialize-default
:set (lambda (_sym val)
(global-semantic-mru-bookmark-mode (if val 1 -1))))
;;;###autoload
@ -266,7 +266,7 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]."
(defvar semantic-mru-bookmark-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "\C-xB" 'semantic-mrub-switch-tags)
(define-key km "\C-xB" #'semantic-mrub-switch-tags)
km)
"Keymap for mru-bookmark minor mode.")
@ -289,14 +289,14 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing"
(buffer-name)))
(add-hook 'semantic-edits-new-change-functions
'semantic-mru-bookmark-change-hook-fcn nil t)
#'semantic-mru-bookmark-change-hook-fcn nil t)
(add-hook 'semantic-edits-move-change-hooks
'semantic-mru-bookmark-change-hook-fcn nil t))
#'semantic-mru-bookmark-change-hook-fcn nil t))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
'semantic-mru-bookmark-change-hook-fcn t)
#'semantic-mru-bookmark-change-hook-fcn t)
(remove-hook 'semantic-edits-move-change-hooks
'semantic-mru-bookmark-change-hook-fcn t)))
#'semantic-mru-bookmark-change-hook-fcn t)))
(semantic-add-minor-mode 'semantic-mru-bookmark-mode
"k")

21
lisp/cedet/semantic/senator.el
View file

@ -1,4 +1,4 @@
;;; semantic/senator.el --- SEmantic NAvigaTOR
;;; semantic/senator.el --- SEmantic NAvigaTOR -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@ -60,7 +60,6 @@ A tag class is a symbol, such as `variable', `function', or `type'.
As a special exception, if the value is nil, Senator's navigation
commands recognize all tag classes."
:group 'senator
:type '(repeat (symbol)))
;;;###autoload
(make-variable-buffer-local 'senator-step-at-tag-classes)
@ -78,7 +77,6 @@ commands stop at the beginning of every tag.
If t, the navigation commands stop at the start and end of any
tag, where possible."
:group 'senator
:type '(choice :tag "Identifiers"
(repeat :menu-tag "Symbols" (symbol))
(const :tag "All" t)))
@ -87,7 +85,6 @@ tag, where possible."
(defcustom senator-highlight-found nil
"If non-nil, Senator commands momentarily highlight found tags."
:group 'senator
:type 'boolean)
(make-variable-buffer-local 'senator-highlight-found)
@ -193,7 +190,6 @@ source."
'(code block)
"List of ignored tag classes.
Tags of those classes are excluded from search."
:group 'senator
:type '(repeat (symbol :tag "class")))
(defun senator-search-default-tag-filter (tag)
@ -461,7 +457,7 @@ filters in `senator-search-tag-filter-functions' remain active."
((symbolp classes)
(list classes))
((stringp classes)
(mapcar 'read (split-string classes)))
(mapcar #'read (split-string classes)))
(t
(signal 'wrong-type-argument (list classes)))
))
@ -470,11 +466,10 @@ filters in `senator-search-tag-filter-functions' remain active."
senator--search-filter t)
(kill-local-variable 'senator--search-filter)
(if classes
(let ((tag (make-symbol "tag"))
(names (mapconcat 'symbol-name classes "', `")))
(let ((names (mapconcat #'symbol-name classes "', `")))
(setq-local senator--search-filter
`(lambda (,tag)
(memq (semantic-tag-class ,tag) ',classes)))
(lambda (tag)
(memq (semantic-tag-class tag) classes)))
(add-hook 'senator-search-tag-filter-functions
senator--search-filter nil t)
(message "Limit search to `%s' tags" names))
@ -605,7 +600,7 @@ Makes C/C++ language like assumptions."
"Non-nil if isearch does semantic search.
This is a buffer local variable.")
(defun senator-beginning-of-defun (&optional arg)
(defun senator-beginning-of-defun (&optional _arg)
"Move backward to the beginning of a defun.
Use semantic tags to navigate.
ARG is the number of tags to navigate (not yet implemented)."
@ -620,7 +615,7 @@ ARG is the number of tags to navigate (not yet implemented)."
(goto-char (semantic-tag-start tag)))
(beginning-of-line))))
(defun senator-end-of-defun (&optional arg)
(defun senator-end-of-defun (&optional _arg)
"Move forward to next end of defun.
Use semantic tags to navigate.
ARG is the number of tags to navigate (not yet implemented)."
@ -859,7 +854,7 @@ Use a senator search function when semantic isearch mode is enabled."
(setq-local senator-old-isearch-search-fun
isearch-search-fun-function))
(setq-local isearch-search-fun-function
'senator-isearch-search-fun))
#'senator-isearch-search-fun))
;; When `senator-isearch-semantic-mode' is off restore the
;; previous `isearch-search-fun-function'.
(when (eq isearch-search-fun-function 'senator-isearch-search-fun)

20
lisp/cedet/semantic/sort.el
View file

@ -1,6 +1,6 @@
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables. -*- lexical-binding: t; -*-
;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@ -233,8 +233,7 @@ unmodified as components of their parent tags."
(semantic-flatten-tags-table components)
lists)))))
table)
(apply 'append (nreverse lists))
))
(apply #'append (nreverse lists))))
;;; Buckets:
@ -520,12 +519,11 @@ See `semantic-tag-external-member-children' for details."
(semantic-tag-name tag) tag)))
(if m (apply #'append (mapcar #'cdr m))))
(semantic--find-tags-by-function
`(lambda (tok)
;; This bit of annoying backquote forces the contents of
;; tag into the generated lambda.
(semantic-tag-external-member-p ',tag tok))
(current-buffer))
))
(lambda (tok)
;; This bit of annoying backquote forces the contents of
;; tag into the generated lambda.
(semantic-tag-external-member-p tag tok))
(current-buffer))))
(define-overloadable-function semantic-tag-external-class (tag)
"Return a list of real tags that faux TAG might represent.
@ -540,6 +538,8 @@ likely derived, then this function is needed."
(:override)
)
(defvar semanticdb-search-system-databases)
(defun semantic-tag-external-class-default (tag)
"Return a list of real tags that faux TAG might represent.
See `semantic-tag-external-class' for details."

8
lisp/cedet/semantic/symref.el
View file

@ -1,4 +1,4 @@
;;; semantic/symref.el --- Symbol Reference API
;;; semantic/symref.el --- Symbol Reference API -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -144,7 +144,7 @@ ARGS are the initialization arguments to pass to the created class."
)
(when (not (class-p class))
(error "Unknown symref tool %s" semantic-symref-tool))
(setq inst (apply 'make-instance class args))
(setq inst (apply #'make-instance class args))
inst))
(defvar semantic-symref-last-result nil
@ -427,7 +427,7 @@ until the next command is executed."
(kill-buffer buff)))
semantic-symref-recently-opened-buffers)
(setq semantic-symref-recently-opened-buffers nil)
(remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
(remove-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
)
(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
@ -453,7 +453,7 @@ already."
lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
(if (not open-buffers)
(add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
(add-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
;; Else, just clear the saved buffers so they aren't deleted later.
(setq semantic-symref-recently-opened-buffers nil)
)

28
lisp/cedet/semantic/symref/list.el
View file

@ -108,20 +108,20 @@ Display the references in `semantic-symref-results-mode'."
(defvar semantic-symref-results-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
(define-key km "\C-i" 'forward-button)
(define-key km "\M-C-i" 'backward-button)
(define-key km " " 'push-button)
(define-key km "-" 'semantic-symref-list-toggle-showing)
(define-key km "=" 'semantic-symref-list-toggle-showing)
(define-key km "+" 'semantic-symref-list-toggle-showing)
(define-key km "n" 'semantic-symref-list-next-line)
(define-key km "p" 'semantic-symref-list-prev-line)
(define-key km "q" 'quit-window)
(define-key km "\C-c\C-e" 'semantic-symref-list-expand-all)
(define-key km "\C-c\C-r" 'semantic-symref-list-contract-all)
(define-key km "R" 'semantic-symref-list-rename-open-hits)
(define-key km "(" 'semantic-symref-list-create-macro-on-open-hit)
(define-key km "E" 'semantic-symref-list-call-macro-on-open-hits)
(define-key km "\C-i" #'forward-button)
(define-key km "\M-C-i" #'backward-button)
(define-key km " " #'push-button)
(define-key km "-" #'semantic-symref-list-toggle-showing)
(define-key km "=" #'semantic-symref-list-toggle-showing)
(define-key km "+" #'semantic-symref-list-toggle-showing)
(define-key km "n" #'semantic-symref-list-next-line)
(define-key km "p" #'semantic-symref-list-prev-line)
(define-key km "q" #'quit-window)
(define-key km "\C-c\C-e" #'semantic-symref-list-expand-all)
(define-key km "\C-c\C-r" #'semantic-symref-list-contract-all)
(define-key km "R" #'semantic-symref-list-rename-open-hits)
(define-key km "(" #'semantic-symref-list-create-macro-on-open-hit)
(define-key km "E" #'semantic-symref-list-call-macro-on-open-hits)
km)
"Keymap used in `semantic-symref-results-mode'.")

2
lisp/cedet/semantic/tag-file.el
View file

@ -1,4 +1,4 @@
;;; semantic/tag-file.el --- Routines that find files based on tags.
;;; semantic/tag-file.el --- Routines that find files based on tags. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.

23
lisp/cedet/semantic/tag-ls.el
View file

@ -1,4 +1,4 @@
;;; semantic/tag-ls.el --- Language Specific override functions for tags
;;; semantic/tag-ls.el --- Language Specific override functions for tags -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2004, 2006-2021 Free Software Foundation, Inc.
@ -97,7 +97,7 @@ Modes that override this function can call
`semantic--tag-attribute-similar-p-default' to do the default equality tests if
ATTR is not special for that mode.")
(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes)
(defun semantic--tag-attribute-similar-p-default (_attr value1 value2 ignorable-attributes)
"For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity."
(cond
;; Tag sublists require special testing.
@ -109,7 +109,7 @@ ATTR is not special for that mode.")
(when (not (eq (length taglist1) (length taglist2)))
(setq ans nil))
(while (and ans taglist1 taglist2)
(setq ans (apply 'semantic-tag-similar-p
(setq ans (apply #'semantic-tag-similar-p
(car taglist1) (car taglist2)
ignorable-attributes)
taglist1 (cdr taglist1)
@ -205,7 +205,7 @@ stream for a tag of class `package', and return that."
(or stream-or-buffer tag))))
(:override-with-args (tag stream))))
(defun semantic-tag-full-package-default (tag stream)
(defun semantic-tag-full-package-default (_tag stream)
"Default method for `semantic-tag-full-package' for TAG.
Return the name of the first tag of class `package' in STREAM."
(let ((pack (car-safe (semantic-find-tags-by-class 'package stream))))
@ -285,7 +285,7 @@ is to return a symbol based on type modifiers."
(setq parent (semantic-tag-calculate-parent tag)))
(:override))
(defun semantic-tag-protection-default (tag &optional parent)
(defun semantic-tag-protection-default (tag &optional _parent)
"Return the protection of TAG as a child of PARENT default action.
See `semantic-tag-protection'."
(let ((mods (semantic-tag-modifiers tag))
@ -295,9 +295,7 @@ See `semantic-tag-protection'."
(let ((s (car mods)))
(setq prot
;; A few silly defaults to get things started.
(cond ((or (string= s "public")
(string= s "extern")
(string= s "export"))
(cond ((member s '("public" "extern" "export"))
'public)
((string= s "private")
'private)
@ -372,15 +370,14 @@ in how methods are overridden. In UML, abstract methods are italicized.
The default behavior (if not overridden with `tag-abstract-p'
is to return true if `abstract' is in the type modifiers.")
(defun semantic-tag-abstract-p-default (tag &optional parent)
(defun semantic-tag-abstract-p-default (tag &optional _parent)
"Return non-nil if TAG is abstract as a child of PARENT default action.
See `semantic-tag-abstract-p'."
(let ((mods (semantic-tag-modifiers tag))
(abs nil))
(while (and (not abs) mods)
(if (stringp (car mods))
(setq abs (or (string= (car mods) "abstract")
(string= (car mods) "virtual"))))
(setq abs (member (car mods) '("abstract" "virtual"))))
(setq mods (cdr mods)))
abs))
@ -392,7 +389,7 @@ In UML, leaf methods and classes have special meaning and behavior.
The default behavior (if not overridden with `tag-leaf-p'
is to return true if `leaf' is in the type modifiers.")
(defun semantic-tag-leaf-p-default (tag &optional parent)
(defun semantic-tag-leaf-p-default (tag &optional _parent)
"Return non-nil if TAG is leaf as a child of PARENT default action.
See `semantic-tag-leaf-p'."
(let ((mods (semantic-tag-modifiers tag))
@ -412,7 +409,7 @@ In UML, static methods and attributes mean that they are allocated
in the parent class, and are not instance specific.
UML notation specifies that STATIC entries are underlined.")
(defun semantic-tag-static-p-default (tag &optional parent)
(defun semantic-tag-static-p-default (tag &optional _parent)
"Return non-nil if TAG is static as a child of PARENT default action.
See `semantic-tag-static-p'."
(let ((mods (semantic-tag-modifiers tag))

4
lisp/cedet/semantic/tag-write.el
View file

@ -1,4 +1,4 @@
;;; semantic/tag-write.el --- Write tags to a text stream
;;; semantic/tag-write.el --- Write tags to a text stream -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@ -88,7 +88,7 @@ INDENT is the amount of indentation to use for this tag."
(if (semantic-tag-with-position-p tag)
(let ((bounds (semantic-tag-bounds tag)))
(princ " ")
(prin1 (apply 'vector bounds))
(prin1 (apply #'vector bounds))
)
(princ " nil"))
;; End it.

22
lisp/cedet/semantic/tag.el
View file

@ -478,7 +478,7 @@ TYPE is a string or semantic tag representing the type of this variable.
Optional DEFAULT-VALUE is a string representing the default value of this
variable.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'variable
(apply #'semantic-tag name 'variable
:type type
:default-value default-value
attributes))
@ -490,7 +490,7 @@ TYPE is a string or semantic tag representing the type of this function.
ARG-LIST is a list of strings or semantic tags representing the
arguments of this function.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'function
(apply #'semantic-tag name 'function
:type type
:arguments arg-list
attributes))
@ -513,7 +513,7 @@ This slot can be interesting because the form:
is a valid parent where there is no explicit parent, and only an
interface.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'type
(apply #'semantic-tag name 'type
:type type
:members members
:superclasses (car parents)
@ -526,7 +526,7 @@ NAME is the name of this include.
SYSTEM-FLAG represents that we were able to identify this include as
belonging to the system, as opposed to belonging to the local project.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'include
(apply #'semantic-tag name 'include
:system-flag system-flag
attributes))
@ -536,7 +536,7 @@ NAME is the name of this package.
DETAIL is extra information about this package, such as a location
where it can be found.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'package
(apply #'semantic-tag name 'package
:detail detail
attributes))
@ -545,7 +545,7 @@ ATTRIBUTES is a list of additional attributes belonging to this tag."
NAME is a name for this code.
DETAIL is extra information about the code.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'code
(apply #'semantic-tag name 'code
:detail detail
attributes))
@ -685,7 +685,7 @@ FILTER takes TAG as an argument, and should return a `semantic-tag'.
It is safe for FILTER to modify the input tag and return it."
(when (not filter) (setq filter 'identity))
(when (not (semantic-tag-p tag))
(signal 'wrong-type-argument (list tag 'semantic-tag-p)))
(signal 'wrong-type-argument (list tag #'semantic-tag-p)))
(let ((ol (semantic-tag-overlay tag))
(fn (semantic-tag-file-name tag)))
(funcall filter (list (semantic-tag-name tag)
@ -937,7 +937,7 @@ NAME is a name for this alias.
META-TAG-CLASS is the class of the tag this tag is an alias.
VALUE is the aliased definition.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(apply 'semantic-tag name 'alias
(apply #'semantic-tag name 'alias
:aliasclass meta-tag-class
:definition value
attributes))
@ -1093,7 +1093,7 @@ For any given situation, additional ARGS may be passed."
(condition-case err
;; If a hook bombs, ignore it! Usually this is tied into
;; some sort of critical system.
(apply 'run-hook-with-args 'semantic--tag-hook-value arglist)
(apply #'run-hook-with-args 'semantic--tag-hook-value arglist)
(error (message "Error: %S" err)))))
;;; Tags and Overlays
@ -1104,7 +1104,7 @@ For any given situation, additional ARGS may be passed."
(defsubst semantic--tag-unlink-list-from-buffer (tags)
"Convert TAGS from using an overlay to using an overlay proxy.
This function is for internal use only."
(mapcar 'semantic--tag-unlink-from-buffer tags))
(mapcar #'semantic--tag-unlink-from-buffer tags))
(defun semantic--tag-unlink-from-buffer (tag)
"Convert TAG from using an overlay to using an overlay proxy.
@ -1125,7 +1125,7 @@ This function is for internal use only."
(defsubst semantic--tag-link-list-to-buffer (tags)
"Convert TAGS from using an overlay proxy to using an overlay.
This function is for internal use only."
(mapc 'semantic--tag-link-to-buffer tags))
(mapc #'semantic--tag-link-to-buffer tags))
(defun semantic--tag-link-to-buffer (tag)
"Convert TAG from using an overlay proxy to using an overlay.

18
lisp/cedet/semantic/texi.el
View file

@ -1,4 +1,4 @@
;;; semantic/texi.el --- Semantic details for Texinfo files
;;; semantic/texi.el --- Semantic details for Texinfo files -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2005, 2007-2021 Free Software Foundation, Inc.
@ -55,7 +55,7 @@ The field position is the field number (based at 1) where the
name of this section is.")
;;; Code:
(defun semantic-texi-parse-region (&rest ignore)
(defun semantic-texi-parse-region (&rest _ignore)
"Parse the current texinfo buffer for semantic tags.
IGNORE any arguments, always parse the whole buffer.
Each tag returned is of the form:
@ -79,7 +79,7 @@ function `semantic-install-function-overrides'."
(let ((chil (semantic-tag-components tag)))
(if chil
(semantic-tag-put-attribute
tag :members (mapcar 'semantic-texi-expand-tag chil)))
tag :members (mapcar #'semantic-texi-expand-tag chil)))
(car (semantic--tag-expand tag))))
(defun semantic-texi-parse-headings ()
@ -297,7 +297,7 @@ can handle the @menu environment.")
nil))
(define-mode-local-override semantic-ctxt-current-class-list
texinfo-mode (&optional point)
texinfo-mode (&optional _point)
"Determine the class of tags that can be used at POINT.
For texinfo, there two possibilities returned.
1) `function' - for a call to a texinfo function
@ -368,7 +368,7 @@ Optional argument POINT is where to look for the environment."
(declare-function semantic-analyze-context "semantic/analyze")
(define-mode-local-override semantic-analyze-current-context
texinfo-mode (point)
texinfo-mode (_point)
"Analysis context makes no sense for texinfo. Return nil."
(let* ((prefixandbounds (semantic-ctxt-current-symbol-and-bounds (point)))
(prefix (car prefixandbounds))
@ -408,7 +408,7 @@ Optional argument POINT is where to look for the environment."
"List of commands that we might bother completing.")
(define-mode-local-override semantic-analyze-possible-completions
texinfo-mode (context &rest flags)
texinfo-mode (context &rest _flags)
"List smart completions at point.
Since texinfo is not a programming language the default version is not
useful. Instead, look at the current symbol. If it is a command
@ -451,7 +451,7 @@ that start with that symbol."
(setq semantic-parser-name "TEXI"
;; Setup a dummy parser table to enable parsing!
semantic--parse-table t
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character "@"
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list '((section . "Section")
@ -466,7 +466,7 @@ that start with that symbol."
;; (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi)
)
(add-hook 'texinfo-mode-hook 'semantic-default-texi-setup)
(add-hook 'texinfo-mode-hook #'semantic-default-texi-setup)
;;; Special features of Texinfo tag streams
@ -500,7 +500,7 @@ that start with that symbol."
;; Turns out this might not be useful.
;; Delete later if that is true.
(defun semantic-texi-find-documentation (name &optional type)
(defun semantic-texi-find-documentation (name &optional _type)
"Find the function or variable NAME of TYPE in the texinfo source.
NAME is a string representing some functional symbol.
TYPE is a string, such as \"variable\" or \"Command\" used to find

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

@ -1,4 +1,4 @@
;;; semantic/util-modes.el --- Semantic minor modes
;;; semantic/util-modes.el --- Semantic minor modes -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@ -48,7 +48,7 @@ line."
:group 'semantic
:type 'boolean
:require 'semantic/util-modes
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
;; Update status of all Semantic enabled buffers
@ -60,7 +60,7 @@ line."
:group 'semantic
:type 'string
:require 'semantic/util-modes
:initialize 'custom-initialize-default)
:initialize #'custom-initialize-default)
(defvar semantic-minor-modes-format nil
"Mode line format showing Semantic minor modes which are locally enabled.
@ -93,7 +93,7 @@ Only minor modes that are locally enabled are shown in the mode line."
(match-string 1 semantic-mode-line-prefix)
"S")))
(setq semantic-minor-modes-format
`((:eval (if (or ,@(mapcar 'car locals))
`((:eval (if (or ,@(mapcar #'car locals))
,(concat " " prefix)))))
;; It would be easier to just put `locals' inside
;; semantic-minor-modes-format, but then things like
@ -111,7 +111,7 @@ Only minor modes that are locally enabled are shown in the mode line."
(cons elem minor-mode-alist)))))
(setcdr tail (nconc locals (cdr tail)))))))))
(defun semantic-desktop-ignore-this-minor-mode (buffer)
(defun semantic-desktop-ignore-this-minor-mode (_buffer)
"Installed as a minor-mode initializer for Desktop mode.
BUFFER is the buffer to not initialize a Semantic minor mode in."
nil)
@ -221,10 +221,10 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing"
(buffer-name)))
(add-hook 'semantic-edits-new-change-functions
'semantic-highlight-edits-new-change-hook-fcn nil t))
#'semantic-highlight-edits-new-change-hook-fcn nil t))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
'semantic-highlight-edits-new-change-hook-fcn t)))
#'semantic-highlight-edits-new-change-hook-fcn t)))
(semantic-add-minor-mode 'semantic-highlight-edits-mode
"e")
@ -345,7 +345,7 @@ Do not search past BOUND if non-nil."
(defvar semantic-show-unmatched-syntax-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "\C-c,`" 'semantic-show-unmatched-syntax-next)
(define-key km "\C-c,`" #'semantic-show-unmatched-syntax-next)
km)
"Keymap for command `semantic-show-unmatched-syntax-mode'.")
@ -372,18 +372,18 @@ non-nil if the minor mode is enabled.
(buffer-name)))
;; Add hooks
(add-hook 'semantic-unmatched-syntax-hook
'semantic-show-unmatched-syntax nil t)
#'semantic-show-unmatched-syntax nil t)
(add-hook 'semantic-pre-clean-token-hooks
'semantic-clean-token-of-unmatched-syntax nil t)
#'semantic-clean-token-of-unmatched-syntax nil t)
;; Show unmatched syntax elements
(if (not (semantic--umatched-syntax-needs-refresh-p))
(semantic-show-unmatched-syntax
(semantic-unmatched-syntax-tokens))))
;; Remove hooks
(remove-hook 'semantic-unmatched-syntax-hook
'semantic-show-unmatched-syntax t)
#'semantic-show-unmatched-syntax t)
(remove-hook 'semantic-pre-clean-token-hooks
'semantic-clean-token-of-unmatched-syntax t)
#'semantic-clean-token-of-unmatched-syntax t)
;; Cleanup unmatched-syntax highlighting
(semantic-clean-unmatched-syntax-in-buffer)))
@ -454,46 +454,46 @@ non-nil if the minor mode is enabled."
'(semantic-show-parser-state-string))))
;; Add hooks
(add-hook 'semantic-edits-new-change-functions
'semantic-show-parser-state-marker nil t)
#'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-edits-incremental-reparse-failed-hook
'semantic-show-parser-state-marker nil t)
#'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-after-partial-cache-change-hook
'semantic-show-parser-state-marker nil t)
#'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-show-parser-state-marker nil t)
#'semantic-show-parser-state-marker nil t)
(semantic-show-parser-state-marker)
(add-hook 'semantic-before-auto-parse-hooks
'semantic-show-parser-state-auto-marker nil t)
#'semantic-show-parser-state-auto-marker nil t)
(add-hook 'semantic-after-auto-parse-hooks
'semantic-show-parser-state-marker nil t)
#'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-before-idle-scheduler-reparse-hook
'semantic-show-parser-state-auto-marker nil t)
#'semantic-show-parser-state-auto-marker nil t)
(add-hook 'semantic-after-idle-scheduler-reparse-hook
'semantic-show-parser-state-marker nil t))
#'semantic-show-parser-state-marker nil t))
;; Remove parts of mode line
(setq mode-line-modified
(delq 'semantic-show-parser-state-string mode-line-modified))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
'semantic-show-parser-state-marker t)
#'semantic-show-parser-state-marker t)
(remove-hook 'semantic-edits-incremental-reparse-failed-hook
'semantic-show-parser-state-marker t)
#'semantic-show-parser-state-marker t)
(remove-hook 'semantic-after-partial-cache-change-hook
'semantic-show-parser-state-marker t)
#'semantic-show-parser-state-marker t)
(remove-hook 'semantic-after-toplevel-cache-change-hook
'semantic-show-parser-state-marker t)
#'semantic-show-parser-state-marker t)
(remove-hook 'semantic-before-auto-parse-hooks
'semantic-show-parser-state-auto-marker t)
#'semantic-show-parser-state-auto-marker t)
(remove-hook 'semantic-after-auto-parse-hooks
'semantic-show-parser-state-marker t)
#'semantic-show-parser-state-marker t)
(remove-hook 'semantic-before-idle-scheduler-reparse-hook
'semantic-show-parser-state-auto-marker t)
#'semantic-show-parser-state-auto-marker t)
(remove-hook 'semantic-after-idle-scheduler-reparse-hook
'semantic-show-parser-state-marker t)))
#'semantic-show-parser-state-marker t)))
(semantic-add-minor-mode 'semantic-show-parser-state-mode
"")
@ -502,7 +502,7 @@ non-nil if the minor mode is enabled."
"String showing the parser state for this buffer.
See `semantic-show-parser-state-marker' for details.")
(defun semantic-show-parser-state-marker (&rest ignore)
(defun semantic-show-parser-state-marker (&rest _ignore)
"Set `semantic-show-parser-state-string' to indicate parser state.
This marker is one of the following:
`-' -> The cache is up to date.
@ -555,7 +555,7 @@ to indicate a parse in progress."
(defvar semantic-stickyfunc-mode-map
(let ((km (make-sparse-keymap)))
(define-key km [ header-line down-mouse-1 ] 'semantic-stickyfunc-menu)
(define-key km [ header-line down-mouse-1 ] #'semantic-stickyfunc-menu)
km)
"Keymap for stickyfunc minor mode.")
@ -826,7 +826,7 @@ Argument EVENT describes the event that caused this function to be called."
(defvar semantic-highlight-func-mode-map
(let ((km (make-sparse-keymap)))
(define-key km [mouse-3] 'semantic-highlight-func-menu)
(define-key km [mouse-3] #'semantic-highlight-func-menu)
km)
"Keymap for highlight-func minor mode.")
@ -916,10 +916,10 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing" (buffer-name)))
;; Setup our hook
(add-hook 'post-command-hook
'semantic-highlight-func-highlight-current-tag nil t))
#'semantic-highlight-func-highlight-current-tag nil t))
;; Disable highlight func mode
(remove-hook 'post-command-hook
'semantic-highlight-func-highlight-current-tag t)
#'semantic-highlight-func-highlight-current-tag t)
(semantic-highlight-func-highlight-current-tag t)))
(defun semantic-highlight-func-highlight-current-tag (&optional disable)

11
lisp/cedet/semantic/util.el
View file

@ -1,6 +1,6 @@
;;; semantic/util.el --- Utilities for use with semantic tag tables
;;; semantic/util.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*-
;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@ -114,7 +114,10 @@ buffer, or a filename. If SOMETHING is nil return nil."
((and (featurep 'semantic/db)
(require 'semantic/db-mode)
(semanticdb-minor-mode-p)
(cl-typep something 'semanticdb-abstract-table))
(progn
(declare-function semanticdb-abstract-table--eieio-childp
"semantic/db")
(cl-typep something 'semanticdb-abstract-table)))
(semanticdb-refresh-table something)
(semanticdb-get-tags something))
;; Semanticdb find-results
@ -427,7 +430,7 @@ determining which symbols are considered."
(setq completion (try-completion pattern collection predicate))
(if (string= pattern completion)
(let ((list (all-completions pattern collection predicate)))
(setq list (sort list 'string<))
(setq list (sort list #'string<))
(if (> (length list) 1)
(with-output-to-temp-buffer "*Completions*"
(display-completion-list

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

@ -3450,7 +3450,7 @@ Automatically called by the Emacs Lisp byte compiler as a
`byte-compile' handler."
(byte-compile-form
(macroexpand-all
(wisent-automaton-lisp-form (eval form)))))
(wisent-automaton-lisp-form (eval form t)))))
(defun wisent-compile-grammar (grammar &optional start-list)
;; This is kept for compatibility with FOO-wy.el files generated

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

@ -111,12 +111,12 @@ Use the alternate LALR(1) parser."
(setq
;; Lexical analysis
semantic-lex-number-expression semantic-java-number-regexp
semantic-lex-analyzer 'wisent-java-tags-lexer
semantic-lex-analyzer #'wisent-java-tags-lexer
;; Parsing
semantic-tag-expand-function 'semantic-java-expand-tag
semantic-tag-expand-function #'semantic-java-expand-tag
;; Environment
semantic-imenu-summary-function 'semantic-format-tag-prototype
imenu-create-index-function 'semantic-create-imenu-index
semantic-imenu-summary-function #'semantic-format-tag-prototype
imenu-create-index-function #'semantic-create-imenu-index
semantic-type-relation-separator-character '(".")
semantic-command-separation-character ";"
;; speedbar and imenu buckets name

8
lisp/cedet/semantic/wisent/javascript.el
View file

@ -128,14 +128,14 @@ This is currently needed for the mozrepl omniscient database."
(wisent-javascript-jv-wy--install-parser)
(setq
;; Lexical Analysis
semantic-lex-analyzer 'javascript-lexer-jv
semantic-lex-analyzer #'javascript-lexer-jv
semantic-lex-number-expression semantic-java-number-regexp
;; semantic-lex-depth nil ;; Full lexical analysis
;; Parsing
semantic-tag-expand-function 'wisent-javascript-jv-expand-tag
semantic-tag-expand-function #'wisent-javascript-jv-expand-tag
;; Environment
semantic-imenu-summary-function 'semantic-format-tag-name
imenu-create-index-function 'semantic-create-imenu-index
semantic-imenu-summary-function #'semantic-format-tag-name
imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character ";"
))

4
lisp/cedet/semantic/wisent/python.el
View file

@ -512,12 +512,12 @@ Shortens `code' tags, but passes through for others."
semantic-type-relation-separator-character '(".")
semantic-command-separation-character ";"
;; Parsing
semantic-tag-expand-function 'semantic-python-expand-tag
semantic-tag-expand-function #'semantic-python-expand-tag
;; Semantic to take over from the one provided by python.
;; The python one, if it uses the senator advice, will hang
;; Emacs unrecoverably.
imenu-create-index-function 'semantic-create-imenu-index
imenu-create-index-function #'semantic-create-imenu-index
;; I need a python guru to update this list:
semantic-symbol->name-assoc-list-for-type-parts '((variable . "Variables")

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

@ -1,6 +1,6 @@
;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime -*- lexical-binding: t; -*-
;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 30 January 2002

2
lisp/cedet/srecode.el
View file

@ -1,6 +1,6 @@
;;; srecode.el --- Semantic buffer evaluator. -*- lexical-binding: t -*-
;;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration

4
lisp/cedet/srecode/cpp.el
View file

@ -164,7 +164,7 @@ specified in a C file."
;; when they make sense. My best bet would be
;; (semantic-tag-function-parent tag), but it is not there, when
;; the function is defined in the scope of a class.
(let ((member t)
(let (;; (member t)
(templates (semantic-tag-get-attribute tag :template))
(modifiers (semantic-tag-modifiers tag)))
@ -185,7 +185,7 @@ specified in a C file."
;; When the function is a member function, it can have
;; additional modifiers.
(when member
(when t ;; member
;; For member functions, constness is called
;; 'methodconst-flag'.

8
lisp/cedet/srecode/mode.el
View file

@ -224,13 +224,11 @@ MENU-DEF is the menu to bind this into."
(if bind
(concat name " (" bind ")")
name)
`(lambda () (interactive)
(srecode-insert (concat ,ctxt ":" ,name)))
(lambda () (interactive)
(srecode-insert (concat ctxt ":" name)))
t)))
(setcdr ctxtcons (cons
new
(cdr ctxtcons)))))
(push new (cdr ctxtcons))))
(setq ltab (cdr ltab))))
(setq subtab (cdr subtab)))

6
lisp/cedet/srecode/template.el
View file

@ -49,11 +49,11 @@
(setq
;; Lexical Analysis
semantic-lex-analyzer 'wisent-srecode-template-lexer
semantic-lex-analyzer #'wisent-srecode-template-lexer
;; Parsing
;; Environment
semantic-imenu-summary-function 'semantic-format-tag-name
imenu-create-index-function 'semantic-create-imenu-index
semantic-imenu-summary-function #'semantic-format-tag-name
imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character "\n"
semantic-lex-comment-regex ";;"
;; Speedbar

6
lisp/comint.el
View file

@ -366,13 +366,15 @@ This variable is buffer-local."
;; OpenBSD doas prints "doas (user@host) password:".
;; See ert test `comint-test-password-regexp'.
(defcustom comint-password-prompt-regexp
;; When extending this, please also add a corresponding test where
;; possible (see `comint-testsuite-password-strings').
(concat
"\\(^ *\\|"
(regexp-opt
'("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the"
"Enter Auth" "enter auth" "Old" "old" "New" "new" "'s" "login"
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO"
"[sudo]" "doas" "Repeat" "Bad" "Retype")
"[sudo]" "doas" "Repeat" "Bad" "Retype" "Verify")
t)
;; Allow for user name to precede password equivalent (Bug#31075).
" +.*\\)"
@ -382,7 +384,7 @@ This variable is buffer-local."
"\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:version "27.1"
:version "28.1"
:type 'regexp
:group 'comint)

98
lisp/emacs-lisp/benchmark.el
View file

@ -31,6 +31,8 @@
;;; Code:
(eval-when-compile (require 'subr-x)) ;For `named-let'.
(defmacro benchmark-elapse (&rest forms)
"Return the time in seconds elapsed for execution of FORMS."
(declare (indent 0) (debug t))
@ -40,6 +42,61 @@
,@forms
(float-time (time-since ,t1)))))
;;;###autoload
(defun benchmark-call (func &optional repetitions)
"Measure the run time of calling FUNC a number REPETITIONS of times.
The result is a list (TIME GC GCTIME)
where TIME is the total time it took, in seconds.
GCTIME is the amount of time that was spent in the GC
and GC is the number of times the GC was called.
REPETITIONS can also be a floating point number, in which case it
specifies a minimum number of seconds that the benchmark execution
should take. In that case the return value is prepended with the
number of repetitions actually used."
(if (floatp repetitions)
(benchmark--adaptive func repetitions)
(unless repetitions (setq repetitions 1))
(let ((gc gc-elapsed)
(gcs gcs-done)
(empty-func (lambda () 'empty-func)))
(list
(if (> repetitions 1)
(- (benchmark-elapse (dotimes (_ repetitions) (funcall func)))
(benchmark-elapse (dotimes (_ repetitions) (funcall empty-func))))
(- (benchmark-elapse (funcall func))
(benchmark-elapse (funcall empty-func))))
(- gcs-done gcs)
(- gc-elapsed gc)))))
(defun benchmark--adaptive (func time)
"Measure the run time of FUNC, calling it enough times to last TIME seconds.
Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'."
(named-let loop ((repetitions 1)
(data (let ((x (list 0))) (setcdr x x) x)))
;; (message "Running %d iteration" repetitions)
(let ((newdata (benchmark-call func repetitions)))
(if (<= (car newdata) 0)
;; This can happen if we're unlucky, e.g. the process got preempted
;; (or the GC ran) just during the empty-func loop.
;; Just try again, hopefully this won't repeat itself.
(progn
;; (message "Ignoring the %d iterations" repetitions)
(loop (* 2 repetitions) data))
(let* ((sum (cl-mapcar #'+ data (cons repetitions newdata)))
(totaltime (nth 1 sum)))
(if (>= totaltime time)
sum
(let* ((iter-time (/ totaltime (car sum)))
(missing-time (- time totaltime))
(missing-iter (/ missing-time iter-time)))
;; `iter-time' is approximate because of effects like the GC,
;; so multiply at most by 10, in case we are wildly off the mark.
(loop (max repetitions
(min (ceiling missing-iter)
(* 10 repetitions)))
sum))))))))
;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
"Time execution of FORMS.
@ -53,20 +110,7 @@ See also `benchmark-run-compiled'."
(unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
(setq forms (cons repetitions forms)
repetitions 1))
(let ((i (make-symbol "i"))
(gcs (make-symbol "gcs"))
(gc (make-symbol "gc")))
`(let ((,gc gc-elapsed)
(,gcs gcs-done))
(list ,(if (or (symbolp repetitions) (> repetitions 1))
;; Take account of the loop overhead.
`(- (benchmark-elapse (dotimes (,i ,repetitions)
,@forms))
(benchmark-elapse (dotimes (,i ,repetitions)
nil)))
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))
`(benchmark-call (lambda () ,@forms) ,repetitions))
;;;###autoload
(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@ -78,21 +122,7 @@ result. The overhead of the `lambda's is accounted for."
(unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
(setq forms (cons repetitions forms)
repetitions 1))
(let ((i (make-symbol "i"))
(gcs (make-symbol "gcs"))
(gc (make-symbol "gc"))
(code (byte-compile `(lambda () ,@forms)))
(lambda-code (byte-compile '(lambda ()))))
`(let ((,gc gc-elapsed)
(,gcs gcs-done))
(list ,(if (or (symbolp repetitions) (> repetitions 1))
;; Take account of the loop overhead.
`(- (benchmark-elapse (dotimes (,i ,repetitions)
(funcall ,code)))
(benchmark-elapse (dotimes (,i ,repetitions)
(funcall ,lambda-code))))
`(benchmark-elapse (funcall ,code)))
(- gcs-done ,gcs) (- gc-elapsed ,gc)))))
`(benchmark-call (byte-compile '(lambda () ,@forms)) ,repetitions))
;;;###autoload
(defun benchmark (repetitions form)
@ -100,9 +130,15 @@ result. The overhead of the `lambda's is accounted for."
Interactively, REPETITIONS is taken from the prefix arg, and
the command prompts for the form to benchmark.
For non-interactive use see also `benchmark-run' and
`benchmark-run-compiled'."
`benchmark-run-compiled'.
FORM can also be a function in which case we measure the time it takes
to call it without any argument."
(interactive "p\nxForm: ")
(let ((result (eval `(benchmark-run ,repetitions ,form) t)))
(let ((result (benchmark-call (eval (pcase form
((or `#',_ `(lambda . ,_)) form)
(_ `(lambda () ,form)))
t)
repetitions)))
(if (zerop (nth 1 result))
(message "Elapsed time: %fs" (car result))
(message "Elapsed time: %fs (%fs in %d GCs)" (car result)

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

@ -548,6 +548,10 @@ has the form (autoload . FILENAME).")
(defvar byte-compile-unresolved-functions nil
"Alist of undefined functions to which calls have been compiled.
Each element in the list has the form (FUNCTION POSITION . CALLS)
where CALLS is a list whose elements are integers (indicating the
number of arguments passed in the function call) or the constant `t'
if the function is called indirectly.
This variable is only significant whilst compiling an entire buffer.
Used for warnings when a function is not known to be defined or is later
defined with incorrect args.")
@ -1423,9 +1427,9 @@ when printing the error message."
;; Remember number of args in call.
(let ((cons (assq f byte-compile-unresolved-functions)))
(if cons
(or (memq nargs (cdr cons))
(push nargs (cdr cons)))
(push (list f nargs)
(or (memq nargs (cddr cons))
(push nargs (cddr cons)))
(push (list f byte-compile-last-position nargs)
byte-compile-unresolved-functions)))))
;; Warn if the form is calling a function with the wrong number of arguments.
@ -1525,14 +1529,14 @@ extra args."
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions))
(setq calls (delq t calls)) ;Ignore higher-order uses of the function.
(when (cdr calls)
(when (cddr calls)
(when (and (symbolp name)
(eq (function-get name 'byte-optimizer)
'byte-compile-inline-expand))
(byte-compile-warn "defsubst `%s' was used before it was defined"
name))
(setq sig (byte-compile-arglist-signature arglist)
nums (sort (copy-sequence (cdr calls)) (function <))
nums (sort (copy-sequence (cddr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
(when (or (< min (car sig))
@ -1640,56 +1644,21 @@ It is too wide if it has any lines longer than the largest of
kind name col))))
form)
(defun byte-compile-print-syms (str1 strn syms)
(when syms
(byte-compile-set-symbol-position (car syms) t))
(cond ((and (cdr syms) (not noninteractive))
(let* ((str strn)
(L (length str))
s)
(while syms
(setq s (symbol-name (pop syms))
L (+ L (length s) 2))
(if (< L (1- (buffer-local-value 'fill-column
(or (get-buffer
byte-compile-log-buffer)
(current-buffer)))))
(setq str (concat str " " s (and syms ",")))
(setq str (concat str "\n " s (and syms ","))
L (+ (length s) 4))))
(byte-compile-warn "%s" str)))
((cdr syms)
(byte-compile-warn "%s %s"
strn
(mapconcat #'symbol-name syms ", ")))
(syms
(byte-compile-warn str1 (car syms)))))
;; If we have compiled any calls to functions which are not known to be
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
(when (byte-compile-warning-enabled-p 'unresolved)
(let ((byte-compile-current-form :end)
(noruntime nil)
(unresolved nil))
(let ((byte-compile-current-form :end))
;; Separate the functions that will not be available at runtime
;; from the truly unresolved ones.
(dolist (f byte-compile-unresolved-functions)
(setq f (car f))
(when (not (memq f byte-compile-new-defuns))
(if (fboundp f) (push f noruntime) (push f unresolved))))
;; Complain about the no-run-time functions
(byte-compile-print-syms
"the function `%s' might not be defined at runtime."
"the following functions might not be defined at runtime:"
noruntime)
;; Complain about the unresolved functions
(byte-compile-print-syms
"the function `%s' is not known to be defined."
"the following functions are not known to be defined:"
unresolved)))
(dolist (urf byte-compile-unresolved-functions)
(let ((f (car urf)))
(when (not (memq f byte-compile-new-defuns))
(let ((byte-compile-last-position (cadr urf)))
(byte-compile-warn
(if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
(car urf))))))))
nil)
@ -4912,10 +4881,10 @@ binding slots have been popped."
(byte-compile-push-constant op)
(byte-compile-form fun)
(byte-compile-form prop)
(let* ((fun (eval fun))
(prop (eval prop))
(let* ((fun (eval fun t))
(prop (eval prop t))
(val (if (macroexp-const-p val)
(eval val)
(eval val t)
(byte-compile-lambda (cadr val)))))
(push `(,fun
. (,prop ,val ,@(alist-get fun overriding-plist-environment)))

64
lisp/emacs-lisp/chart.el
View file

@ -89,33 +89,39 @@ Useful if new Emacs is used on B&W display.")
(declare-function x-display-color-cells "xfns.c" (&optional terminal))
(defvar chart-face-list
(if (display-color-p)
(let ((cl chart-face-color-list)
(pl chart-face-pixmap-list)
(faces ())
nf)
(while cl
(setq nf (make-face
(intern (concat "chart-" (car cl) "-" (car pl)))))
(set-face-background nf (if (condition-case nil
(> (x-display-color-cells) 4)
(error t))
(car cl)
"white"))
(set-face-foreground nf "black")
(if (and chart-face-use-pixmaps pl)
(condition-case nil
(set-face-background-pixmap nf (car pl))
(error (message "Cannot set background pixmap %s" (car pl)))))
(push nf faces)
(setq cl (cdr cl)
pl (cdr pl)))
faces))
(defvar chart-face-list #'chart--face-list
"Faces used to colorize charts.
This should either be a list of faces, or a function that returns
a list of faces.
List is limited currently, which is ok since you really can't display
too much in text characters anyways.")
(defun chart--face-list ()
(and
(display-color-p)
(let ((cl chart-face-color-list)
(pl chart-face-pixmap-list)
(faces ())
nf)
(while cl
(setq nf (make-face
(intern (concat "chart-" (car cl) "-" (car pl)))))
(set-face-background nf (if (condition-case nil
(> (x-display-color-cells) 4)
(error t))
(car cl)
"white"))
(set-face-foreground nf "black")
(if (and chart-face-use-pixmaps pl)
(condition-case nil
(set-face-background-pixmap nf (car pl))
(error (message "Cannot set background pixmap %s" (car pl)))))
(push nf faces)
(setq cl (cdr cl)
pl (cdr pl)))
faces)))
(define-derived-mode chart-mode special-mode "Chart"
"Define a mode in Emacs for displaying a chart."
(buffer-disable-undo)
@ -374,7 +380,10 @@ of the drawing."
(let* ((data (oref c sequences))
(dir (oref c direction))
(odir (if (eq dir 'vertical) 'horizontal 'vertical))
)
(faces
(if (functionp chart-face-list)
(funcall chart-face-list)
chart-face-list)))
(while data
(if (stringp (car (oref (car data) data)))
;; skip string lists...
@ -390,10 +399,9 @@ of the drawing."
(zp (if (eq dir 'vertical)
(chart-translate-ypos c 0)
(chart-translate-xpos c 0)))
(fc (if chart-face-list
(nth (% i (length chart-face-list)) chart-face-list)
'default))
)
(fc (if faces
(nth (% i (length faces)) faces)
'default)))
(if (< dp zp)
(progn
(chart-draw-line dir (car rng) dp zp)

27
lisp/emacs-lisp/cl-macs.el
View file

@ -1976,7 +1976,8 @@ a `let' form, except that the list of symbols can be computed at run-time."
(,binds ()))
(while ,syms
(push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
(eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun))))))))
(eval (list 'let (nreverse ,binds)
(list 'funcall (list 'quote ,bodyfun))))))))
(defconst cl--labels-magic (make-symbol "cl--labels-magic"))
@ -2068,6 +2069,8 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; even handle mutually recursive functions.
(letrec
((done nil) ;; Non-nil if some TCO happened.
;; This var always holds the value `nil' until (just before) we
;; exit the loop.
(retvar (make-symbol "retval"))
(ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
(make-symbol (symbol-name s))))
@ -2100,6 +2103,12 @@ Like `cl-flet' but the definitions can refer to previous ones.
(`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
(`(if ,cond ,then . ,else)
`(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
(`(and . ,exps) `(and . ,(funcall opt-exps exps)))
(`(or ,arg) (funcall opt arg))
(`(or ,arg . ,args)
(let ((val (make-symbol "val")))
`(let ((,val ,arg))
(if ,val ,(funcall opt val) ,(funcall opt `(or . ,args))))))
(`(cond . ,conds)
(let ((cs '()))
(while conds
@ -2109,14 +2118,18 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; This returns the value of `exp' but it's
;; only in tail position if it's the
;; last condition.
;; Note: This may set the var before we
;; actually exit the loop, but luckily it's
;; only the case if we set the var to nil,
;; so it does preserve the invariant that
;; the var is nil until we exit the loop.
`((setq ,retvar ,exp) nil)
`(,(funcall opt exp)))
cs))
(exps
(push (funcall opt-exps exps) cs))))
(if (eq t (caar cs))
`(cond . ,(nreverse cs))
`(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
;; No need to set `retvar' to return nil.
`(cond . ,(nreverse cs))))
((and `(,(or 'let 'let*) ,bindings . ,exps)
(guard
;; Note: it's OK for this `let' to shadow any
@ -2128,8 +2141,8 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
(_
`(progn (setq ,retvar ,exp) nil))))))
('nil nil) ;No need to set `retvar' to return nil.
(_ `(progn (setq ,retvar ,exp) nil))))))
(let ((optimized-body (funcall opt-exps body)))
(if (not done)
@ -2275,7 +2288,7 @@ of `cl-symbol-macrolet' to additionally expand symbol macros."
;; on this behavior (haven't found any yet).
;; Such code should explicitly use `cl-letf' instead, I think.
;;
;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare))
;; (let ((letf nil) (found nil) (nbs ()))
;; (dolist (binding bindings)
;; (let* ((var (if (symbolp binding) binding (car binding)))

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

@ -1,6 +1,6 @@
;;; generator.el --- generators -*- lexical-binding: t -*-
;;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Daniel Colascione <dancol@dancol.org>
;; Keywords: extensions, elisp

2
lisp/emacs-lisp/memory-report.el
View file

@ -295,7 +295,7 @@ by counted more than once."
(- (position-bytes (point-min)))
(gap-size)))
(seq-reduce #'+ (mapcar (lambda (elem)
(if (cdr elem)
(if (and (consp elem) (cdr elem))
(memory-report--object-size
(make-hash-table :test #'eq)
(cdr elem))

16
lisp/emacs-lisp/package.el
View file

@ -2206,10 +2206,13 @@ directory."
(package-install-from-buffer)))
;;;###autoload
(defun package-install-selected-packages ()
(defun package-install-selected-packages (&optional noconfirm)
"Ensure packages in `package-selected-packages' are installed.
If some packages are not installed propose to install them."
If some packages are not installed, propose to install them.
If optional argument NOCONFIRM is non-nil, don't ask for
confirmation to install packages."
(interactive)
(package--archives-initialize)
;; We don't need to populate `package-selected-packages' before
;; using here, because the outcome is the same either way (nothing
;; gets installed).
@ -2220,10 +2223,11 @@ If some packages are not installed propose to install them."
(difference (- (length not-installed) (length available))))
(cond
(available
(when (y-or-n-p
(format "Packages to install: %d (%s), proceed? "
(length available)
(mapconcat #'symbol-name available " ")))
(when (or noconfirm
(y-or-n-p
(format "Packages to install: %d (%s), proceed? "
(length available)
(mapconcat #'symbol-name available " "))))
(mapc (lambda (p) (package-install p 'dont-select)) available)))
((> difference 0)
(message "Packages that are not available: %d (the rest is already installed), maybe you need to `M-x package-refresh-contents'"

147
lisp/emacs-lisp/pcase.el
View file

@ -207,6 +207,7 @@ If EXP fails to match any of the patterns in CASES, an error is signaled."
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
;; FILE is available from `macroexp-file-name'.
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
;;;###autoload
@ -320,34 +321,46 @@ of the elements of LIST is performed as if by `pcase-let'.
(defun pcase--trivial-upat-p (upat)
(and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
(defun pcase--expand (exp cases)
;; (message "pid=%S (pcase--expand %S ...hash=%S)"
;; (emacs-pid) exp (sxhash cases))
(defun pcase-compile-patterns (exp cases)
"Compile the set of patterns in CASES.
EXP is the expression that will be matched against the patterns.
CASES is a list of elements (PAT . CODEGEN)
where CODEGEN is a function that returns the code to use when
PAT matches. That code has to be in the form of a cons cell.
CODEGEN will be called with at least 2 arguments, VARVALS and COUNT.
VARVALS is a list of elements of the form (VAR VAL . RESERVED) where VAR
is a variable bound by the pattern and VAL is a duplicable expression
that returns the value this variable should be bound to.
If the pattern PAT uses `or', CODEGEN may be called multiple times,
in which case it may want to generate the code differently to avoid
a potential code explosion. For this reason the COUNT argument indicates
how many time this CODEGEN is called."
(macroexp-let2 macroexp-copyable-p val exp
(let* ((defs ())
(seen '())
(let* ((seen '())
(phcounter 0)
(main
(pcase--u
(mapcar
(lambda (case)
`(,(pcase--match val (pcase--macroexpand (car case)))
,(lambda (vars)
(let ((prev (assq case seen))
(code (cdr case)))
(let ((prev (assq case seen)))
(unless prev
;; Keep track of the cases that are used.
(push (setq prev (list case)) seen))
(if (member code '(nil (nil))) nil
;; Put `code' in the cdr just so that not all
;; branches look identical (to avoid things like
;; `macroexp--if' optimizing them too optimistically).
(let ((ph (list 'pcase--placeholder code)))
(setcdr prev (cons (cons vars ph) (cdr prev)))
ph))))))
;; Put a counter in the cdr just so that not
;; all branches look identical (to avoid things
;; like `macroexp--if' optimizing them too
;; optimistically).
(let ((ph (cons 'pcase--placeholder
(setq phcounter (1+ phcounter)))))
(setcdr prev (cons (cons vars ph) (cdr prev)))
ph)))))
cases))))
;; Take care of the place holders now.
(dolist (branch seen)
(let ((code (cdar branch))
(let ((codegen (cdar branch))
(uses (cdr branch)))
;; Find all the vars that are in scope (the union of the
;; vars provided in each use case).
@ -358,48 +371,74 @@ of the elements of LIST is performed as if by `pcase-let'.
(if vi
(if (cddr v) (setcdr vi 'used))
(push (cons (car v) (cddr v)) allvarinfo))))))
(allvars (mapcar #'car allvarinfo))
(ignores (mapcar (lambda (vi) (when (cdr vi) `(ignore ,(car vi))))
allvarinfo)))
;; Since we use a tree-based pattern matching
;; technique, the leaves (the places that contain the
;; code to run once a pattern is matched) can get
;; copied a very large number of times, so to avoid
;; code explosion, we need to keep track of how many
;; times we've used each leaf and move it
;; to a separate function if that number is too high.
(if (or (null (cdr uses)) (pcase--small-branch-p code))
(dolist (use uses)
(let ((vars (car use))
(placeholder (cdr use)))
;; (cl-assert (eq (car placeholder) 'pcase--placeholder))
(setcar placeholder 'let)
(setcdr placeholder
`(,(mapcar (lambda (v) (list v (cadr (assq v vars))))
allvars)
;; Try and silence some of the most common
;; spurious "unused var" warnings.
,@ignores
,@code))))
;; Several occurrence of this non-small branch in the output.
(let ((bsym
(make-symbol (format "pcase-%d" (length defs)))))
(push `(,bsym (lambda ,allvars ,@ignores ,@code)) defs)
(dolist (use uses)
(let ((vars (car use))
(placeholder (cdr use)))
;; (cl-assert (eq (car placeholder) 'pcase--placeholder))
(setcar placeholder 'funcall)
(setcdr placeholder
`(,bsym
,@(mapcar (lambda (v) (cadr (assq v vars)))
allvars))))))))))
(allvars (mapcar #'car allvarinfo)))
(dolist (use uses)
(let* ((vars (car use))
(varvals
(mapcar (lambda (v)
`(,v ,(cadr (assq v vars))
,(cdr (assq v allvarinfo))))
allvars))
(placeholder (cdr use))
(code (funcall codegen varvals (length uses))))
;; (cl-assert (eq (car placeholder) 'pcase--placeholder))
(setcar placeholder (car code))
(setcdr placeholder (cdr code)))))))
(dolist (case cases)
(unless (or (assq case seen)
(memq (car case) pcase--dontwarn-upats))
(message "pcase pattern %S shadowed by previous pcase pattern"
(car case))))
(macroexp-let* defs main))))
(setq main
(macroexp-warn-and-return
(format "pcase pattern %S shadowed by previous pcase pattern"
(car case))
main))))
main)))
(defun pcase--expand (exp cases)
;; (message "pid=%S (pcase--expand %S ...hash=%S)"
;; (emacs-pid) exp (sxhash cases))
(let* ((defs ())
(codegen
(lambda (code)
(if (member code '(nil (nil) ('nil)))
(lambda (&rest _) ''nil)
(let ((bsym ()))
(lambda (varvals count &rest _)
(let* ((ignored-vars
(delq nil (mapcar (lambda (vv) (if (nth 2 vv) (car vv)))
varvals)))
(ignores (if ignored-vars
`((ignore . ,ignored-vars)))))
;; Since we use a tree-based pattern matching
;; technique, the leaves (the places that contain the
;; code to run once a pattern is matched) can get
;; copied a very large number of times, so to avoid
;; code explosion, we need to keep track of how many
;; times we've used each leaf and move it
;; to a separate function if that number is too high.
(if (or (< count 2) (pcase--small-branch-p code))
`(let ,(mapcar (lambda (vv) (list (car vv) (cadr vv)))
varvals)
;; Try and silence some of the most common
;; spurious "unused var" warnings.
,@ignores
,@code)
;; Several occurrence of this non-small branch in
;; the output.
(unless bsym
(setq bsym (make-symbol
(format "pcase-%d" (length defs))))
(push `(,bsym (lambda ,(mapcar #'car varvals)
,@ignores ,@code))
defs))
`(funcall ,bsym ,@(mapcar #'cadr varvals)))))))))
(main
(pcase-compile-patterns
exp
(mapcar (lambda (case)
(cons (car case) (funcall codegen (cdr case))))
cases))))
(macroexp-let* defs main)))
(defun pcase--macroexpand (pat)
"Expands all macro-patterns in PAT."

54
lisp/erc/erc-autoaway.el
View file

@ -1,4 +1,4 @@
;;; erc-autoaway.el --- Provides autoaway for ERC
;;; erc-autoaway.el --- Provides autoaway for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
@ -58,7 +58,7 @@ function each time you change `erc-autoaway-idle-seconds'."
(setq erc-autoaway-idletimer
(run-with-idle-timer erc-autoaway-idle-seconds
t
'erc-autoaway-set-away
#'erc-autoaway-set-away
erc-autoaway-idle-seconds)))
(defun erc-autoaway-some-server-buffer ()
@ -66,21 +66,21 @@ function each time you change `erc-autoaway-idle-seconds'."
If none is found, return nil."
(car (erc-buffer-list #'erc-open-server-buffer-p)))
(defun erc-autoaway-insinuate-maybe (&optional server &rest ignored)
(defun erc-autoaway-insinuate-maybe (&optional server &rest _ignored)
"Add autoaway reset function to `post-command-hook' if at least one
ERC process is alive.
This is used when `erc-autoaway-idle-method' is `user'."
(when (or server (erc-autoaway-some-server-buffer))
(add-hook 'post-command-hook 'erc-autoaway-reset-idle-user)))
(add-hook 'post-command-hook #'erc-autoaway-reset-idle-user)))
(defun erc-autoaway-remove-maybe (&rest ignored)
(defun erc-autoaway-remove-maybe (&rest _ignored)
"Remove the autoaway reset function from `post-command-hook' if
no ERC process is alive.
This is used when `erc-autoaway-idle-method' is `user'."
(unless (erc-autoaway-some-server-buffer)
(remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user)))
(remove-hook 'post-command-hook #'erc-autoaway-reset-idle-user)))
;;;###autoload(autoload 'erc-autoaway-mode "erc-autoaway")
(define-erc-module autoaway nil
@ -107,36 +107,36 @@ set you no longer away.
Related variables: `erc-public-away-p' and `erc-away-nickname'."
;; Enable:
((when (boundp 'erc-autoaway-idle-method)
(add-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators)
(add-hook 'erc-connect-pre-hook #'erc-autoaway-reset-indicators)
(setq erc-autoaway-last-sent-time (erc-current-time))
(cond
((eq erc-autoaway-idle-method 'irc)
(add-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc)
(add-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc))
(add-hook 'erc-send-completed-hook #'erc-autoaway-reset-idle-irc)
(add-hook 'erc-server-001-functions #'erc-autoaway-reset-idle-irc))
((eq erc-autoaway-idle-method 'user)
(add-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
(add-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe)
(add-hook 'erc-after-connect #'erc-autoaway-insinuate-maybe)
(add-hook 'erc-disconnected-hook #'erc-autoaway-remove-maybe)
(erc-autoaway-insinuate-maybe))
((eq erc-autoaway-idle-method 'emacs)
(erc-autoaway-reestablish-idletimer)))
(add-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
(add-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators)))
(add-hook 'erc-timer-hook #'erc-autoaway-possibly-set-away)
(add-hook 'erc-server-305-functions #'erc-autoaway-reset-indicators)))
;; Disable:
((when (boundp 'erc-autoaway-idle-method)
(remove-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators)
(remove-hook 'erc-connect-pre-hook #'erc-autoaway-reset-indicators)
(cond
((eq erc-autoaway-idle-method 'irc)
(remove-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc)
(remove-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc))
(remove-hook 'erc-send-completed-hook #'erc-autoaway-reset-idle-irc)
(remove-hook 'erc-server-001-functions #'erc-autoaway-reset-idle-irc))
((eq erc-autoaway-idle-method 'user)
(remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user)
(remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
(remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe))
(remove-hook 'post-command-hook #'erc-autoaway-reset-idle-user)
(remove-hook 'erc-after-connect #'erc-autoaway-insinuate-maybe)
(remove-hook 'erc-disconnected-hook #'erc-autoaway-remove-maybe))
((eq erc-autoaway-idle-method 'emacs)
(cancel-timer erc-autoaway-idletimer)
(setq erc-autoaway-idletimer nil)))
(remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
(remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))))
(remove-hook 'erc-timer-hook #'erc-autoaway-possibly-set-away)
(remove-hook 'erc-server-305-functions #'erc-autoaway-reset-indicators))))
(defcustom erc-autoaway-idle-method 'user
"The method used to determine how long you have been idle.
@ -148,7 +148,6 @@ The time itself is specified by `erc-autoaway-idle-seconds'.
See `erc-autoaway-mode' for more information on the various
definitions of being idle."
:group 'erc-autoaway
:type '(choice (const :tag "User idle time" user)
(const :tag "Emacs idle time" emacs)
(const :tag "Last IRC action" irc))
@ -166,7 +165,6 @@ ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set away when you idle. See `erc-auto-discard-away' for
the other half."
:group 'erc-autoaway
:type 'boolean)
(defcustom erc-auto-discard-away t
@ -176,20 +174,17 @@ longer away when you type something. This variable controls whether
you will be set no longer away when you type something. See
`erc-auto-set-away' for the other half.
See also `erc-autoaway-no-auto-discard-regexp'."
:group 'erc-autoaway
:type 'boolean)
(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$"
"Input that matches this will not automatically discard away status.
See `erc-auto-discard-away'."
:group 'erc-autoaway
:type 'regexp)
(defcustom erc-autoaway-idle-seconds 1800
"Number of seconds after which ERC will set you automatically away.
If you are changing this variable using lisp instead of customizing it,
you have to run `erc-autoaway-reestablish-idletimer' afterwards."
:group 'erc-autoaway
:set (lambda (sym val)
(set-default sym val)
(when (eq erc-autoaway-idle-method 'emacs)
@ -201,10 +196,9 @@ you have to run `erc-autoaway-reestablish-idletimer' afterwards."
"Message ERC will use when setting you automatically away.
It is used as a `format' string with the argument of the idletime
in seconds."
:group 'erc-autoaway
:type 'string)
(defun erc-autoaway-reset-idle-user (&rest stuff)
(defun erc-autoaway-reset-idle-user (&rest _stuff)
"Reset the stored user idle time.
This is one global variable since a user talking on one net can
talk on another net too."
@ -212,7 +206,7 @@ talk on another net too."
(erc-autoaway-set-back #'erc-autoaway-remove-maybe))
(setq erc-autoaway-last-sent-time (erc-current-time)))
(defun erc-autoaway-reset-idle-irc (line &rest stuff)
(defun erc-autoaway-reset-idle-irc (line &rest _stuff)
"Reset the stored IRC idle time.
This is one global variable since a user talking on one net can
talk on another net too."
@ -272,7 +266,7 @@ active server buffer available."
(setq erc-autoaway-caused-away t)
(erc-cmd-GAWAY (format-message erc-autoaway-message idle-time))))
(defun erc-autoaway-reset-indicators (&rest stuff)
(defun erc-autoaway-reset-indicators (&rest _stuff)
"Reset indicators used by the erc-autoaway module."
(setq erc-autoaway-last-sent-time (erc-current-time))
(setq erc-autoaway-caused-away nil))

37
lisp/erc/erc-backend.el
View file

@ -268,7 +268,6 @@ protection algorithm.")
"Non-nil means that ERC will attempt to reestablish broken connections.
Reconnection will happen automatically for any unexpected disconnection."
:group 'erc-server
:type 'boolean)
(defcustom erc-server-reconnect-attempts 2
@ -276,7 +275,6 @@ Reconnection will happen automatically for any unexpected disconnection."
broken connection, or t to always attempt to reconnect.
This only has an effect if `erc-server-auto-reconnect' is non-nil."
:group 'erc-server
:type '(choice (const :tag "Always reconnect" t)
integer))
@ -285,7 +283,6 @@ This only has an effect if `erc-server-auto-reconnect' is non-nil."
successive reconnect attempts.
If a key is pressed while ERC is waiting, it will stop waiting."
:group 'erc-server
:type 'number)
(defcustom erc-split-line-length 440
@ -299,14 +296,12 @@ And a typical message looks like this:
You can limit here the maximum length of the \"Hello!\" part.
Good luck."
:type 'integer
:group 'erc-server)
:type 'integer)
(defcustom erc-coding-system-precedence '(utf-8 undecided)
"List of coding systems to be preferred when receiving a string from the server.
This will only be consulted if the coding system in
`erc-server-coding-system' is `undecided'."
:group 'erc-server
:version "24.1"
:type '(repeat coding-system))
@ -331,7 +326,6 @@ If you need to send non-ASCII text to people not using a client that
does decoding on its own, you must tell ERC what encoding to use.
Emacs cannot guess it, since it does not know what the people on the
other end of the line are using."
:group 'erc-server
:type '(choice (const :tag "None" nil)
coding-system
(cons (coding-system :tag "encoding" :value utf-8)
@ -346,37 +340,32 @@ current target as returned by `erc-default-target'.
Example: If you know that the channel #linux-ru uses the coding-system
`cyrillic-koi8', then add (\"#linux-ru\" . cyrillic-koi8) to the
alist."
:group 'erc-server
:type '(repeat (cons (regexp :tag "Target")
coding-system)))
(defcustom erc-server-connect-function #'erc-open-network-stream
"Function used to initiate a connection.
It should take same arguments as `open-network-stream' does."
:group 'erc-server
:type 'function)
(defcustom erc-server-prevent-duplicates '("301")
"Either nil or a list of strings.
Each string is a IRC message type, like PRIVMSG or NOTICE.
All Message types in that list of subjected to duplicate prevention."
:type '(choice (const nil) (list string))
:group 'erc-server)
:type '(choice (const nil) (list string)))
(defcustom erc-server-duplicate-timeout 60
"The time allowed in seconds between duplicate messages.
If two identical messages arrive within this value of one another, the second
isn't displayed."
:type 'integer
:group 'erc-server)
:type 'integer)
(defcustom erc-server-timestamp-format "%Y-%m-%d %T"
"Timestamp format used with server response messages.
This string is processed using `format-time-string'."
:version "24.3"
:type 'string
:group 'erc-server)
:type 'string)
;;; Flood-related
@ -395,22 +384,19 @@ detailed in RFC 2813, section 5.8 \"Flood control of clients\".
time, send a message, and increase
`erc-server-flood-last-message' by
`erc-server-flood-penalty' for each message."
:type 'integer
:group 'erc-server)
:type 'integer)
(defcustom erc-server-flood-penalty 3
"How much we penalize a message.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm."
:type 'integer
:group 'erc-server)
:type 'integer)
;; Ping handling
(defcustom erc-server-send-ping-interval 30
"Interval of sending pings to the server, in seconds.
If this is set to nil, pinging the server is disabled."
:group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
@ -422,7 +408,6 @@ This must be greater than or equal to the value for
`erc-server-send-ping-interval'.
If this is set to nil, never try to reconnect."
:group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
@ -1082,9 +1067,6 @@ Finds hooks by looking in the `erc-server-responses' hash table."
(cl-defmacro define-erc-response-handler ((name &rest aliases)
&optional extra-fn-doc extra-var-doc
&rest fn-body)
(declare (debug (&define [&name "erc-response-handler@"
(symbolp &rest symbolp)]
&optional sexp sexp def-body)))
"Define an ERC handler hook/function pair.
NAME is the response name as sent by the server (see the IRC RFC for
meanings).
@ -1164,6 +1146,9 @@ Would expand to:
See also `erc-server-311'.\"))
\(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
(declare (debug (&define [&name "erc-response-handler@"
(symbolp &rest symbolp)]
&optional sexp sexp def-body)))
(if (numberp name) (setq name (intern (format "%03i" name))))
(setq aliases (mapcar (lambda (a)
(if (numberp a)
@ -1226,8 +1211,8 @@ add things to `%s' instead."
,@(cl-loop for fn in fn-alternates
for var in var-alternates
for a in aliases
nconc (list `(defalias ',fn ',fn-name)
`(defvar ,var ',fn-name ,(format hook-doc a))
nconc (list `(defalias ',fn #',fn-name)
`(defvar ,var #',fn-name ,(format hook-doc a))
`(put ',var 'definition-name ',hook-name))))))
(define-erc-response-handler (ERROR)

52
lisp/erc/erc-button.el
View file

@ -52,14 +52,14 @@
;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append)
(add-hook 'erc-complete-functions 'erc-button-next-function)
(add-hook 'erc-mode-hook 'erc-button-setup))
((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons)
(remove-hook 'erc-send-modify-hook 'erc-button-add-buttons)
(remove-hook 'erc-complete-functions 'erc-button-next-function)
(remove-hook 'erc-mode-hook 'erc-button-setup)))
((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
(add-hook 'erc-complete-functions #'erc-button-next-function)
(add-hook 'erc-mode-hook #'erc-button-setup))
((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons)
(remove-hook 'erc-send-modify-hook #'erc-button-add-buttons)
(remove-hook 'erc-complete-functions #'erc-button-next-function)
(remove-hook 'erc-mode-hook #'erc-button-setup)))
;;; Variables
@ -91,7 +91,6 @@ above them."
(defcustom erc-button-url-regexp browse-url-button-regexp
"Regular expression that matches URLs."
:version "27.1"
:group 'erc-button
:type 'regexp)
(defcustom erc-button-wrap-long-urls nil
@ -100,28 +99,25 @@ above them."
If this variable is a number, consider URLs longer than its value to
be \"long\". If t, URLs will be considered \"long\" if they are
longer than `erc-fill-column'."
:group 'erc-button
:type '(choice integer boolean))
(defcustom erc-button-buttonize-nicks t
"Flag indicating whether nicks should be buttonized or not."
:group 'erc-button
:type 'boolean)
(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
"URL used to browse rfc references.
(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s"
"URL used to browse RFC references.
%s is replaced by the number."
:group 'erc-button
:type 'string)
:type 'string
:version "28.1")
(define-obsolete-variable-alias 'erc-button-google-url
'erc-button-search-url "27.1")
(defcustom erc-button-search-url "http://duckduckgo.com/?q=%s"
(defcustom erc-button-search-url "https://duckduckgo.com/?q=%s"
"URL used to search for a term.
%s is replaced by the search string."
:version "27.1"
:group 'erc-button
:version "28.1"
:type 'string)
(defcustom erc-button-alist
@ -179,7 +175,6 @@ PAR is a number of a regexp grouping whose text will be passed to
CALLBACK. There can be several PAR arguments. If REGEXP is
\\='nicknames, these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
:group 'erc-button
:version "24.1" ; remove finger (bug#4443)
:type '(repeat
(list :tag "Button"
@ -200,20 +195,18 @@ PAR is a number of a regexp grouping whose text will be passed to
(defcustom erc-emacswiki-url "https://www.emacswiki.org/cgi-bin/wiki.pl?"
"URL of the EmacsWiki Homepage."
:group 'erc-button
:type 'string)
(defcustom erc-emacswiki-lisp-url "https://www.emacswiki.org/elisp/"
"URL of the EmacsWiki ELisp area."
:group 'erc-button
:type 'string)
(defvar erc-button-keymap
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'erc-button-press-button)
(define-key map (kbd "<mouse-2>") 'erc-button-click-button)
(define-key map (kbd "TAB") 'erc-button-next)
(define-key map (kbd "<backtab>") 'erc-button-previous)
(define-key map (kbd "RET") #'erc-button-press-button)
(define-key map (kbd "<mouse-2>") #'erc-button-click-button)
(define-key map (kbd "TAB") #'erc-button-next)
(define-key map (kbd "<backtab>") #'erc-button-previous)
(define-key map [follow-link] 'mouse-face)
(set-keymap-parent map erc-mode-map)
map)
@ -244,7 +237,7 @@ global-level ERC button keys yet.")
"Add ERC mode-level button movement keys. This is only done once."
;; Add keys.
(unless erc-button-keys-added
(define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous)
(define-key erc-mode-map (kbd "<backtab>") #'erc-button-previous)
(setq erc-button-keys-added t)))
(defun erc-button-add-buttons ()
@ -287,7 +280,7 @@ specified by `erc-button-alist'."
(fun (nth 3 entry))
bounds word)
(when (or (eq t form)
(eval form))
(eval form t))
(goto-char (point-min))
(while (erc-forward-word)
(when (setq bounds (erc-bounds-of-word-at-point))
@ -306,9 +299,9 @@ specified by `erc-button-alist'."
(end (match-end (nth 1 entry)))
(form (nth 2 entry))
(fun (nth 3 entry))
(data (mapcar 'match-string (nthcdr 4 entry))))
(data (mapcar #'match-string (nthcdr 4 entry))))
(when (or (eq t form)
(eval form))
(eval form t))
(erc-button-add-button start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
@ -483,7 +476,6 @@ Examples:
(format
\"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
nick)))"
:group 'erc-button
:type '(repeat (cons (string :tag "Op")
sexp)))

36
lisp/erc/erc-capab.el
View file

@ -1,4 +1,4 @@
;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@ -40,8 +40,8 @@
;; disable this module, it will continue removing message flags, but the
;; unidentified nickname prefix will not be added to messages.
;; Visit <http://freenode.net/faq.shtml#spoofing> and
;; <http://freenode.net/faq.shtml#registering> to find further
;; Visit <https://freenode.net/kb/answer/cloaks> and
;; <https://freenode.net/kb/answer/registration> to find further
;; explanations of this capability.
;; From freenode.net's web site (not there anymore) on how to mark
@ -80,12 +80,10 @@
If you change this from the default \"*\", be sure to use a
character not found in IRC nicknames to avoid confusion."
:group 'erc-capab
:type '(choice string (const nil)))
(defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face'
"Face to use for `erc-capab-identify-prefix'."
:group 'erc-capab
:group 'erc-faces)
;;; Define module:
@ -94,22 +92,22 @@ character not found in IRC nicknames to avoid confusion."
(define-erc-module capab-identify nil
"Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
;; append so that `erc-server-parameters' is already set by `erc-server-005'
((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
(add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
((add-hook 'erc-server-005-functions #'erc-capab-identify-setup t)
(add-hook 'erc-server-290-functions #'erc-capab-identify-activate)
(add-hook 'erc-server-PRIVMSG-functions
'erc-capab-identify-remove/set-identified-flag)
#'erc-capab-identify-remove/set-identified-flag)
(add-hook 'erc-server-NOTICE-functions
'erc-capab-identify-remove/set-identified-flag)
(add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
#'erc-capab-identify-remove/set-identified-flag)
(add-hook 'erc-insert-modify-hook #'erc-capab-identify-add-prefix t)
(mapc (lambda (buffer)
(when buffer
(with-current-buffer buffer (erc-capab-identify-setup))))
(erc-buffer-list 'erc-open-server-buffer-p)))
((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
(remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
(erc-buffer-list #'erc-open-server-buffer-p)))
((remove-hook 'erc-server-005-functions #'erc-capab-identify-setup)
(remove-hook 'erc-server-290-functions #'erc-capab-identify-activate)
;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
;; because there doesn't seem to be a way to tell the server to turn it off
(remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))
(remove-hook 'erc-insert-modify-hook #'erc-capab-identify-add-prefix)))
;;; Variables:
@ -121,7 +119,7 @@ character not found in IRC nicknames to avoid confusion."
;;; Functions:
(defun erc-capab-identify-setup (&optional proc parsed)
(defun erc-capab-identify-setup (&optional _proc _parsed)
"Set up CAPAB IDENTIFY on the current server.
Optional argument PROC is the current server's process.
@ -146,19 +144,19 @@ These arguments are sent to this function when called as a hook in
(setq erc-capab-identify-sent t)))
(defun erc-capab-identify-activate (proc parsed)
(defun erc-capab-identify-activate (_proc parsed)
"Set `erc-capab-identify-activated' and display an activation message.
PROC is the current server's process.
PARSED is an `erc-parsed' response struct."
(when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
(string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
(when (member (erc-response.contents parsed)
'("IDENTIFY-MSG" "IDENTIFY-CTCP"))
(setq erc-capab-identify-activated t)
(erc-display-message
parsed 'notice 'active (format "%s activated"
(erc-response.contents parsed)))))
(defun erc-capab-identify-remove/set-identified-flag (proc parsed)
(defun erc-capab-identify-remove/set-identified-flag (_proc parsed)
"Remove PARSED message's id flag and add the `erc-identified' text property.
PROC is the current server's process.

74
lisp/erc/erc-dcc.el
View file

@ -1,4 +1,4 @@
;;; erc-dcc.el --- CTCP DCC module for ERC
;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2021 Free Software
;; Foundation, Inc.
@ -55,12 +55,6 @@
;; Require at run-time too to silence compiler.
(require 'pcomplete)
;;;###autoload(autoload 'erc-dcc-mode "erc-dcc")
(define-erc-module dcc nil
"Provide Direct Client-to-Client support for ERC."
((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))
((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)))
(defgroup erc-dcc nil
"DCC stands for Direct Client Communication, where you and your
friend's client programs connect directly to each other,
@ -71,9 +65,14 @@ Using DCC get and send, you can transfer files directly from and to other
IRC users."
:group 'erc)
;;;###autoload(autoload 'erc-dcc-mode "erc-dcc")
(define-erc-module dcc nil
"Provide Direct Client-to-Client support for ERC."
((add-hook 'erc-server-401-functions #'erc-dcc-no-such-nick))
((remove-hook 'erc-server-401-functions #'erc-dcc-no-such-nick)))
(defcustom erc-dcc-verbose nil
"If non-nil, be verbose about DCC activity reporting."
:group 'erc-dcc
:type 'boolean)
(defconst erc-dcc-connection-types
@ -120,7 +119,8 @@ All values of the list must be uppercase strings.")
;; more: the entry data from erc-dcc-list for this particular process.
(defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
(defun erc-dcc-open-network-stream (procname buffer addr port entry)
(defun erc-dcc-open-network-stream (procname buffer addr port _entry)
;; FIXME: Time to try activating this again!?
(if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes
;; cvs emacs
(open-network-stream-nowait procname buffer addr port)
@ -286,7 +286,6 @@ The result is also a string."
"IP address to listen on when offering files.
Should be set to a string or nil. If nil, automatic detection of
the host interface to use will be attempted."
:group 'erc-dcc
:type (list 'choice (list 'const :tag "Auto-detect" nil)
(list 'string :tag "IP-address"
:valid-regexp erc-dcc-ipv4-regexp)))
@ -295,7 +294,6 @@ the host interface to use will be attempted."
"IP address to use for outgoing DCC offers.
Should be set to a string or nil. If nil, use the value of
`erc-dcc-listen-host'."
:group 'erc-dcc
:type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil)
(list 'string :tag "IP-address"
:valid-regexp erc-dcc-ipv4-regexp)))
@ -306,7 +304,6 @@ Should be set to a string or nil. If nil, use the value of
You might want to set `erc-dcc-auto-masks' for this.
`auto' - Automatically accept the request and begin downloading the file
`ignore' - Ignore incoming DCC Send requests completely."
:group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
(defun erc-dcc-get-host (proc)
@ -323,7 +320,6 @@ If variable `erc-dcc-host' is non-nil, use it. Otherwise call
(defcustom erc-dcc-port-range nil
"If nil, any available user port is used for outgoing DCC connections.
If set to a cons, it specifies a range of ports to use in the form (min . max)"
:group 'erc-dcc
:type '(choice
(const :tag "Any port" nil)
(cons :tag "Port range"
@ -335,7 +331,6 @@ If set to a cons, it specifies a range of ports to use in the form (min . max)"
accepted automatically. A user identifier has the form \"nick!login@host\".
For instance, to accept all incoming DCC send offers automatically, add the
string \".*!.*@.*\" to this list."
:group 'erc-dcc
:type '(repeat regexp))
(defun erc-dcc-server (name filter sentinel)
@ -391,7 +386,6 @@ the accepted connection."
(defcustom erc-dcc-get-default-directory nil
"Default directory for incoming DCC file transfers.
If this is nil, then the current value of `default-directory' is used."
:group 'erc-dcc
:type '(choice (const nil :tag "Default directory") directory))
;;;###autoload
@ -468,7 +462,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
'dcc-chat-offer ?n nick)
t))))
(defun erc-dcc-do-CLOSE-command (proc &optional type nick)
(defun erc-dcc-do-CLOSE-command (_proc &optional type nick)
"Close a connection. Usage: /dcc close type nick.
At least one of TYPE and NICK must be provided."
;; disambiguate type and nick if only one is provided
@ -540,7 +534,7 @@ PROC is the server process."
(defvar-local erc-dcc-byte-count nil)
(defun erc-dcc-do-LIST-command (proc)
(defun erc-dcc-do-LIST-command (_proc)
"This is the handler for the /dcc list command.
It lists the current state of `erc-dcc-list' in an easy to read manner."
(let ((alist erc-dcc-list)
@ -703,7 +697,6 @@ the matching regexp, or nil if none found."
`ask' - Report the Chat request, and wait for the user to manually accept it
`auto' - Automatically accept the request and open a new chat window
`ignore' - Ignore incoming DCC chat requests completely."
:group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
(defun erc-dcc-handle-ctcp-chat (proc query nick login host to)
@ -757,13 +750,11 @@ the matching regexp, or nil if none found."
(defcustom erc-dcc-block-size 1024
"Block size to use for DCC SEND sessions."
:group 'erc-dcc
:type 'integer)
(defcustom erc-dcc-pump-bytes nil
"If set to an integer, keep sending until that number of bytes are
unconfirmed."
:group 'erc-dcc
:type '(choice (const nil) integer))
(define-inline erc-dcc-get-parent (proc)
@ -837,7 +828,6 @@ bytes sent."
'(erc-dcc-display-send erc-dcc-send-block)
"Hook run whenever the remote end of a DCC SEND offer connected to your
listening port."
:group 'erc-dcc
:type 'hook)
(defun erc-dcc-nick (plist)
@ -900,7 +890,6 @@ other client."
(defcustom erc-dcc-receive-cache (* 1024 512)
"Number of bytes to let the receive buffer grow before flushing it."
:group 'erc-dcc
:type 'integer)
(defvar-local erc-dcc-file-name nil)
@ -942,12 +931,12 @@ and making the connection."
(set-process-coding-system proc 'binary 'binary)
(set-buffer-file-coding-system 'binary t)
(set-process-filter proc 'erc-dcc-get-filter)
(set-process-sentinel proc 'erc-dcc-get-sentinel)
(set-process-filter proc #'erc-dcc-get-filter)
(set-process-sentinel proc #'erc-dcc-get-sentinel)
(setq entry (plist-put entry :start-time (erc-current-time)))
(setq entry (plist-put entry :peer proc)))))
(defun erc-dcc-append-contents (buffer file)
(defun erc-dcc-append-contents (buffer _file)
"Append the contents of BUFFER to FILE.
The contents of the BUFFER will then be erased."
(with-current-buffer buffer
@ -1000,7 +989,7 @@ rather than every 1024 byte block, but nobody seems to care."
proc (erc-pack-int received-bytes)))))))
(defun erc-dcc-get-sentinel (proc event)
(defun erc-dcc-get-sentinel (proc _event)
"This is the process sentinel for CTCP DCC SEND connections.
It shuts down the connection and notifies the user that the
transfer is complete."
@ -1025,25 +1014,21 @@ transfer is complete."
(defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
"Format to use for DCC Chat buffer names."
:group 'erc-dcc
:type 'string)
(defcustom erc-dcc-chat-mode-hook nil
"Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
:group 'erc-dcc
:type 'hook)
(defcustom erc-dcc-chat-connect-hook nil
""
:group 'erc-dcc
:type 'hook)
(defcustom erc-dcc-chat-exit-hook nil
""
:group 'erc-dcc
:type 'hook)
(defun erc-cmd-CREQ (line &optional force)
(defun erc-cmd-CREQ (line &optional _force)
"Set or get the DCC chat request flag.
Possible values are: ask, auto, ignore."
(when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
@ -1058,7 +1043,7 @@ Possible values are: ask, auto, ignore."
erc-dcc-chat-request)))
t)))
(defun erc-cmd-SREQ (line &optional force)
(defun erc-cmd-SREQ (line &optional _force)
"Set or get the DCC send request flag.
Possible values are: ask, auto, ignore."
(when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
@ -1075,7 +1060,7 @@ Possible values are: ask, auto, ignore."
(defun pcomplete/erc-mode/CREQ ()
(pcomplete-here '("auto" "ask" "ignore")))
(defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
(defalias 'pcomplete/erc-mode/SREQ #'pcomplete/erc-mode/CREQ)
(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook
'erc-dcc-chat-filter-functions "24.3")
@ -1087,19 +1072,19 @@ the unprocessed output.")
(defvar erc-dcc-chat-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'erc-send-current-line)
(define-key map "\t" 'completion-at-point)
(define-key map (kbd "RET") #'erc-send-current-line)
(define-key map "\t" #'completion-at-point)
map)
"Keymap for `erc-dcc-mode'.")
(define-derived-mode erc-dcc-chat-mode fundamental-mode "DCC-Chat"
"Major mode for wasting time via DCC chat."
(setq mode-line-process '(":%s")
erc-send-input-line-function 'erc-dcc-chat-send-input-line
erc-send-input-line-function #'erc-dcc-chat-send-input-line
erc-default-recipients '(dcc))
(add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
(add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
(defun erc-dcc-chat-send-input-line (recipient line &optional force)
(defun erc-dcc-chat-send-input-line (recipient line &optional _force)
"Send LINE to the remote end.
Argument RECIPIENT should always be the symbol dcc, and force
is ignored."
@ -1150,14 +1135,14 @@ other client."
(setq erc-input-marker (make-marker))
(erc-display-prompt buffer (point-max))
(set-process-buffer proc buffer)
(add-hook 'kill-buffer-hook 'erc-dcc-chat-buffer-killed nil t)
(add-hook 'kill-buffer-hook #'erc-dcc-chat-buffer-killed nil t)
(run-hook-with-args 'erc-dcc-chat-connect-hook proc)
buffer))
(defun erc-dcc-chat-accept (entry parent-proc)
"Accept an incoming DCC connection and open a DCC window."
(let* ((nick (erc-extract-nick (plist-get entry :nick)))
buffer proc)
(let* (;; (nick (erc-extract-nick (plist-get entry :nick)))
proc) ;; buffer
(setq proc
(funcall erc-dcc-connect-function
"dcc-chat" nil
@ -1167,9 +1152,10 @@ other client."
;; XXX: connected, should we kill the ip/port properties?
(setq entry (plist-put entry :peer proc))
(setq entry (plist-put entry :parent parent-proc))
(set-process-filter proc 'erc-dcc-chat-filter)
(set-process-sentinel proc 'erc-dcc-chat-sentinel)
(setq buffer (erc-dcc-chat-setup entry))))
(set-process-filter proc #'erc-dcc-chat-filter)
(set-process-sentinel proc #'erc-dcc-chat-sentinel)
;; (setq buffer
(erc-dcc-chat-setup entry))) ;; )
(defun erc-dcc-chat-filter (proc str)
(let ((orig-buffer (current-buffer)))

10
lisp/erc/erc-desktop-notifications.el
View file

@ -45,13 +45,11 @@
(defcustom erc-notifications-icon nil
"Icon to use for notification."
:group 'erc-notifications
:type '(choice (const :tag "No icon" nil) file))
(defcustom erc-notifications-bus :session
"D-Bus bus to use for notification."
:version "25.1"
:group 'erc-notifications
:type '(choice (const :tag "Session bus" :session) string))
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
@ -99,11 +97,11 @@ This will replace the last notification sent with this function."
(define-erc-module notifications nil
"Send notifications on private message reception and mentions."
;; Enable
((add-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
(add-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))
((add-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
(add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match))
;; Disable
((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
(remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)))
((remove-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
(remove-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match)))
(provide 'erc-desktop-notifications)

18
lisp/erc/erc-ezbounce.el
View file

@ -1,4 +1,4 @@
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@ -33,7 +33,6 @@
(defcustom erc-ezb-regexp "^ezbounce!srv$"
"Regexp used by the EZBouncer to identify itself to the user."
:group 'erc-ezbounce
:type 'regexp)
(defcustom erc-ezb-login-alist '()
@ -44,7 +43,6 @@ The alist's format is as follows:
(((server . port) . (username . password))
((server . port) . (username . password))
...)"
:group 'erc-ezbounce
:type '(repeat
(cons (cons :tag "Server"
string
@ -68,7 +66,7 @@ The alist's format is as follows:
"Indicate whether current notices are expected to be EZB session listings.")
;;;###autoload
(defun erc-cmd-ezb (line &optional force)
(defun erc-cmd-ezb (line &optional _force)
"Send EZB commands to the EZBouncer verbatim."
(erc-server-send (concat "EZB " line)))
(put 'erc-cmd-EZB 'do-not-parse-args t)
@ -102,7 +100,7 @@ in the alist is nil, prompt for the appropriate values."
found))
;;;###autoload
(defun erc-ezb-notice-autodetect (proc parsed)
(defun erc-ezb-notice-autodetect (_proc parsed)
"React on an EZBounce NOTICE request."
(let* ((sender (erc-response.sender parsed))
(message (erc-response.contents parsed))
@ -113,7 +111,7 @@ in the alist is nil, prompt for the appropriate values."
nil)
;;;###autoload
(defun erc-ezb-identify (message)
(defun erc-ezb-identify (_message)
"Identify to the EZBouncer server."
(let ((login (erc-ezb-get-login erc-session-server (erc-port-to-string erc-session-port))))
(unless (null login)
@ -122,13 +120,13 @@ in the alist is nil, prompt for the appropriate values."
(erc-server-send (concat "LOGIN " username " " pass))))))
;;;###autoload
(defun erc-ezb-init-session-list (message)
(defun erc-ezb-init-session-list (_message)
"Reset the EZBounce session list to nil."
(setq erc-ezb-session-list nil)
(setq erc-ezb-inside-session-listing t))
;;;###autoload
(defun erc-ezb-end-of-session-list (message)
(defun erc-ezb-end-of-session-list (_message)
"Indicate the end of the EZBounce session listing."
(setq erc-ezb-inside-session-listing nil))
@ -143,7 +141,7 @@ in the alist is nil, prompt for the appropriate values."
(add-to-list 'erc-ezb-session-list (list id nick to)))))
;;;###autoload
(defun erc-ezb-select (message)
(defun erc-ezb-select (_message)
"Select an IRC server to use by EZBounce, in ERC style."
(unless (and erc-ezb-session-list
(erc-ezb-select-session))
@ -169,7 +167,7 @@ in the alist is nil, prompt for the appropriate values."
;;;###autoload
(defun erc-ezb-initialize ()
"Add EZBouncer convenience functions to ERC."
(add-hook 'erc-server-NOTICE-functions 'erc-ezb-notice-autodetect))
(add-hook 'erc-server-NOTICE-functions #'erc-ezb-notice-autodetect))
(provide 'erc-ezbounce)

17
lisp/erc/erc-fill.el
View file

@ -1,4 +1,4 @@
;;; erc-fill.el --- Filling IRC messages in various ways
;;; erc-fill.el --- Filling IRC messages in various ways -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
@ -47,7 +47,7 @@ the mode if ARG is omitted or nil.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
nil nil nil
:global t :group 'erc-fill
:global t
(if erc-fill-mode
(erc-fill-enable)
(erc-fill-disable)))
@ -55,19 +55,18 @@ the channel buffers are filled."
(defun erc-fill-enable ()
"Setup hooks for `erc-fill-mode'."
(interactive)
(add-hook 'erc-insert-modify-hook 'erc-fill)
(add-hook 'erc-send-modify-hook 'erc-fill))
(add-hook 'erc-insert-modify-hook #'erc-fill)
(add-hook 'erc-send-modify-hook #'erc-fill))
(defun erc-fill-disable ()
"Cleanup hooks, disable `erc-fill-mode'."
(interactive)
(remove-hook 'erc-insert-modify-hook 'erc-fill)
(remove-hook 'erc-send-modify-hook 'erc-fill))
(remove-hook 'erc-insert-modify-hook #'erc-fill)
(remove-hook 'erc-send-modify-hook #'erc-fill))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
nil means fill with space, a string means fill with this string."
:group 'erc-fill
:type '(choice (const nil) string))
(defcustom erc-fill-function 'erc-fill-variable
@ -94,7 +93,6 @@ These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
function is called."
:group 'erc-fill
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
function))
@ -104,18 +102,15 @@ function is called."
centered. This column denotes the point where the ` ' character
between <nickname> and the entered text will be put, thus aligning
nick names right and text left."
:group 'erc-fill
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
"If we indent a line after a long nick, don't indent more then this
characters. Set to nil to disable."
:group 'erc-fill
:type 'integer)
(defcustom erc-fill-column 78
"The column at which a filled paragraph is broken."
:group 'erc-fill
:type 'integer)
;;;###autoload

Some files were not shown because too many files have changed in this diff Show more