[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen a8a59b9 1/2: Merge branch 'master' into scratch/etag
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen a8a59b9 1/2: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Fri, 19 Feb 2021 09:40:54 -0500 (EST) |
branch: scratch/etags-regen
commit a8a59b959494b3cd032f48edfa846e789889030b
Merge: 40c293b d0826e5
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
doc/emacs/custom.texi | 9 +-
doc/lispref/minibuf.texi | 2 +-
etc/NEWS | 24 +-
lisp/cedet/data-debug.el | 48 +--
lisp/cedet/ede/project-am.el | 111 +++----
lisp/cedet/pulse.el | 4 +-
lisp/cedet/semantic/bovine/gcc.el | 11 +-
lisp/cedet/semantic/idle.el | 32 +-
lisp/cedet/semantic/lex.el | 6 +-
lisp/cedet/semantic/scope.el | 14 +-
lisp/cus-dep.el | 4 +-
lisp/cus-edit.el | 2 +-
lisp/emacs-lisp/byte-opt.el | 142 ++++-----
lisp/emacs-lisp/bytecomp.el | 3 +-
lisp/emacs-lisp/edebug.el | 7 +-
lisp/emacs-lisp/lisp-mnt.el | 2 +-
lisp/emacs-lisp/lisp-mode.el | 3 -
lisp/emacs-lisp/macroexp.el | 71 ++++-
lisp/emacs-lisp/pp.el | 5 +-
lisp/erc/erc-pcomplete.el | 2 +-
lisp/eshell/em-cmpl.el | 6 +-
lisp/generic-x.el | 337 ++++++++-------------
lisp/gnus/gnus-art.el | 4 -
lisp/gnus/gnus-topic.el | 16 +-
lisp/gnus/gnus-util.el | 5 +
lisp/gnus/gnus.el | 6 +-
lisp/international/characters.el | 2 +-
lisp/international/mule-cmds.el | 67 +++-
lisp/menu-bar.el | 6 +-
lisp/minibuffer.el | 4 +-
lisp/net/dictionary.el | 37 ++-
lisp/net/ldap.el | 10 +-
lisp/net/mairix.el | 145 ++++-----
lisp/pcomplete.el | 15 +-
lisp/play/5x5.el | 42 +--
lisp/play/blackbox.el | 2 +-
lisp/play/cookie1.el | 14 +-
lisp/play/doctor.el | 2 +-
lisp/play/gametree.el | 2 +-
lisp/play/hanoi.el | 2 +-
lisp/play/zone.el | 21 +-
lisp/progmodes/elisp-mode.el | 21 +-
lisp/registry.el | 33 +-
lisp/simple.el | 53 ++--
lisp/subr.el | 10 +
lisp/textmodes/bib-mode.el | 11 +-
lisp/textmodes/texinfmt.el | 10 +-
lisp/vc/vc-bzr.el | 24 +-
lisp/vc/vc-cvs.el | 18 +-
lisp/vc/vc-dir.el | 12 +-
lisp/vc/vc-git.el | 5 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-svn.el | 4 +-
src/fns.c | 2 +-
src/lread.c | 3 +-
test/lisp/cedet/cedet-files-tests.el | 54 ++++
test/lisp/cedet/inversion-tests.el | 81 +++++
test/lisp/cedet/semantic-utest-fmt.el | 127 --------
.../cedet/semantic-utest-ia-resources}/test.mk | 0
.../cedet/semantic-utest-ia-resources}/test.srt | 0
.../cedet/semantic-utest-ia-resources}/test.texi | 0
.../semantic-utest-ia-resources}/testdoublens.cpp | 0
.../semantic-utest-ia-resources}/testdoublens.hpp | 0
.../semantic-utest-ia-resources}/testfriends.cpp | 1 -
.../semantic-utest-ia-resources}/testjavacomp.java | 0
.../semantic-utest-ia-resources}/testlocalvars.cpp | 0
.../cedet/semantic-utest-ia-resources}/testnsp.cpp | 0
.../semantic-utest-ia-resources}/testsppcomplete.c | 0
.../semantic-utest-ia-resources}/teststruct.cpp | 0
.../semantic-utest-ia-resources}/testsubclass.cpp | 0
.../semantic-utest-ia-resources}/testsubclass.hh | 0
.../semantic-utest-ia-resources}/testtemplates.cpp | 0
.../semantic-utest-ia-resources}/testtypedefs.cpp | 0
.../semantic-utest-ia-resources}/testusing.cpp | 0
.../semantic-utest-ia-resources}/testusing.hh | 0
.../semantic-utest-ia-resources}/testvarnames.c | 0
.../semantic-utest-ia-resources}/testvarnames.java | 0
.../semantic-utest-ia-resources}/testwisent.wy | 0
test/lisp/cedet/semantic-utest-ia.el | 71 ++---
test/lisp/cedet/semantic/bovine/gcc-tests.el | 129 ++++++++
.../cedet/semantic/format-resources}/test-fmt.cpp | 0
.../cedet/semantic/format-resources}/test-fmt.el | 2 +-
test/lisp/cedet/semantic/format-tests.el | 95 ++++++
test/lisp/cedet/semantic/fw-tests.el | 45 +++
test/lisp/cedet/srecode/document-tests.el | 80 +++++
.../cedet/srecode/fields-tests.el} | 94 ++----
test/lisp/cus-edit-tests.el | 4 +-
test/lisp/play/cookie1-resources/cookies | 8 +
test/lisp/play/cookie1-tests.el | 40 +++
test/lisp/simple-tests.el | 5 +
test/manual/cedet/cedet-utests.el | 105 +------
test/manual/cedet/ede-tests.el | 14 +-
test/manual/cedet/semantic-tests.el | 122 --------
test/manual/cedet/tests/test.el | 2 +-
test/manual/etags/ETAGS.good_1 | 10 +-
test/manual/etags/el-src/TAGTEST.EL | 2 +
96 files changed, 1342 insertions(+), 1206 deletions(-)
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ccf5f19..22900c5 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -519,12 +519,9 @@ Set up a customization buffer for all the settings and
groups that
match @var{regexp}.
@item M-x customize-changed @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the settings and groups
-whose meaning has changed since Emacs version @var{version}.
-
-@item M-x customize-changed-options @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the options whose meaning or
-default values have changed since Emacs version @var{version}.
+Set up a customization buffer with all the user options, faces and
+groups whose meaning has changed since (or been added after) Emacs
+version @var{version}.
@item M-x customize-saved
Set up a customization buffer containing all settings that you
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 185d355..b60775d 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2393,7 +2393,7 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
keys in minibuffer local keymaps. The command throws an error if the
-current buffer is not the active minibuffer.
+current buffer is a minibuffer, but not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit
diff --git a/etc/NEWS b/etc/NEWS
index 5130048..3cbf2a0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -602,10 +602,11 @@ This is used when expanding commit messages from
'vc-print-root-log'
and similar commands.
---
-*** New faces for 'vc-dir' buffers and their Git VC backend.
+*** New faces for 'vc-dir' buffers.
Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
-'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'.
+'vc-dir-status-edited', 'vc-dir-status-up-to-date',
+'vc-dir-status-ignored'.
---
*** The responsible VC backend is now the most specific one.
@@ -872,6 +873,14 @@ so e.g. like 'C-x 8 [' inserts a left single quotation
mark,
'C-x \ [' does the same.
---
+*** New user options 'read-char-by-name-sort' and 'read-char-by-name-group'.
+'read-char-by-name-sort' defines the sorting order of characters for
+completion of 'C-x 8 RET TAB' and can be customized to sort them
+by codepoints instead of character names by default. The 't' value of
+'read-char-by-name-group' groups the characters for completion of
+'C-x 8 RET TAB' by Unicode blocks.
+
+---
*** Improved language transliteration in Malayalam input methods.
Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
deprecated. Errors in the Inscript method were corrected.
@@ -916,7 +925,7 @@ To revert to the previous behavior,
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
-'customize-changed-options'.
+'customize-changed'.
To customize obsolete user options, use 'customize-option' or
'customize-saved'.
@@ -2056,6 +2065,8 @@ directory instead of the default directory.
* Incompatible Lisp Changes in Emacs 28.1
+** 'pcomplete-ignore-case' is now an obsolete alias of
'completion-ignore-case'.
+
** 'completions-annotations' face is not used when the caller puts own face.
This affects the suffix specified by completion 'annotation-function'.
@@ -2112,6 +2123,11 @@ parameter.
by mistake and were not useful to Lisp code.
---
+** Loading 'generic-x' unconditionally loads all modes.
+The user option `generic-extras-enable-list' is now obsolete, and
+setting it has no effect.
+
+---
** The 'load-dangerous-libraries' variable is now obsolete.
It was used to allow loading Lisp libraries compiled by XEmacs, a
modified version of Emacs which is no longer actively maintained.
@@ -2215,6 +2231,8 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
* Lisp Changes in Emacs 28.1
+** The 'values' variable is now obsolete.
+
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index a062a5a..f0fa91b 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1045,30 +1045,30 @@ If the result is a list or vector, then use the data
debugger to display it."
(list (let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Eval: "
nil read-expression-map t
- 'read-expression-history))
- ))
-
- (if (null eval-expression-debug-on-error)
- (setq values (cons (eval expr) values))
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (setq values (cons (eval expr) values))
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (if (or (consp (car values)) (vectorp (car values)))
- (let ((v (car values)))
- (data-debug-show-stuff v "Expression"))
- ;; Old style
- (prog1
- (prin1 (car values) t)
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str t))))))
+ 'read-expression-history))))
+
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result (values--store-value (eval expr)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result (values--store-value (eval expr)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (if (or (consp result) (vectorp result))
+ (let ((v result))
+ (data-debug-show-stuff v "Expression"))
+ ;; Old style
+ (prog1
+ (prin1 result t)
+ (let ((str (eval-expression-print-format result)))
+ (if str (princ str t)))))))
(provide 'data-debug)
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 061d1b5..d676c57 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,4 +1,4 @@
-;;; project-am.el --- A project management scheme based on automake files.
+;;; project-am.el --- A project management scheme based on automake files.
-*- lexical-binding: t; -*-
;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
@@ -54,17 +54,14 @@
(defcustom project-am-compile-project-command nil
"Default command used to compile a project."
- :group 'project-am
:type '(choice (const nil) string))
(defcustom project-am-compile-target-command (concat ede-make-command " -k %s")
"Default command used to compile a project."
- :group 'project-am
:type 'string)
(defcustom project-am-debug-target-function 'gdb
"Default Emacs command used to debug a target."
- :group 'project-am
:type 'function) ; make this be a list some day
(defconst project-am-type-alist
@@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(cl-defmethod project-new-target ((proj project-am-makefile)
- &optional name type)
+(cl-defmethod project-new-target ((_proj project-am-makefile)
+ &optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
matching something in `project-am-type-alist' or type class symbol.
@@ -300,7 +297,7 @@ buffer being in order to provide a smart default target
type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(cl-defmethod project-compile-project ((obj project-am-target) &optional
command)
+(cl-defmethod project-compile-project ((_obj project-am-target) &optional
command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((_obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-target ((obj project-am-target) &optional
command)
+(cl-defmethod project-compile-target ((_obj project-am-target) &optional
command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the
target."
;;; Project loading and saving
;;
-(defun project-am-load (directory &optional rootproj)
+(defun project-am-load (directory &optional _rootproj)
"Read an automakefile DIRECTORY into our data structure.
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
@@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project."
(file-name-directory (directory-file-name newdir))))
(expand-file-name dir)))
+(defvar recentf-exclude)
+
(defmacro project-am-with-makefile-current (dir &rest forms)
"Set the Makefile.am in DIR to be the current buffer.
-Run FORMS while the makefile is current.
-Kill the makefile if it was not loaded before the load."
- `(let* ((fn (expand-file-name "Makefile.am" ,dir))
- (fb nil)
- (kb (get-file-buffer fn)))
- (if (not (file-exists-p fn))
- nil
- (save-excursion
- (if kb (setq fb kb)
- ;; We need to find-file this thing, but don't use
- ;; any semantic features.
- (let ((semantic-init-hook nil)
- (recentf-exclude '( (lambda (f) t) ))
- )
- (setq fb (find-file-noselect fn)))
- )
- (set-buffer fb)
- (prog1 ,@forms
- (if (not kb) (kill-buffer (current-buffer))))))))
-(put 'project-am-with-makefile-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-makefile-current
- (form def-body))))
-
+Run FORMS while the makefile is current."
+ (declare (indent 1) (debug (form def-body)))
+ `(project-am--with-makefile-current ,dir (lambda () ,@forms)))
+
+(defun project-am--with-makefile-current (dir fun)
+ (let* ((fn (expand-file-name "Makefile.am" dir))
+ (kb (get-file-buffer fn)))
+ (if (not (file-exists-p fn))
+ nil
+ (with-current-buffer
+ (or kb
+ ;; We need to find-file this thing, but don't use
+ ;; any semantic features.
+ (let ((semantic-init-hook nil)
+ (recentf-exclude `(,(lambda (_f) t))))
+ (find-file-noselect fn)))
+ (unwind-protect (funcall fun)
+ (if (not kb) (kill-buffer (current-buffer))))))))
(defun project-am-load-makefile (path &optional suggestedname)
"Convert PATH into a project Makefile, and return its project object.
@@ -480,6 +471,7 @@ This is used when subprojects are made in named
subdirectories."
(if (and ede-object (project-am-makefile-p ede-object))
ede-object
(let* ((pi (project-am-package-info path))
+ (fn buffer-file-name)
(sfn (when suggestedname
(project-am-last-dir suggestedname)))
(pn (or sfn (nth 0 pi) (project-am-last-dir fn)))
@@ -734,19 +726,19 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES"))
-(cl-defmethod project-am-macro ((this project-am-header-noinst))
+(cl-defmethod project-am-macro ((_this project-am-header-noinst))
"Return the default macro to `edit' for this object."
"noinst_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-inst))
+(cl-defmethod project-am-macro ((_this project-am-header-inst))
"Return the default macro to `edit' for this object."
"include_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-pkg))
+(cl-defmethod project-am-macro ((_this project-am-header-pkg))
"Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-chk))
+(cl-defmethod project-am-macro ((_this project-am-header-chk))
"Return the default macro to `edit' for this object."
"check_HEADERS")
@@ -758,7 +750,7 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(oref this name))
-(cl-defmethod project-am-macro ((this project-am-lisp))
+(cl-defmethod project-am-macro ((_this project-am-lisp))
"Return the default macro to `edit' for this object."
"lisp_LISP")
@@ -785,13 +777,11 @@ nil means that this buffer belongs to no-one."
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this file) efn)
- (string-match "/configure\\.ac$" efn)
- (string-match "/configure\\.in$" efn)
- (string-match "/configure$" efn)
+ (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn)
;; Search output files.
(let ((ans nil))
(dolist (f (oref this configureoutputfiles))
- (when (string-match (concat (regexp-quote f) "$") efn)
+ (when (string-match (concat (regexp-quote f) "\\'") efn)
(setq ans t)))
ans)
)))
@@ -822,7 +812,7 @@ nil means that this buffer belongs to no-one."
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(cl-defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((_this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
@@ -861,7 +851,7 @@ Argument FILE is the file to extract the end directory name
from."
(t
'project-am-program)))
-(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer)
"There are no default header files."
(or (cl-call-next-method)
(let ((s (oref this source))
@@ -910,22 +900,13 @@ files in the project."
"Set the Configure FILE in the top most directory above DIR as current.
Run FORMS in the configure file.
Kill the Configure buffer if it was not already in a buffer."
- `(save-excursion
- (let ((fb (generate-new-buffer ,file)))
- (set-buffer fb)
- (erase-buffer)
- (insert-file-contents ,file)
- (prog1 ,@forms
- (kill-buffer fb)))))
-
-(put 'project-am-with-config-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-config-current
- (form def-body))))
-
-(defmacro project-am-extract-shell-variable (var)
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (erase-buffer)
+ (insert-file-contents ,file)
+ ,@forms))
+
+(defun project-am-extract-shell-variable (var)
"Extract the value of the shell variable VAR from a shell script."
(save-excursion
(goto-char (point-min))
@@ -997,12 +978,12 @@ Calculates the info with
`project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(cl-defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((_this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(cl-defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((_this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index aef4fc8..3257feb 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
-;;; pulse.el --- Pulsing Overlays
+;;; pulse.el --- Pulsing Overlays -*- 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>
;; Version: 1.0
diff --git a/lisp/cedet/semantic/bovine/gcc.el
b/lisp/cedet/semantic/bovine/gcc.el
index 1cfe5a3..9cd9cdc 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
+;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -25,6 +25,7 @@
;; GCC, and set up the preprocessor and include paths.
(require 'semantic/dep)
+(require 'cl-lib)
(defvar semantic-lex-c-preprocessor-symbol-file)
(defvar semantic-lex-c-preprocessor-symbol-map)
@@ -88,9 +89,7 @@ to give to the program."
(let ((path (substring line 1)))
(when (and (file-accessible-directory-p path)
(file-name-absolute-p path))
- (add-to-list 'inc-path
- (expand-file-name path)
- t))))))))
+ (cl-pushnew (expand-file-name path) inc-path))))))))
inc-path))
@@ -101,7 +100,7 @@ to give to the program."
(dolist (L lines)
(let ((dat (split-string L)))
(when (= (length dat) 3)
- (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
+ (push (cons (nth 1 dat) (nth 2 dat)) lst))))
lst))
(defun semantic-gcc-fields (str)
@@ -142,6 +141,8 @@ This is an alist, and should include keys of:
`--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
+(defvar c++-include-path)
+
;;;###autoload
(defun semantic-gcc-setup ()
"Setup Semantic C/C++ parsing based on GCC output."
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 9f1bcfa..5af4607 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,4 +1,4 @@
-;;; idle.el --- Schedule parsing tasks in idle time
+;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t;
-*-
;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc.
@@ -222,18 +222,18 @@ And also manages services that depend on tag values."
(and (buffer-file-name b)
b))
(buffer-list)))))
- safe ;; This safe is not used, but could be.
+ ;; safe ;; This safe is not used, but could be.
others
mode)
(when (semantic-idle-scheduler-enabled-p)
(save-excursion
;; First, reparse the current buffer.
- (setq mode major-mode
- safe (semantic-safe "Idle Parse Error: %S"
- ;(error "Goofy error 1")
- (semantic-idle-scheduler-refresh-tags)
- )
- )
+ (setq mode major-mode)
+ ;; (setq safe
+ (semantic-safe "Idle Parse Error: %S"
+ ;(error "Goofy error 1")
+ (semantic-idle-scheduler-refresh-tags))
+
;; Now loop over other buffers with same major mode, trying to
;; update them as well. Stop on keypress.
(dolist (b buffers)
@@ -430,6 +430,8 @@ datasets."
(message "Long Work Idle Timer...%s" exit-type)))
)
+(defvar ede-auto-add-method)
+
(defun semantic-idle-scheduler-work-parse-neighboring-files ()
"Parse all the files in similar directories to buffers being edited."
;; Let's tell EDE to ignore all the files we're about to load
@@ -564,11 +566,12 @@ DOC will be a documentation string describing FORMS.
FORMS will be called during idle time after the current buffer's
semantic tag information has been updated.
This routine creates the following functions and variables:"
+ (declare (indent 1) (debug (&define name stringp def-body)))
(let ((global (intern (concat "global-" (symbol-name name) "-mode")))
(mode (intern (concat (symbol-name name) "-mode")))
(hook (intern (concat (symbol-name name) "-mode-hook")))
(map (intern (concat (symbol-name name) "-mode-map")))
- (setup (intern (concat (symbol-name name) "-mode-setup")))
+ ;; (setup (intern (concat (symbol-name name) "-mode-setup")))
(func (intern (concat (symbol-name name) "-idle-function"))))
`(progn
@@ -618,11 +621,6 @@ turned on in every Semantic-supported buffer.")
,(concat "Perform idle activity for the minor mode `"
(symbol-name mode) "'.")
,@forms))))
-(put 'define-semantic-idle-service 'lisp-indent-function 1)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec define-semantic-idle-service
- (&define name stringp def-body))))
;;; SUMMARY MODE
;;
@@ -821,6 +819,8 @@ turned on in every Semantic-supported buffer."
(make-obsolete-variable 'semantic-idle-symbol-highlight-face
"customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
+(defvar pulse-flag)
+
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
TAG was found as the symbol under point. If it happens to be
@@ -898,7 +898,7 @@ Call `semantic-symref-hits-in-region' to identify local
references."
(when (semantic-tag-p target)
(require 'semantic/symref/filter)
(semantic-symref-hits-in-region
- target (lambda (start end prefix)
+ target (lambda (start end _prefix)
(when (/= start (car Hbounds))
(pulse-momentary-highlight-region
start end semantic-idle-symbol-highlight-face))
@@ -1231,7 +1231,7 @@ shortened at the beginning."
)
(defun semantic-idle-breadcrumbs--format-linear
- (tag-list &optional max-length)
+ (tag-list &optional _max-length)
"Format TAG-LIST as a linear list, starting with the outermost tag.
MAX-LENGTH is not used."
(require 'semantic/analyze/fcn)
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 4cafc7d..ae70d5c 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -469,11 +469,9 @@ PROPERTY set."
;;; Lexical Analyzer framework settings
;;
-;; FIXME change to non-obsolete default.
-(defvar-local semantic-lex-analyzer 'semantic-flex
+(defvar-local semantic-lex-analyzer 'semantic-lex
"The lexical analyzer used for a given buffer.
-See `semantic-lex' for documentation.
-For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
+See `semantic-lex' for documentation.")
(defvar semantic-lex-tokens
'(
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 31576d2..6bd04b2 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,4 +1,4 @@
-;;; semantic/scope.el --- Analyzer Scope Calculations
+;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t;
-*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.")
)
(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
- new-tags)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
@@ -262,7 +262,7 @@ are from nesting data types."
(semantic-go-to-tag pparent)
(setq stack (semantic-find-tag-by-overlay (point)))
;; Step one, find the merged version of stack in the typecache.
- (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
+ (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack)))
(tc nil)
)
;; @todo - can we use the typecache ability to
@@ -317,7 +317,7 @@ are from nesting data types."
;; returnlist is empty.
(while snlist
(setq fullsearchname
- (append (mapcar 'semantic-tag-name returnlist)
+ (append (mapcar #'semantic-tag-name returnlist)
(list (car snlist)))) ;; Next one
(setq ptag
(semanticdb-typecache-find fullsearchname))
@@ -325,8 +325,8 @@ are from nesting data types."
(when (or (not ptag)
(not (semantic-tag-of-class-p ptag 'type)))
(let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
+ (apply #'append
+ (mapcar #'semantic-tag-type-members
(cons (car returnlist) scopetypes)
)))
)
@@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE."
(setq leftover (cons S leftover)))))
(nreverse leftover)))
-(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit
protection)
+(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit
_protection)
"Return all parts of TYPE, a tag representing a TYPE declaration.
SCOPE is the scope object.
NOINHERIT turns off searching of inherited tags.
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index a52d082..f0b108b 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -178,7 +178,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
(insert "\
;; The remainder of this file is for handling :version.
-;; We provide a minimum of information so that `customize-changed-options'
+;; We provide a minimum of information so that `customize-changed'
;; can do its job.
;; For groups we set `custom-version', `group-documentation' and
@@ -239,7 +239,7 @@ Usage: emacs -batch -l ./cus-dep.el -f
custom-make-dependencies DIRS"
This is an alist whose members have as car a version string, and as
elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
-buffer that `customize-changed-options' generates.\")\n\n"))
+buffer that `customize-changed' generates.\")\n\n"))
(save-buffer)
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index cd1ae96..dde6e89 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it."
(message "`%s' is an alias for `%s'" symbol basevar))))
(defvar customize-changed-options-previous-release "26.3"
- "Version for `customize-changed-options' to refer back to by default.")
+ "Version for `customize-changed' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###autoload
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index abbe2a2..4fa2c75 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -289,7 +289,7 @@
(byte-compile-preprocess
(byte-compile--reify-function fn))))))
(if (eq (car-safe newfn) 'function)
- (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+ (macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form)))
;; This can happen because of macroexp-warn-and-return &co.
(byte-compile-warn
"Inlining closure %S failed" name)
@@ -297,74 +297,6 @@
(_ ;; Give up on inlining.
form))))
-
-;; ((lambda ...) ...)
-(defun byte-compile-unfold-lambda (form &optional name)
- ;; In lexical-binding mode, let and functions don't bind vars in the same way
- ;; (let obey special-variable-p, but functions don't). But luckily, this
- ;; doesn't matter here, because function's behavior is underspecified so it
- ;; can safely be turned into a `let', even though the reverse is not true.
- (or name (setq name "anonymous lambda"))
- (let* ((lambda (car form))
- (values (cdr form))
- (arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (byte-compile-warn "attempt to open-code `%s' with too few
arguments" name)
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (progn
- (or (eq values 'too-few)
- (byte-compile-warn
- "attempt to open-code `%s' with too many arguments" name))
- form)
-
- ;; The following leads to infinite
recursion when loading a
- ;; file containing `(defsubst f ()
(f))', and then trying to
- ;; byte-compile that file.
- ;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
- (if bindings
- (cons 'let (cons (nreverse bindings) body))
- (cons 'progn body))))
- (byte-compile-log " %s\t==>\t%s" form newform)
- newform))))
-
;;; implementing source-level optimizers
@@ -416,6 +348,40 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(symbolp (cadr expr)))
(keywordp expr)))
+(defmacro byte-optimize--pcase (exp &rest cases)
+ ;; When we do
+ ;;
+ ;; (pcase EXP
+ ;; (`(if ,exp ,then ,else) (DO-TEST))
+ ;; (`(plus ,e2 ,e2) (DO-ADD))
+ ;; (`(times ,e2 ,e2) (DO-MULT))
+ ;; ...)
+ ;;
+ ;; we usually don't want to fall back to the default case if
+ ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)'
+ ;; or `(times E1 E2 E3)', instead we either want to signal an error
+ ;; that EXP has an unexpected shape, or we want to carry on as if
+ ;; it had the right shape (ignore the extra data and pretend the missing
+ ;; data is nil) because it should simply never happen.
+ ;;
+ ;; The macro below implements the second option by rewriting patterns
+ ;; like `(if ,exp ,then ,else)'
+ ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'.
+ ;;
+ ;; The resulting macroexpansion is also significantly cleaner/smaller/faster.
+ (declare (indent 1) (debug (form &rest (pcase-PAT body))))
+ `(pcase ,exp
+ . ,(mapcar (lambda (case)
+ `(,(pcase (car case)
+ ((and `(,'\` (,_ . (,'\, ,_))) pat) pat)
+ (`(,'\` (,head . ,tail))
+ (list '\`
+ (cons head
+ (list '\, `(or ,(list '\` tail)
pcase--dontcare)))))
+ (pat pat))
+ . ,(cdr case)))
+ cases)))
+
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@@ -428,7 +394,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
- (pcase form
+ (byte-optimize--pcase form
((pred (not consp))
(cond
((and for-effect
@@ -438,7 +404,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
- (if (cddr lexvar) ; Value available?
+ (if (cddr lexvar) ; Value available?
(if (assq form byte-optimize--vars-outside-loop)
;; Cannot substitute; mark for retention to avoid the
;; variable being eliminated.
@@ -458,27 +424,27 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(not for-effect)
form))
(`(,(or 'let 'let*) . ,rest)
- (cons fn (byte-optimize-let-form fn rest for-effect)))
+ (cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
;; The condition in the first clause is always executed, but
;; right now we treat all of them as conditional for simplicity.
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
(cons fn
(mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- clauses))))
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses))))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
- (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
+ (`(prog1 ,exp . ,exps)
(if exps
`(prog1 ,(byte-optimize-form exp for-effect)
. ,(byte-optimize-body exps t))
@@ -503,8 +469,6 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(then-opt (byte-optimize-form then for-effect))
(else-opt (byte-optimize-body else for-effect)))
`(if ,test-opt ,then-opt . ,else-opt)))
- (`(if . ,_)
- (byte-compile-warn "too few arguments for `if'"))
(`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
;; FIXME: We have to traverse the expressions in left-to-right
@@ -542,8 +506,6 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(body (byte-optimize-body exps t)))
`(while ,condition . ,body)))
- (`(while . ,_)
- (byte-compile-warn "too few arguments for `while'"))
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
@@ -555,9 +517,9 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; all the subexpressions and compiling them separately.
form)
- (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
+ (`(condition-case ,var ,exp . ,clauses)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
- `(condition-case ,var ;Not evaluated.
+ `(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
@@ -581,7 +543,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
`(unwind-protect ,bodyform
. ,(byte-optimize-body exps t))))))
- (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
+ (`(catch ,tag . ,exps)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect))))
@@ -604,7 +566,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
form)
(`((lambda . ,_) . ,_)
- (let ((newform (byte-compile-unfold-lambda form)))
+ (let ((newform (macroexp--unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion.
form
@@ -634,7 +596,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(setcdr (cdr lexvar)
(and (byte-optimize--substitutable-p value)
(list value))))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t)) ; Mark variable to be kept.
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9429d6a..89068a1 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -195,7 +195,6 @@ otherwise adds \".elc\"."
(autoload 'byte-optimize-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
-(autoload 'byte-compile-unfold-lambda "byte-opt")
;; This is the entry point to the decompiler, which is used by the
;; disassembler. The disassembler just requires 'byte-compile, but
@@ -3277,7 +3276,7 @@ for symbols generated by the byte compiler itself."
((and (eq (car-safe (car form)) 'lambda)
;; if the form comes out the same way it went in, that's
;; because it was malformed, and we couldn't unfold it.
- (not (eq form (setq form (byte-compile-unfold-lambda form)))))
+ (not (eq form (setq form (macroexp--unfold-lambda form)))))
(byte-compile-form form byte-compile--for-effect)
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 5d59585..41768f2 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3801,9 +3801,10 @@ Print result in minibuffer."
(interactive (list (read--expression "Eval: ")))
(princ
(edebug-outside-excursion
- (setq values (cons (edebug-eval expr) values))
- (concat (edebug-safe-prin1-to-string (car values))
- (eval-expression-print-format (car values))))))
+ (let ((result (edebug-eval expr)))
+ (values--store-value result)
+ (concat (edebug-safe-prin1-to-string result)
+ (eval-expression-print-format result))))))
(defun edebug-eval-last-sexp (&optional no-truncate)
"Evaluate sexp before point in the outside environment.
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index adb9cb2..6d9c8c3 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -495,7 +495,7 @@ absent, return nil."
(concat "^;;;[[:blank:]]*\\("
lm-commentary-header
"\\):[[:blank:]\n]*")
- "^;;[[:blank:]]*" ; double semicolon prefix
+ "^;;[[:blank:]]?" ; double semicolon prefix
"[[:blank:]\n]*\\'") ; trailing new-lines
"" (buffer-substring-no-properties
start (lm-commentary-end))))))))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index f5ce107..54089c4 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -62,9 +62,6 @@
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table)
- ;; This is probably obsolete since nowadays such features use overlays.
- ;; ;; Give CR the same syntax as newline, for selective-display.
- ;; (modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\; "< " table)
(modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e842222..042061c 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -200,6 +200,69 @@ and also to avoid outputting the warning during normal
execution."
new-form))
new-form)))
+(defun macroexp--unfold-lambda (form &optional name)
+ ;; In lexical-binding mode, let and functions don't bind vars in the same way
+ ;; (let obey special-variable-p, but functions don't). But luckily, this
+ ;; doesn't matter here, because function's behavior is underspecified so it
+ ;; can safely be turned into a `let', even though the reverse is not true.
+ (or name (setq name "anonymous lambda"))
+ (let* ((lambda (car form))
+ (values (cdr form))
+ (arglist (nth 1 lambda))
+ (body (cdr (cdr lambda)))
+ optionalp restp
+ bindings)
+ (if (and (stringp (car body)) (cdr body))
+ (setq body (cdr body)))
+ (if (and (consp (car body)) (eq 'interactive (car (car body))))
+ (setq body (cdr body)))
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr arglist))
+ (error "nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car arglist) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in arglists.
+ (if (null (cdr arglist))
+ (error "nothing after &rest in %s" name))
+ (if (cdr (cdr arglist))
+ (error "multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car arglist)
+ (and values (cons 'list values)))
+ bindings)
+ values nil))
+ ((and (not optionalp) (null values))
+ (setq arglist nil values 'too-few))
+ (t
+ (setq bindings (cons (list (car arglist) (car values))
+ bindings)
+ values (cdr values))))
+ (setq arglist (cdr arglist)))
+ (if values
+ (macroexp--warn-and-return
+ (format (if (eq values 'too-few)
+ "attempt to open-code `%s' with too few arguments"
+ "attempt to open-code `%s' with too many arguments")
+ name)
+ form)
+
+ ;; The following leads to infinite recursion when loading a
+ ;; file containing `(defsubst f () (f))', and then trying to
+ ;; byte-compile that file.
+ ;;(setq body (mapcar 'byte-optimize-form body)))
+
+ (if bindings
+ `(let ,(nreverse bindings) . ,body)
+ (macroexp-progn body)))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
@@ -245,12 +308,8 @@ Assumes the caller has bound
`macroexpand-all-environment'."
;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the
optimizer
;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
;; creation of a closure, thus resulting in much better code.
- (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
- 'macroexp--not-unfolded
- ;; Don't unfold if byte-opt is not yet loaded.
- (byte-compile-unfold-lambda form))))
- (if (or (eq newform 'macroexp--not-unfolded)
- (eq newform form))
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
;; Unfolding failed for some reason, avoid infinite recursion.
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index ef4c960..2fd4724 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -127,8 +127,9 @@ Also add the value to the front of the list in the variable
`values'."
(interactive
(list (read--expression "Eval: ")))
(message "Evaluating...")
- (push (eval expression lexical-binding) values)
- (pp-display-expression (car values) "*Pp Eval Output*"))
+ (let ((result (eval expression lexical-binding)))
+ (values--store-value result)
+ (pp-display-expression result "*Pp Eval Output*")))
;;;###autoload
(defun pp-macroexpand-expression (expression)
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index ab4c7c5..ddaf787 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -89,7 +89,7 @@ for use on `completion-at-point-function'."
(defun pcomplete-erc-setup ()
"Setup `erc-mode' to use pcomplete."
- (setq-local pcomplete-ignore-case t)
+ (setq-local completion-ignore-case t)
(setq-local pcomplete-use-paring nil)
(setq-local pcomplete-parse-arguments-function
#'pcomplete-erc-parse-arguments)
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 638c0ac..cbfe0b8 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -150,8 +150,8 @@ to writing a completion function."
:type (get 'pcomplete-dir-ignore 'custom-type))
(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
- (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case)
- :type (get 'pcomplete-ignore-case 'custom-type))
+ (eshell-cmpl--custom-variable-docstring 'completion-ignore-case)
+ :type (get 'completion-ignore-case 'custom-type))
(defcustom eshell-cmpl-autolist nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-autolist)
@@ -259,7 +259,7 @@ to writing a completion function."
eshell-cmpl-file-ignore)
(setq-local pcomplete-dir-ignore
eshell-cmpl-dir-ignore)
- (setq-local pcomplete-ignore-case
+ (setq-local completion-ignore-case
eshell-cmpl-ignore-case)
(setq-local pcomplete-autolist
eshell-cmpl-autolist)
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 4c6e118..0f4e1ae 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -23,7 +23,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file contains a collection of generic modes.
;;
;; INSTALLATION:
@@ -32,17 +32,6 @@
;;
;; (require 'generic-x)
;;
-;; You can decide which modes to load by setting the variable
-;; `generic-extras-enable-list'. Its default value is platform-
-;; specific. The recommended way to set this variable is through
-;; customize:
-;;
-;; M-x customize-option RET generic-extras-enable-list RET
-;;
-;; This lets you select generic modes from the list of available
-;; modes. If you manually set `generic-extras-enable-list' in your
-;; .emacs, do it BEFORE loading generic-x with (require 'generic-x).
-;;
;; You can also send in new modes; if the file types are reasonably
;; common, we would like to install them.
;;
@@ -184,88 +173,7 @@ This hook will be installed if the variable
;; Other Generic modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; If you add a generic mode to this file, put it in one of these four
-;; lists as well.
-
-(defconst generic-default-modes
- '(apache-conf-generic-mode
- apache-log-generic-mode
- hosts-generic-mode
- java-manifest-generic-mode
- java-properties-generic-mode
- javascript-generic-mode
- show-tabs-generic-mode
- vrml-generic-mode)
- "List of generic modes that are defined by default.")
-
-(defconst generic-mswindows-modes
- '(bat-generic-mode
- inf-generic-mode
- ini-generic-mode
- rc-generic-mode
- reg-generic-mode
- rul-generic-mode)
- "List of generic modes that are defined by default on MS-Windows.")
-
-(defconst generic-unix-modes
- '(alias-generic-mode
- ansible-inventory-generic-mode
- etc-fstab-generic-mode
- etc-modules-conf-generic-mode
- etc-passwd-generic-mode
- etc-services-generic-mode
- etc-sudoers-generic-mode
- fvwm-generic-mode
- inetd-conf-generic-mode
- mailagent-rules-generic-mode
- mailrc-generic-mode
- named-boot-generic-mode
- named-database-generic-mode
- prototype-generic-mode
- resolve-conf-generic-mode
- samba-generic-mode
- x-resource-generic-mode
- xmodmap-generic-mode)
- "List of generic modes that are defined by default on Unix.")
-
-(defconst generic-other-modes
- '(astap-generic-mode
- ibis-generic-mode
- pkginfo-generic-mode
- spice-generic-mode)
- "List of generic modes that are not defined by default.")
-
-(defcustom generic-extras-enable-list
- (append generic-default-modes
- (if (memq system-type '(windows-nt ms-dos))
- generic-mswindows-modes
- generic-unix-modes)
- nil)
- "List of generic modes to define.
-Each entry in the list should be a symbol. If you set this variable
-directly, without using customize, you must reload generic-x to put
-your changes into effect."
- :type (let (list)
- (dolist (mode
- (sort (append generic-default-modes
- generic-mswindows-modes
- generic-unix-modes
- generic-other-modes
- nil)
- (lambda (a b)
- (string< (symbol-name b)
- (symbol-name a))))
- (cons 'set list))
- (push `(const ,mode) list)))
- :set (lambda (s v)
- (set-default s v)
- (unless load-in-progress
- (load "generic-x")))
- :version "22.1")
-
;;; Apache
-(when (memq 'apache-conf-generic-mode generic-extras-enable-list)
-
(define-generic-mode apache-conf-generic-mode
'(?#)
nil
@@ -278,9 +186,7 @@ your changes into effect."
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
- "Generic mode for Apache or HTTPD configuration files."))
-
-(when (memq 'apache-log-generic-mode generic-extras-enable-list)
+ "Generic mode for Apache or HTTPD configuration files.")
(define-generic-mode apache-log-generic-mode
nil
@@ -291,11 +197,9 @@ your changes into effect."
(2 font-lock-variable-name-face)))
'("access_log\\'")
nil
- "Generic mode for Apache log files."))
+ "Generic mode for Apache log files.")
;;; Samba
-(when (memq 'samba-generic-mode generic-extras-enable-list)
-
(define-generic-mode samba-generic-mode
'(?\; ?#)
nil
@@ -305,13 +209,11 @@ your changes into effect."
(2 font-lock-type-face)))
'("smb\\.conf\\'")
'(generic-bracket-support)
- "Generic mode for Samba configuration files."))
+ "Generic mode for Samba configuration files.")
;;; Fvwm
;; This is pretty basic. Also, modes for other window managers could
;; be defined as well.
-(when (memq 'fvwm-generic-mode generic-extras-enable-list)
-
(define-generic-mode fvwm-generic-mode
'(?#)
'("AddToMenu"
@@ -330,33 +232,28 @@ your changes into effect."
nil
'("\\.fvwmrc\\'" "\\.fvwm2rc\\'")
nil
- "Generic mode for FVWM configuration files."))
+ "Generic mode for FVWM configuration files.")
;;; X Resource
;; I'm pretty sure I've seen an actual mode to do this, but I don't
;; think it's standard with Emacs
-(when (memq 'x-resource-generic-mode generic-extras-enable-list)
-
(define-generic-mode x-resource-generic-mode
'(?!)
nil
'(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face))
'("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'")
nil
- "Generic mode for X Resource configuration files."))
+ "Generic mode for X Resource configuration files.")
-(if (memq 'xmodmap-generic-mode generic-extras-enable-list)
(define-generic-mode xmodmap-generic-mode
'(?!)
'("add" "clear" "keycode" "keysym" "remove" "pointer")
nil
'("[xX]modmap\\(rc\\)?\\'")
nil
- "Simple mode for xmodmap files."))
+ "Simple mode for xmodmap files.")
;;; Hosts
-(when (memq 'hosts-generic-mode generic-extras-enable-list)
-
(define-generic-mode hosts-generic-mode
'(?#)
'("localhost")
@@ -364,27 +261,20 @@ your changes into effect."
("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face))
'("[hH][oO][sS][tT][sS]\\'")
nil
- "Generic mode for HOSTS files."))
+ "Generic mode for HOSTS files.")
;;; Windows INF files
-;; If i-g-m-f-f-h is defined, then so is i-g-m.
-(declare-function ini-generic-mode "generic-x")
-
-(when (memq 'inf-generic-mode generic-extras-enable-list)
-
(define-generic-mode inf-generic-mode
'(?\;)
nil
'(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face))
'("\\.[iI][nN][fF]\\'")
'(generic-bracket-support)
- "Generic mode for MS-Windows INF files."))
+ "Generic mode for MS-Windows INF files.")
;;; Windows INI files
;; Should define escape character as well!
-(when (memq 'ini-generic-mode generic-extras-enable-list)
-
(define-generic-mode ini-generic-mode
'(?\;)
nil
@@ -411,13 +301,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(goto-char (point-min))
(and (looking-at "^\\s-*\\[.*\\]")
(ini-generic-mode)))))
-(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
- 'ini-generic-mode-find-file-hook "28.1"))
;;; Windows REG files
;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax!
-(when (memq 'reg-generic-mode generic-extras-enable-list)
-
(define-generic-mode reg-generic-mode
'(?\;)
'("key" "classes_root" "REGEDIT" "REGEDIT4")
@@ -428,19 +314,11 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
- "Generic mode for MS-Windows Registry files."))
-
-(declare-function w32-shell-name "w32-fns" ())
-
-;;; DOS/Windows BAT files
-(when (memq 'bat-generic-mode generic-extras-enable-list)
- (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4"))
+ "Generic mode for MS-Windows Registry files.")
;;; Mailagent
;; Mailagent is a Unix mail filtering program. Anyone wanna do a
;; generic mode for procmail?
-(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list)
-
(define-generic-mode mailagent-rules-generic-mode
'(?#)
'("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT")
@@ -451,11 +329,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
- "Generic mode for Mailagent rules files."))
+ "Generic mode for Mailagent rules files.")
;; Solaris/Sys V prototype files
-(when (memq 'prototype-generic-mode generic-extras-enable-list)
-
(define-generic-mode prototype-generic-mode
'(?#)
nil
@@ -474,11 +350,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("prototype\\'")
nil
- "Generic mode for Sys V prototype files."))
+ "Generic mode for Sys V prototype files.")
;; Solaris/Sys V pkginfo files
-(when (memq 'pkginfo-generic-mode generic-extras-enable-list)
-
(define-generic-mode pkginfo-generic-mode
'(?#)
nil
@@ -487,17 +361,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("pkginfo\\'")
nil
- "Generic mode for Sys V pkginfo files."))
-
-;; Javascript mode
-;; Obsolete; defer to js-mode from js.el.
-(when (memq 'javascript-generic-mode generic-extras-enable-list)
- (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3")
- (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3"))
+ "Generic mode for Sys V pkginfo files.")
;; VRML files
-(when (memq 'vrml-generic-mode generic-extras-enable-list)
-
(define-generic-mode vrml-generic-mode
'(?#)
'("DEF"
@@ -545,11 +411,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1)))))
- "Generic Mode for VRML files."))
+ "Generic Mode for VRML files.")
;; Java Manifests
-(when (memq 'java-manifest-generic-mode generic-extras-enable-list)
-
(define-generic-mode java-manifest-generic-mode
'(?#)
'("Name"
@@ -566,11 +430,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-constant-face)))
'("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'")
nil
- "Generic mode for Java Manifest files."))
+ "Generic mode for Java Manifest files.")
;; Java properties files
-(when (memq 'java-properties-generic-mode generic-extras-enable-list)
-
(define-generic-mode java-properties-generic-mode
'(?! ?#)
nil
@@ -596,11 +458,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
- "Generic mode for Java properties files."))
+ "Generic mode for Java properties files.")
;; C shell alias definitions
-(when (memq 'alias-generic-mode generic-extras-enable-list)
-
(define-generic-mode alias-generic-mode
'(?#)
'("alias" "unalias")
@@ -613,11 +473,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
- "Generic mode for C Shell alias files."))
+ "Generic mode for C Shell alias files.")
;; Ansible inventory files
-(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list)
-
(define-generic-mode ansible-inventory-generic-mode
'(?#)
nil
@@ -636,12 +494,10 @@ like an INI file. You can add this hook to
`find-file-hook'."
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
- "Generic mode for Ansible inventory files."))
+ "Generic mode for Ansible inventory files.")
;;; Windows RC files
;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira)
-(when (memq 'rc-generic-mode generic-extras-enable-list)
-
(define-generic-mode rc-generic-mode
;; '(?\/)
'("//")
@@ -721,15 +577,13 @@ like an INI file. You can add this hook to
`find-file-hook'."
'("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
(1 font-lock-constant-face)
(2 font-lock-variable-name-face nil t))))
- '("\\.[rR][cC]\\'")
- nil
- "Generic mode for MS-Windows Resource files."))
+ '("\\.[rR][cC]\\'")
+ nil
+ "Generic mode for MS-Windows Resource files.")
;; InstallShield RUL files
;; Contributed by Alfred.Correira@Pervasive.Com
;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com>
-(when (memq 'rul-generic-mode generic-extras-enable-list)
-
(eval-when-compile
;;; build the regexp strings using regexp-opt
@@ -1372,11 +1226,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
> "begin" \n
> _ \n
resume:
- > "end;"))
+ > "end;")
;; Additions by ACorreir@pervasive-sw.com (Alfred Correira)
-(when (memq 'mailrc-generic-mode generic-extras-enable-list)
-
(define-generic-mode mailrc-generic-mode
'(?#)
'("alias"
@@ -1398,11 +1250,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.mailrc\\'")
nil
- "Mode for mailrc files."))
+ "Mode for mailrc files.")
;; Inetd.conf
-(when (memq 'inetd-conf-generic-mode generic-extras-enable-list)
-
(define-generic-mode inetd-conf-generic-mode
'(?#)
'("stream"
@@ -1417,11 +1267,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
;; Services
-(when (memq 'etc-services-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-services-generic-mode
'(?#)
'("tcp"
@@ -1434,11 +1282,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))
;; Password and Group files
-(when (memq 'etc-passwd-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-passwd-generic-mode
nil ;; No comment characters
'("root") ;; Only one keyword
@@ -1476,11 +1322,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
+ '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))
;; Fstab
-(when (memq 'etc-fstab-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-fstab-generic-mode
'(?#)
'("adfs"
@@ -1592,11 +1436,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
(list
(lambda ()
(setq imenu-generic-expression
- '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
+ '((nil "^\\([^# \t]+\\)\\s-+" 1))))))
;; /etc/sudoers
-(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list)
-
(define-generic-mode etc-sudoers-generic-mode
'(?#)
'("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias"
@@ -1607,11 +1449,9 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face))
'("/etc/sudoers\\'")
nil
- "Generic mode for sudoers configuration files."))
+ "Generic mode for sudoers configuration files.")
;; From Jacques Duthen <jacques.duthen@sncf.fr>
-(when (memq 'show-tabs-generic-mode generic-extras-enable-list)
-
(eval-when-compile
(defconst show-tabs-generic-mode-font-lock-defaults-1
@@ -1649,14 +1489,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
nil ;; no auto-mode-alist
;; '(show-tabs-generic-mode-hook-fun)
nil
- "Generic mode to show tabs and trailing spaces."))
+ "Generic mode to show tabs and trailing spaces.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DNS modes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(when (memq 'named-boot-generic-mode generic-extras-enable-list)
-
(define-generic-mode named-boot-generic-mode
;; List of comment characters
'(?\;)
@@ -1672,9 +1510,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/named\\.boot\\'")
;; List of set up functions to call
- nil))
-
-(when (memq 'named-database-generic-mode generic-extras-enable-list)
+ nil)
(define-generic-mode named-database-generic-mode
;; List of comment characters
@@ -1695,9 +1531,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
(defun named-database-print-serial ()
"Print a serial number based on the current date."
(interactive)
- (insert (format-time-string named-database-time-string))))
-
-(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
+ (insert (format-time-string named-database-time-string)))
(define-generic-mode resolve-conf-generic-mode
;; List of comment characters
@@ -1709,14 +1543,12 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional auto-mode-alist expressions
'("/etc/resolve?\\.conf\\'")
;; List of set up functions to call
- nil))
+ nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Modes for spice and common electrical engineering circuit netlist formats
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(when (memq 'spice-generic-mode generic-extras-enable-list)
-
(define-generic-mode spice-generic-mode
nil
'("and"
@@ -1752,9 +1584,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for SPICE circuit netlist files."))
-
-(when (memq 'ibis-generic-mode generic-extras-enable-list)
+ "Generic mode for SPICE circuit netlist files.")
(define-generic-mode ibis-generic-mode
'(?|)
@@ -1763,9 +1593,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[iI][bB][sS]\\'")
'(generic-bracket-support)
- "Generic mode for IBIS circuit netlist files."))
-
-(when (memq 'astap-generic-mode generic-extras-enable-list)
+ "Generic mode for IBIS circuit netlist files.")
(define-generic-mode astap-generic-mode
nil
@@ -1799,9 +1627,7 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; Make keywords case-insensitive
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
- "Generic mode for ASTAP circuit netlist files."))
-
-(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)
+ "Generic mode for ASTAP circuit netlist files.")
(define-generic-mode etc-modules-conf-generic-mode
;; List of comment characters
@@ -1843,7 +1669,98 @@ like an INI file. You can add this hook to
`find-file-hook'."
;; List of additional automode-alist expressions
'("/etc/modules\\.conf" "/etc/conf\\.modules")
;; List of set up functions to call
- nil))
+ nil)
+
+;; Obsolete
+
+(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3")
+(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook
"24.3")
+
+(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4")
+
+(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook
+ #'ini-generic-mode-find-file-hook "28.1")
+
+(defconst generic-default-modes
+ '(apache-conf-generic-mode
+ apache-log-generic-mode
+ hosts-generic-mode
+ java-manifest-generic-mode
+ java-properties-generic-mode
+ javascript-generic-mode
+ show-tabs-generic-mode
+ vrml-generic-mode)
+ "List of generic modes that are defined by default.")
+(make-obsolete-variable 'generic-default-modes "no longer used." "28.1")
+
+(defconst generic-mswindows-modes
+ '(bat-generic-mode
+ inf-generic-mode
+ ini-generic-mode
+ rc-generic-mode
+ reg-generic-mode
+ rul-generic-mode)
+ "List of generic modes that are defined by default on MS-Windows.")
+(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1")
+
+(defconst generic-unix-modes
+ '(alias-generic-mode
+ ansible-inventory-generic-mode
+ etc-fstab-generic-mode
+ etc-modules-conf-generic-mode
+ etc-passwd-generic-mode
+ etc-services-generic-mode
+ etc-sudoers-generic-mode
+ fvwm-generic-mode
+ inetd-conf-generic-mode
+ mailagent-rules-generic-mode
+ mailrc-generic-mode
+ named-boot-generic-mode
+ named-database-generic-mode
+ prototype-generic-mode
+ resolve-conf-generic-mode
+ samba-generic-mode
+ x-resource-generic-mode
+ xmodmap-generic-mode)
+ "List of generic modes that are defined by default on Unix.")
+(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1")
+
+(defconst generic-other-modes
+ '(astap-generic-mode
+ ibis-generic-mode
+ pkginfo-generic-mode
+ spice-generic-mode)
+ "List of generic modes that are not defined by default.")
+(make-obsolete-variable 'generic-other-modes "no longer used." "28.1")
+
+(defcustom generic-extras-enable-list
+ (append generic-default-modes
+ (if (memq system-type '(windows-nt ms-dos))
+ generic-mswindows-modes
+ generic-unix-modes)
+ nil)
+ "List of generic modes to define.
+Each entry in the list should be a symbol. If you set this variable
+directly, without using customize, you must reload generic-x to put
+your changes into effect."
+ :type (let (list)
+ (dolist (mode
+ (sort (append generic-default-modes
+ generic-mswindows-modes
+ generic-unix-modes
+ generic-other-modes
+ nil)
+ (lambda (a b)
+ (string< (symbol-name b)
+ (symbol-name a))))
+ (cons 'set list))
+ (push `(const ,mode) list)))
+ :set (lambda (s v)
+ (set-default s v)
+ (unless load-in-progress
+ (load "generic-x")))
+ :version "22.1")
+(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1")
(provide 'generic-x)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7ded9e4..c9afa3a 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4325,10 +4325,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(if (gnus-buffer-live-p gnus-original-article-buffer)
(canlock-verify gnus-original-article-buffer)))
-(defmacro gnus--\,@ (exp)
- (declare (debug t))
- `(progn ,@(eval exp t)))
-
(gnus--\,@
(mapcar (lambda (func)
`(defun ,(intern (format "gnus-%s" func))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index e7d1cf8..3253b78 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -627,7 +627,14 @@ articles in the topic and its subtopics."
(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
&optional unread)
+ (gnus--\,@
+ (let ((vars '(indentation visible name level number-of-groups
+ total-number-of-articles entries)))
+ `((with-suppressed-warnings ((lexical ,@vars))
+ ,@(mapcar (lambda (s) `(defvar ,s)) vars)))))
(let* ((visible (if visiblep "" "..."))
+ (level level)
+ (name name)
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(total-number-of-articles unread)
(number-of-groups (length entries))
@@ -640,14 +647,7 @@ articles in the topic and its subtopics."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec
- `((indentation . ,indentation)
- (visible . ,visible)
- (name . ,name)
- (level . ,level)
- (number-of-groups . ,number-of-groups)
- (total-number-of-articles . ,total-number-of-articles)
- (entries . ,entries))))
+ (eval gnus-topic-line-format-spec t))
(list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-unread unread
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 3c7c948..f80243c 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1068,6 +1068,11 @@ ARG is passed to the first function."
;;; Various
+(defmacro gnus--\,@ (exp)
+ "Splice EXP's value (a list of Lisp forms) into the code."
+ (declare (debug t))
+ `(progn ,@(eval exp t)))
+
(defvar gnus-group-buffer) ; Compiler directive
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 98664ac..7b94c64 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3212,9 +3212,9 @@ that that variable is buffer-local to the summary
buffers."
(format "%s" (car method))
(format "%s:%s" (car method) (cadr method))))
(name-method (cons name method)))
- (when (and (not no-enter-cache)
- (not (member name-method gnus-server-method-cache))
- (not (assoc (car name-method) gnus-server-method-cache)))
+ (unless (or no-enter-cache
+ (member name-method gnus-server-method-cache)
+ (assoc (car name-method) gnus-server-method-cache))
(push name-method gnus-server-method-cache))
name)))
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 9bce419..c643f66 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -265,7 +265,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
-(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x2975)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5dc3de4..e4bdf50 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3077,12 +3077,47 @@ on encoding."
(puthash "BELL (BEL)" ?\a names)
(setq ucs-names names))))
+(defun mule--ucs-names-sort-by-code (names)
+ (let ((codes-and-names
+ (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)))
+ (mapcar #'cdr (sort codes-and-names #'car-less-than-car))))
+
(defun mule--ucs-names-affixation (names)
(mapcar (lambda (name)
(let ((char (gethash name ucs-names)))
- (list name (concat (if char (format "%c" char) " ") "\t") "")))
+ (list name (concat (if char (list char) " ") "\t") "")))
names))
+(defun mule--ucs-names-group (names)
+ (let* ((codes-and-names
+ (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))
+ (grouped
+ (seq-group-by
+ (lambda (code-name)
+ (let ((script (aref char-script-table (car code-name))))
+ (if script (symbol-name script) "ungrouped")))
+ codes-and-names))
+ names-with-header header)
+ (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b)))))
+ (setq header t)
+ (dolist (code-name (cdr group))
+ (push (list
+ (cdr code-name)
+ (concat
+ (if header
+ (progn
+ (setq header nil)
+ (concat "\n" (propertize
+ (format "* %s\n" (car group))
+ 'face 'header-line)))
+ "")
+ ;; prefix
+ (if (car code-name) (format "%c" (car code-name)) " ") "\t")
+ ;; suffix
+ "")
+ names-with-header)))
+ (nreverse names-with-header)))
+
(defun char-from-name (string &optional ignore-case)
"Return a character as a number from its Unicode name STRING.
If optional IGNORE-CASE is non-nil, ignore case in STRING.
@@ -3104,6 +3139,23 @@ Return nil if STRING does not name a character."
ignore-case))
code)))))))
+(defcustom read-char-by-name-sort nil
+ "How to sort characters for `read-char-by-name' completion.
+Defines the sorting order either by character names or their codepoints."
+ :type '(choice
+ (const :tag "Sort by character names" nil)
+ (const :tag "Sort by character codepoints" code))
+ :group 'mule
+ :version "28.1")
+
+(defcustom read-char-by-name-group nil
+ "How to group characters for `read-char-by-name' completion.
+When t, split characters to sections of Unicode blocks
+sorted alphabetically."
+ :type 'boolean
+ :group 'mule
+ :version "28.1")
+
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
@@ -3117,6 +3169,9 @@ preceded by an asterisk `*' and use completion, it will
show all
the characters whose names include that substring, not necessarily
at the beginning of the name.
+The options `read-char-by-name-sort' and `read-char-by-name-group'
+define the sorting order of completion characters and how to group them.
+
Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
number like \"2A10\", or a number in hash notation (e.g.,
\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for
@@ -3130,8 +3185,14 @@ as names, not numbers."
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata
- (affixation-function . mule--ucs-names-affixation)
+ `(metadata
+ (display-sort-function
+ . ,(when (eq read-char-by-name-sort 'code)
+ #'mule--ucs-names-sort-by-code))
+ (affixation-function
+ . ,(if read-char-by-name-group
+ #'mule--ucs-names-group
+ #'mule--ucs-names-affixation))
(category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 2fdfcc8..133df65 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -636,9 +636,9 @@ Do the same for the keys of the same name."
:help "Customize value of specific option"))
(bindings--define-key menu [separator-2]
menu-bar-separator)
- (bindings--define-key menu [customize-changed-options]
- '(menu-item "New Options..." customize-changed-options
- :help "Options added or changed in recent Emacs versions"))
+ (bindings--define-key menu [customize-changed]
+ '(menu-item "New Options..." customize-changed
+ :help "Options and faces added or changed in recent Emacs
versions"))
(bindings--define-key menu [customize-saved]
'(menu-item "Saved Options" customize-saved
:help "Customize previously saved options"))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 03cc70c..a899a94 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2116,13 +2116,15 @@ variables.")
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
+ (when (or
+ (innermost-minibuffer-p)
+ (not (minibufferp)))
;; If the command that uses this has made modifications in the minibuffer,
;; we don't want them to cause deactivation of the mark in the original
;; buffer.
;; A better solution would be to make deactivate-mark buffer-local
;; (or to turn it into a list of buffers, ...), but in the mean time,
;; this should do the trick in most cases.
- (when (innermost-minibuffer-p)
(setq deactivate-mark nil)
(throw 'exit nil))
(error "%s" "Not in most nested minibuffer"))
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index ccc24cb..6f08605 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -160,6 +160,18 @@ by the choice value:
:type 'boolean
:version "28.1")
+(defcustom dictionary-link-dictionary
+ "*"
+ "The dictionary which is used in links.
+* means to create links that search all dictionaries,
+nil means to create links that search only in the same dictionary
+where the current word was found."
+ :group 'dictionary
+ :type '(choice (const :tag "Link to all dictionaries" "*")
+ (const :tag "Link only to the same dictionary" nil)
+ (string :tag "User choice"))
+ :version "28.1")
+
(defcustom dictionary-mode-hook
nil
"Hook run in dictionary mode buffers."
@@ -167,6 +179,13 @@ by the choice value:
:type 'hook
:version "28.1")
+(defcustom dictionary-post-buffer-hook
+ nil
+ "Hook run at the end of every update of the dictionary buffer."
+ :group 'dictionary
+ :type 'hook
+ :version "28.1")
+
(defcustom dictionary-use-http-proxy
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
@@ -323,8 +342,9 @@ is utf-8"
(define-key map "l" 'dictionary-previous)
(define-key map "n" 'forward-button)
(define-key map "p" 'backward-button)
- (define-key map " " 'scroll-up)
- (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
+ (define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-command)
+ (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command)
map)
"Keymap for the dictionary mode.")
@@ -772,7 +792,8 @@ of matching words."
(goto-char dictionary-marker)
(set-buffer-modified-p nil)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (run-hooks 'dictionary-post-buffer-hook))
(defun dictionary-display-search-result (reply)
"Start displaying the result in REPLY."
@@ -842,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given
as argument."
(setq word (replace-match " " t t word)))
(while (string-match "[*\"]" word)
(setq word (replace-match "" t t word)))
+ (when dictionary-link-dictionary
+ (setq dictionary dictionary-link-dictionary))
(unless (equal word displayed-word)
(make-button start end :type 'dictionary-link
@@ -1117,9 +1140,11 @@ If PATTERN is omitted, it defaults to \"[
\\f\\t\\n\\r\\v]+\"."
;; - if region is active returns its contents
;; - otherwise return the word near the point
(defun dictionary-search-default ()
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning) (region-end))
- (current-word t)))
+ (cond
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ ((car (get-char-property (point) 'data)))
+ (t (current-word t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User callable commands
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 0476835..7997bf3 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
-;;; ldap.el --- client interface to LDAP for Emacs
+;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -418,12 +418,12 @@ RFC2798 Section 9.1.1")
(encode-coding-string str ldap-coding-system))
(defun ldap-decode-address (str)
- (mapconcat 'ldap-decode-string
+ (mapconcat #'ldap-decode-string
(split-string str "\\$")
"\n"))
(defun ldap-encode-address (str)
- (mapconcat 'ldap-encode-string
+ (mapconcat #'ldap-encode-string
(split-string str "\n")
"$"))
@@ -601,7 +601,7 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result proc)
+ arglist dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
@@ -671,7 +671,7 @@ an alist of attribute/value pairs."
" bind distinguished name (binddn)"))
(error "Failed ldapsearch invocation: %s \"%s\""
ldap-ldapsearch-prog
- (mapconcat 'identity proc-args "\" \""))))))
+ (mapconcat #'identity proc-args "\" \""))))))
(apply #'call-process ldap-ldapsearch-prog
;; Ignore stderr, which can corrupt results
nil (list buf nil) nil
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 08edb44..024d118 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,4 +1,4 @@
-;;; mairix.el --- Mairix interface for Emacs
+;;; mairix.el --- Mairix interface for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -83,55 +83,46 @@
(defcustom mairix-file-path "~/"
"Path where output files produced by Mairix should be stored."
- :type 'directory
- :group 'mairix)
+ :type 'directory)
(defcustom mairix-search-file "mairixsearch.mbox"
"Name of the default file for storing the searches.
Note that this will be prefixed by `mairix-file-path'."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-command "mairix"
"Command for calling mairix.
You can add further options here if you want to, but better use
`mairix-update-options' instead."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-output-buffer "*mairix output*"
"Name of the buffer for the output of the mairix binary."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-customize-query-buffer "*mairix query*"
"Name of the buffer for customizing a search query."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-saved-searches-buffer "*mairix searches*"
"Name of the buffer for displaying saved searches."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
The default is \"-F\" and \"-Q\" for making updates faster. You
should call mairix without these options from time to
time (e.g. via cron job)."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-search-options '("-Q")
"Options when calling mairix for searching.
The default is \"-Q\" for making searching faster."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-synchronous-update nil
"Defines if Emacs should wait for the mairix database update."
- :type 'boolean
- :group 'mairix)
+ :type 'boolean)
(defcustom mairix-saved-searches nil
"Saved mairix searches.
@@ -144,8 +135,7 @@ threads (nil or t). Note that the file will be prefixed by
(choice :tag "File"
(const :tag "default")
file)
- (boolean :tag "Threads")))
- :group 'mairix)
+ (boolean :tag "Threads"))))
(defcustom mairix-mail-program 'rmail
"Mail program used to display search results.
@@ -153,8 +143,7 @@ Currently RMail, Gnus (mbox), and VM are supported. If you
use Gnus
with maildir, use nnmairix.el instead."
:type '(choice (const :tag "RMail" rmail)
(const :tag "Gnus mbox" gnus)
- (const :tag "VM" vm))
- :group 'mairix)
+ (const :tag "VM" vm)))
(defcustom mairix-display-functions
'((rmail mairix-rmail-display)
@@ -166,8 +155,7 @@ This is an alist where each entry consists of a symbol from
displaying the search results. The function will be called with
the mailbox file produced by mairix as the single argument."
:type '(repeat (list (symbol :tag "Mail program")
- (function)))
- :group 'mairix)
+ (function))))
(defcustom mairix-get-mail-header-functions
'((rmail mairix-rmail-fetch-field)
@@ -184,15 +172,13 @@ won't work."
:type '(repeat (list (symbol :tag "Mail program")
(choice :tag "Header function"
(const :tag "none")
- function)))
- :group 'mairix)
+ function))))
(defcustom mairix-widget-select-window-function
(lambda () (select-window (get-largest-window)))
"Function for selecting the window for customizing the mairix query.
The default chooses the largest window in the current frame."
- :type 'function
- :group 'mairix)
+ :type 'function)
;; Other variables
@@ -466,18 +452,18 @@ MVALUES may contain values from current article."
;; generate Buttons
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-send-query mairix-widgets))
"Send Query")
(widget-insert " ")
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-save-search mairix-widgets))
"Save search")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(kill-buffer mairix-customize-query-buffer))
"Cancel")
(use-local-map widget-keymap)
@@ -502,7 +488,7 @@ Mairix will be called asynchronously unless
(cdr commandsplit)
mairix-update-options))
(setq args (append args mairix-update-options)))
- (apply 'call-process args))
+ (apply #'call-process args))
(progn
(message "Updating mairix database...")
(setq args (append (list "mairixupdate" (get-buffer-create
mairix-output-buffer)
@@ -511,8 +497,8 @@ Mairix will be called asynchronously unless
(setq args (append args (cdr commandsplit) mairix-update-options))
(setq args (append args mairix-update-options)))
(set-process-sentinel
- (apply 'start-process args)
- 'mairix-sentinel-mairix-update-finished)))))
+ (apply #'start-process args)
+ #'mairix-sentinel-mairix-update-finished)))))
;;;; Helper functions
@@ -557,7 +543,7 @@ whole threads. Function returns t if messages were found."
mairix-file-path))
file))
(setq rval
- (apply 'call-process
+ (apply #'call-process
(append args (list "-o" file) query)))
(if (zerop rval)
(with-current-buffer mairix-output-buffer
@@ -582,7 +568,7 @@ whole threads. Function returns t if messages were found."
(setq header (replace-match "," t t header)))
header))
-(defun mairix-sentinel-mairix-update-finished (proc status)
+(defun mairix-sentinel-mairix-update-finished (_proc status)
"Sentinel for mairix update process PROC with STATUS."
(if (equal status "finished\n")
(message "Updating mairix database... done")
@@ -642,51 +628,50 @@ See %s for details" mairix-output-buffer)))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
;; return query string
- (mapconcat 'identity query " ")))
+ (mapconcat #'identity query " ")))
(defun mairix-widget-create-query (&optional values)
"Create widgets for creating mairix queries.
Fill in VALUES if based on an article."
- (let (allwidgets)
- (when (get-buffer mairix-customize-query-buffer)
- (kill-buffer mairix-customize-query-buffer))
- (switch-to-buffer mairix-customize-query-buffer)
- (kill-all-local-variables)
- (erase-buffer)
- (widget-insert
- "Specify your query for Mairix using check boxes for activating
fields.\n\n")
- (widget-insert
- (concat "Use ~word to match messages "
- (propertize "not" 'face 'italic)
- " containing the word)\n"
- " substring= to match words containing the substring\n"
- " substring=N to match words containing the substring,
allowing\n"
- " up to N errors(missing/extra/different
letters)\n"
- " ^substring= to match the substring at the beginning of a
word.\n"))
- (widget-insert
- (format-message
- "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
- (setq mairix-widgets (mairix-widget-build-editable-fields values))
- (when (member 'flags mairix-widget-other)
- (widget-insert "\nFlags:\n Seen: ")
- (mairix-widget-add "seen"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Replied: ")
- (mairix-widget-add "replied"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Ticked: ")
- (mairix-widget-add "flagged"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore")))
- (when (member 'threads mairix-widget-other)
- (widget-insert "\n")
- (mairix-widget-add "Threads" 'checkbox nil))
- (widget-insert " Show full threads\n\n")))
+ (when (get-buffer mairix-customize-query-buffer)
+ (kill-buffer mairix-customize-query-buffer))
+ (switch-to-buffer mairix-customize-query-buffer)
+ (kill-all-local-variables)
+ (erase-buffer)
+ (widget-insert
+ "Specify your query for Mairix using check boxes for activating
fields.\n\n")
+ (widget-insert
+ (concat "Use ~word to match messages "
+ (propertize "not" 'face 'italic)
+ " containing the word)\n"
+ " substring= to match words containing the substring\n"
+ " substring=N to match words containing the substring,
allowing\n"
+ " up to N errors(missing/extra/different letters)\n"
+ " ^substring= to match the substring at the beginning of a
word.\n"))
+ (widget-insert
+ (format-message
+ "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
+ (setq mairix-widgets (mairix-widget-build-editable-fields values))
+ (when (member 'flags mairix-widget-other)
+ (widget-insert "\nFlags:\n Seen: ")
+ (mairix-widget-add "seen"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Replied: ")
+ (mairix-widget-add "replied"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Ticked: ")
+ (mairix-widget-add "flagged"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore")))
+ (when (member 'threads mairix-widget-other)
+ (widget-insert "\n")
+ (mairix-widget-add "Threads" 'checkbox nil))
+ (widget-insert " Show full threads\n\n"))
(defun mairix-widget-build-editable-fields (values)
"Build editable field widgets in `nnmairix-widget-fields-list'.
@@ -703,7 +688,7 @@ VALUES may contain values for editable fields from current
article."
(concat "c" field)
(widget-create 'checkbox
:tag field
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(mairix-widget-toggle-activate widget))
nil)))
(list
@@ -727,7 +712,7 @@ VALUES may contain values for editable fields from current
article."
"Add a widget NAME with optional ARGS."
(push
(list name
- (apply 'widget-create args))
+ (apply #'widget-create args))
mairix-widgets))
(defun mairix-widget-toggle-activate (widget)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 7effb27..b648ecf 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -135,11 +135,8 @@
"A regexp of names to be disregarded during directory completion."
:type '(choice regexp (const :tag "None" nil)))
-(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
- ;; FIXME: the doc mentions file-name completion, but the code
- ;; seems to apply it to all completions.
- "If non-nil, ignore case when doing filename completion."
- :type 'boolean)
+(define-obsolete-variable-alias 'pcomplete-ignore-case 'completion-ignore-case
+ "28.1")
(defcustom pcomplete-autolist nil
"If non-nil, automatically list possibilities on partial completion.
@@ -472,7 +469,7 @@ Same as `pcomplete' but using the standard completion UI."
(not (member
(funcall norm-func (directory-file-name f))
seen)))))))
- (when pcomplete-ignore-case
+ (when completion-ignore-case
(setq table (completion-table-case-fold table)))
(list beg (point) table
:predicate pred
@@ -865,7 +862,7 @@ this is `comint-dynamic-complete-functions'."
(sort comps pcomplete-compare-entry-function)))
,@(cdr (completion-file-name-table s p a)))
(let ((completion-ignored-extensions nil)
- (completion-ignore-case pcomplete-ignore-case))
+ (completion-ignore-case completion-ignore-case))
(completion-table-with-predicate
#'comint-completion-file-name-table pred 'strict s p a))))))
@@ -1116,7 +1113,7 @@ Typing SPC flushes the help buffer."
"Insert a completion entry at point.
Returns non-nil if a space was appended at the end."
(let ((here (point)))
- (if (not pcomplete-ignore-case)
+ (if (not completion-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
(comint-quote-filename
@@ -1194,7 +1191,7 @@ Returns `partial' if completed as far as possible with
the matches.
Returns `listed' if a completion listing was shown.
See also `pcomplete-filename'."
- (let* ((completion-ignore-case pcomplete-ignore-case)
+ (let* ((completion-ignore-case completion-ignore-case)
(completions (all-completions stub candidates))
(entry (try-completion stub candidates))
result)
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 05e61df..891a5f6 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,4 +1,4 @@
-;;; 5x5.el --- simple little puzzle game
+;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -289,7 +289,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-draw-grid-end ()
"Draw the top/bottom of the grid."
(insert "+")
- (dotimes (x 5x5-grid-size)
+ (dotimes (_ 5x5-grid-size)
(insert "-" (make-string 5x5-x-scale ?-)))
(insert "-+ "))
@@ -297,11 +297,11 @@ Quit current game \\[5x5-quit-game]"
"Draw the grids GRIDS into the current buffer."
(let ((inhibit-read-only t) grid-org)
(erase-buffer)
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_ grids) (5x5-draw-grid-end))
(insert "\n")
(setq grid-org (point))
(dotimes (y 5x5-grid-size)
- (dotimes (lines 5x5-y-scale)
+ (dotimes (_lines 5x5-y-scale)
(dolist (grid grids)
(dotimes (x 5x5-grid-size)
(insert (if (zerop x) "| " " ")
@@ -331,7 +331,7 @@ Quit current game \\[5x5-quit-game]"
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_grid grids) (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids))
5x5-moves))))
@@ -475,11 +475,11 @@ position."
"Convert a grid matrix GRID-MATRIX in Calc format to a grid in
5x5 format. See function `5x5-grid-to-vec'."
(apply
- 'vector
+ #'vector
(mapcar
(lambda (x)
(apply
- 'vector
+ #'vector
(mapcar
(lambda (y) (/= (cadr y) 0))
(cdr x))))
@@ -503,7 +503,9 @@ position."
Log a matrix VALUE of (mod B 2) forms, only B is output and
Scilab matrix notation is used. VALUE is returned so that it is
easy to log a value with minimal rewrite of code."
- (when (buffer-live-p 5x5-log-buffer)
+ (when (buffer-live-p 5x5-log-buffer)
+ (defvar calc-matrix-brackets)
+ (defvar calc-vector-commas)
(let* ((unpacked-value
(math-map-vec
(lambda (row) (math-map-vec 'cadr row))
@@ -515,7 +517,7 @@ easy to log a value with minimal rewrite of code."
(insert name ?= value-to-log ?\n))))
value))
(defsubst 5x5-log-init ())
- (defsubst 5x5-log (name value) value)))
+ (defsubst 5x5-log (_name value) value)))
(declare-function math-map-vec "calc-vec" (f a))
(declare-function math-sub "calc" (a b))
@@ -533,6 +535,10 @@ easy to log a value with minimal rewrite of code."
(declare-function calcFunc-mcol "calc-vec" (mat n))
(declare-function calcFunc-vconcat "calc-vec" (a b))
(declare-function calcFunc-index "calc-vec" (n &optional start incr))
+(defvar calc-word-size)
+(defvar calc-leading-zeros)
+(defvar calc-number-radix)
+(defvar calc-command-flags)
(defun 5x5-solver (grid)
"Return a list of solutions for GRID.
@@ -671,16 +677,16 @@ Solutions are sorted from least to greatest Hamming
weight."
(5x5-log
"cb"
(math-mul inv-base-change targetv))); CB
- (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
+ ;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
(row-2 (math-make-intv 1 transferm-kernel-size
grid-size-squared)); 3..25
(col-1 (math-make-intv 3 1 (- grid-size-squared
transferm-kernel-size))); 1..23
- (col-2 (math-make-intv 1 (- grid-size-squared
- transferm-kernel-size)
- grid-size-squared)); 24..25
- (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
- (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
+ ;; (col-2 (math-make-intv 1 (- grid-size-squared
+ ;; transferm-kernel-size)
+ ;; grid-size-squared)) ; 24..25
+ ;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
+ ;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
;; and ctransferm-2-2 = 0.
@@ -696,8 +702,8 @@ Solutions are sorted from least to greatest Hamming weight."
;;
;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
- (ctarget-1 (calcFunc-mrow ctarget row-1))
- (ctarget-2 (calcFunc-mrow ctarget row-2))
+ ;; (ctarget-1 (calcFunc-mrow ctarget row-1))
+ (ctarget-2 (calcFunc-mrow ctarget row-2))
;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
;; + ctransferm-1-2(2x2) *cx-2(2x1);
@@ -770,7 +776,7 @@ Solutions are sorted from least to greatest Hamming weight."
(message "5x5 Solution computation done.")
solution-list)))
-(defun 5x5-solve-suggest (&optional n)
+(defun 5x5-solve-suggest (&optional _n)
"Suggest to the user where to click.
Argument N is ignored."
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index e3854b5..61b0878 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,4 +1,4 @@
-;;; blackbox.el --- blackbox game in Emacs Lisp
+;;; blackbox.el --- blackbox game in Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 5255d81..be35daf 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,4 +1,4 @@
-;;; cookie1.el --- retrieve random phrases from fortune cookie files
+;;; cookie1.el --- retrieve random phrases from fortune cookie files -*-
lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -177,11 +177,12 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie."
"Randomly permute the elements of VECTOR (all permutations equally likely)."
(let ((len (length vector))
j temp)
- (dotimes (i len vector)
+ (dotimes (i len)
(setq j (+ i (random (- len i)))
temp (aref vector i))
(aset vector i (aref vector j))
- (aset vector j temp))))
+ (aset vector j temp))
+ vector))
(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4")
@@ -204,9 +205,10 @@ If called interactively, or if DISPLAY is non-nil, display
a list of matches."
(cookie-table-symbol (intern phrase-file cookie-cache))
(string-table (symbol-value cookie-table-symbol))
(matches nil))
- (and (dotimes (i (length string-table) matches)
- (and (string-match-p regexp (aref string-table i))
- (setq matches (cons (aref string-table i) matches))))
+ (dotimes (i (length string-table))
+ (and (string-match-p regexp (aref string-table i))
+ (setq matches (cons (aref string-table i) matches))))
+ (and matches
(setq matches (sort matches 'string-lessp)))
(and display
(if matches
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index 028f04c..46fd852 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,4 +1,4 @@
-;;; doctor.el --- psychological help for frustrated users
+;;; doctor.el --- psychological help for frustrated users -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software
;; Foundation, Inc.
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 1c2c24a..c6aef02 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,4 +1,4 @@
-;;; gametree.el --- manage game analysis trees in Emacs
+;;; gametree.el --- manage game analysis trees in Emacs -*- lexical-binding:
t -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index f6e5fcd..ac28fba 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -1,4 +1,4 @@
-;;; hanoi.el --- towers of hanoi in Emacs
+;;; hanoi.el --- towers of hanoi in Emacs -*- lexical-binding: t -*-
;; Author: Damon Anton Permezel
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 70b6a01..19e4e39 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,4 +1,4 @@
-;;; zone.el --- idle display hacks
+;;; zone.el --- idle display hacks -*- lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -128,14 +128,17 @@ If the element is a function or a list of a function and
a number,
(let ((pgm (elt zone-programs (random (length zone-programs))))
(ct (and f (frame-parameter f 'cursor-type)))
(show-trailing-whitespace nil)
- (restore (list '(kill-buffer outbuf))))
+ restore)
(when ct
- (modify-frame-parameters f '((cursor-type . (bar . 0))))
- (setq restore (cons '(modify-frame-parameters
- f (list (cons 'cursor-type ct)))
- restore)))
+ (modify-frame-parameters f '((cursor-type . (bar . 0)))))
;; Make `restore' a self-disabling one-shot thunk.
- (setq restore `(lambda () ,@restore (setq restore nil)))
+ (setq restore
+ (lambda ()
+ (when ct
+ (modify-frame-parameters
+ f (list (cons 'cursor-type ct))))
+ (kill-buffer outbuf)
+ (setq restore nil)))
(condition-case nil
(progn
(message "Zoning... (%s)" pgm)
@@ -419,7 +422,7 @@ If the element is a function or a list of a function and a
number,
(defsubst zone-replace-char (count del-count char-as-string new-value)
(delete-char (or del-count (- count)))
(aset char-as-string 0 new-value)
- (dotimes (i count) (insert char-as-string)))
+ (dotimes (_ count) (insert char-as-string)))
(defsubst zone-park/sit-for (pos seconds)
(let ((p (point)))
@@ -460,7 +463,7 @@ If the element is a function or a list of a function and a
number,
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(setq line (concat line "\n"))
- (dotimes (i nl)
+ (dotimes (_ nl)
(insert line))))
(goto-char start)
(recenter 0)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a096866..3121530 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1268,9 +1268,8 @@ If `eval-expression-debug-on-error' is non-nil, which is
the default,
this command arranges for all errors to enter the debugger."
(interactive "P")
(if (null eval-expression-debug-on-error)
- (let ((value (elisp--eval-last-sexp eval-last-sexp-arg-internal)))
- (push value values)
- value)
+ (values--store-value
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal))
(let ((value
(let ((debug-on-error elisp--eval-last-sexp-fake-value))
(cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
@@ -1339,7 +1338,8 @@ Return the result of evaluation."
;; printing, not while evaluating.
(let ((debug-on-error eval-expression-debug-on-error)
(print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
+ (print-level eval-expression-print-level)
+ elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
;; eval-region handles recording which file defines a function or
@@ -1355,17 +1355,18 @@ Return the result of evaluation."
(setq end (point)))
;; Alter the form if necessary.
(let ((form (eval-sexp-add-defvars
- (elisp--eval-defun-1 (macroexpand form)))))
+ (elisp--eval-defun-1
+ (macroexpand
+ `(setq elisp--eval-defun-result ,form))))))
(eval-region beg end standard-output
(lambda (_ignore)
;; Skipping to the end of the specified region
;; will make eval-region return.
(goto-char end)
- form))))))
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str)))
- ;; The result of evaluation has been put onto VALUES. So return it.
- (car values))
+ form)))))
+ (let ((str (eval-expression-print-format elisp--eval-defun-result)))
+ (if str (princ str)))
+ elisp--eval-defun-result))
(defun eval-defun (edebug-it)
"Evaluate the top-level form containing point, or after point.
diff --git a/lisp/registry.el b/lisp/registry.el
index a5c30f2..258f7fc 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -1,4 +1,4 @@
-;;; registry.el --- Track and remember data items by various fields
+;;; registry.el --- Track and remember data items by various fields -*-
lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -128,7 +128,7 @@
:type hash-table
:documentation "The data hash table.")))
-(cl-defmethod initialize-instance :before ((this registry-db) slots)
+(cl-defmethod initialize-instance :before ((_this registry-db) slots)
"Check whether a registry object needs to be upgraded."
;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the
;; :max-soft slot to disappear, and the :max-hard slot to be renamed
@@ -212,7 +212,7 @@ When SET is not nil, set it for VAL (use t for an empty
list)."
(:regex
(string-match (car vals)
(mapconcat
- 'prin1-to-string
+ #'prin1-to-string
(cdr-safe (assoc key entry))
"\0"))))
vals (cdr-safe vals)))
@@ -247,7 +247,7 @@ Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
(let* ((data (oref db data))
(keys (or keys
- (apply 'registry-search db spec)))
+ (apply #'registry-search db spec)))
(tracked (oref db tracked)))
(dolist (key keys)
@@ -308,19 +308,18 @@ Errors out if the key exists already."
(let ((count 0)
(expected (* (length (oref db tracked)) (registry-size db))))
(dolist (tr (oref db tracked))
- (let (values)
- (maphash
- (lambda (key v)
- (cl-incf count)
- (when (and (< 0 expected)
- (= 0 (mod count 1000)))
- (message "reindexing: %d of %d (%.2f%%)"
- count expected (/ (* 100.0 count) expected)))
- (dolist (val (cdr-safe (assq tr v)))
- (let ((value-keys (registry-lookup-secondary-value db tr val)))
- (push key value-keys)
- (registry-lookup-secondary-value db tr val value-keys))))
- (oref db data))))))
+ (maphash
+ (lambda (key v)
+ (cl-incf count)
+ (when (and (< 0 expected)
+ (= 0 (mod count 1000)))
+ (message "reindexing: %d of %d (%.2f%%)"
+ count expected (/ (* 100.0 count) expected)))
+ (dolist (val (cdr-safe (assq tr v)))
+ (let ((value-keys (registry-lookup-secondary-value db tr val)))
+ (push key value-keys)
+ (registry-lookup-secondary-value db tr val value-keys))))
+ (oref db data)))))
(cl-defmethod registry-prune ((db registry-db) &optional sortfunc)
"Prune the registry-db object DB.
diff --git a/lisp/simple.el b/lisp/simple.el
index 568deba..0c5bcb6 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1809,31 +1809,34 @@ this command arranges for all errors to enter the
debugger."
(cons (read--expression "Eval: ")
(eval-expression-get-print-arguments current-prefix-arg)))
- (if (null eval-expression-debug-on-error)
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (let ((print-length (unless no-truncate eval-expression-print-length))
- (print-level (unless no-truncate eval-expression-print-level))
- (eval-expression-print-maximum-character char-print-limit)
- (deactivate-mark))
- (let ((out (if insert-value (current-buffer) t)))
- (prog1
- (prin1 (car values) out)
- (let ((str (and char-print-limit
- (eval-expression-print-format (car values)))))
- (when str (princ str out)))))))
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (let ((print-length (unless no-truncate eval-expression-print-length))
+ (print-level (unless no-truncate eval-expression-print-level))
+ (eval-expression-print-maximum-character char-print-limit)
+ (deactivate-mark))
+ (let ((out (if insert-value (current-buffer) t)))
+ (prog1
+ (prin1 result out)
+ (let ((str (and char-print-limit
+ (eval-expression-print-format result))))
+ (when str (princ str out))))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
diff --git a/lisp/subr.el b/lisp/subr.el
index f0de6d5..6573090 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1655,6 +1655,12 @@ The return value has the form (WIDTH . HEIGHT).
POSITION should
be a list of the form returned by `event-start' and `event-end'."
(nth 9 position))
+(defun values--store-value (value)
+ "Store VALUE in the obsolete `values' variable."
+ (with-suppressed-warnings ((obsolete values))
+ (push value values))
+ value)
+
;;;; Obsolescent names for functions.
@@ -1721,6 +1727,10 @@ be a list of the form returned by `event-start' and
`event-end'."
(make-obsolete-variable 'load-dangerous-libraries
"no longer used." "27.1")
+;; We can't actually make `values' obsolete, because that will result
+;; in warnings when using `values' in let-bindings.
+;;(make-obsolete-variable 'values "no longer used" "28.1")
+
;;;; Alternate names for functions - these are not being phased out.
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 1e22287..ec21987 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,4 +1,4 @@
-;;; bib-mode.el --- major mode for editing bib files
+;;; bib-mode.el --- major mode for editing bib files -*- lexical-binding: t
-*-
;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
@@ -39,13 +39,11 @@
(defcustom bib-file "~/my-bibliography.bib"
"Default name of file used by `addbib'."
- :type 'file
- :group 'bib)
+ :type 'file)
(defcustom unread-bib-file "~/to-be-read.bib"
"Default name of file used by `unread-bib' in Bib mode."
- :type 'file
- :group 'bib)
+ :type 'file)
(defvar bib-mode-map
(let ((map (make-sparse-keymap)))
@@ -138,8 +136,7 @@ with the cdr.")
(defcustom bib-auto-capitalize t
"True to automatically capitalize appropriate fields in Bib mode."
- :type 'boolean
- :group 'bib)
+ :type 'boolean)
(defconst bib-capitalized-fields "%[AETCBIJR]")
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index ed0a367..fe052e3 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -28,10 +28,12 @@
;;; Emacs lisp functions to convert Texinfo files to Info files.
(defvar texinfmt-version "2.42 of 7 Jul 2006")
+(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1")
(defun texinfmt-version (&optional here)
"Show the version of texinfmt.el in the minibuffer.
If optional argument HERE is non-nil, insert info at point."
+ (declare (obsolete emacs-version "28.1"))
(interactive "P")
(let ((version-string
(format-message "Version of `texinfmt.el': %s" texinfmt-version)))
@@ -345,8 +347,8 @@ converted to Info is stored in a temporary buffer."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Now convert for real.
@@ -489,8 +491,8 @@ if large. You can use `Info-split' to do this manually."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Return data for indices.
(list outfile
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index c495afb..d1385ea 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1076,49 +1076,49 @@ stream. Standard error output is discarded."
(when (string-match ".+checkout of branch: \\(.+\\)$" str)
(match-string 1 str)))))
(concat
- (propertize "Parent branch : " 'face 'font-lock-type-face)
+ (propertize "Parent branch : " 'face 'vc-dir-header)
(propertize
(if (string-match "parent branch: \\(.+\\)$" str)
(match-string 1 str)
"None")
- 'face 'font-lock-variable-name-face)
+ 'face 'vc-dir-header-value)
"\n"
(when light-checkout
(concat
- (propertize "Light checkout root: " 'face 'font-lock-type-face)
- (propertize light-checkout 'face 'font-lock-variable-name-face)
+ (propertize "Light checkout root: " 'face 'vc-dir-header)
+ (propertize light-checkout 'face 'vc-dir-header-value)
"\n"))
(when light-checkout-branch
(concat
- (propertize "Checkout of branch : " 'face 'font-lock-type-face)
- (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
+ (propertize "Checkout of branch : " 'face 'vc-dir-header)
+ (propertize light-checkout-branch 'face 'vc-dir-header-value)
"\n"))
(when pending-merge
(concat
- (propertize "Warning : " 'face 'font-lock-warning-face
+ (propertize "Warning : " 'face 'vc-dir-status-warning
'help-echo pending-merge-help-echo)
(propertize "Pending merges, commit recommended before any other
action"
'help-echo pending-merge-help-echo
- 'face 'font-lock-warning-face)
+ 'face 'vc-dir-status-warning)
"\n"))
(if shelve
(concat
- (propertize "Shelves :\n" 'face 'font-lock-type-face
+ (propertize "Shelves :\n" 'face 'vc-dir-header
'help-echo shelve-help-echo)
(mapconcat
(lambda (x)
(propertize x
- 'face 'font-lock-variable-name-face
+ 'face 'vc-dir-header-value
'mouse-face 'highlight
'help-echo "mouse-3: Show shelve menu\nA: Apply and
keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k:
Delete shelf"
'keymap vc-bzr-shelve-map))
shelve "\n"))
(concat
- (propertize "Shelves : " 'face 'font-lock-type-face
+ (propertize "Shelves : " 'face 'vc-dir-header
'help-echo shelve-help-echo)
(propertize "No shelved changes"
'help-echo shelve-help-echo
- 'face 'font-lock-variable-name-face))))))
+ 'face 'vc-dir-header-value))))))
;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-resynch-buffer "vc-dispatcher"
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a595cc9..0adb532 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil."
(file-error nil))))
(concat
(cond (repo
- (concat (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t ""))
(cond (module
- (concat (propertize "Module : " 'face 'font-lock-type-face)
- (propertize module 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Module : " 'face 'vc-dir-header)
+ (propertize module 'face 'vc-dir-header-value)))
(t ""))
(if (file-readable-p "CVS/Tag")
(let ((tag (vc-cvs-file-to-string "CVS/Tag")))
(cond
((string-match "\\`T" tag)
- (concat (propertize "Tag : " 'face 'font-lock-type-face)
+ (concat (propertize "Tag : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
((string-match "\\`D" tag)
- (concat (propertize "Date : " 'face 'font-lock-type-face)
+ (concat (propertize "Date : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
(t ""))))
;; In CVS, branch is a per-file property, not a per-directory property.
;; We can't really do this here without making dangerous assumptions.
- ;;(propertize "Branch: " 'face 'font-lock-type-face)
+ ;;(propertize "Branch: " 'face 'vc-dir-header)
;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
;; 'face 'font-lock-warning-face)
)))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 14c8157..a416474 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -86,7 +86,7 @@ See `run-hooks'."
"Face for up-to-date status in VC-dir buffers."
:group 'vc)
-(defface vc-dir-ignored '((t :inherit shadow))
+(defface vc-dir-status-ignored '((t :inherit shadow))
"Face for ignored or empty values in VC-dir buffers."
:group 'vc)
@@ -1454,10 +1454,12 @@ These are the commands available for use in the file
status buffer:
" "
(propertize
(format "%-20s" state)
- 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
- ((memq state '(missing conflict)) 'vc-dir-status-warning)
- ((eq state 'edited) 'font-lock-constant-face)
- (t 'vc-dir-header-value))
+ 'face (cond
+ ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
+ ((memq state '(missing conflict needs-update unlocked-changes))
+ 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
+ (t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" "
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e730638..25ae26d 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -479,7 +479,8 @@ or an empty string if none."
(propertize
(format "%-12s" state)
'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
- ((eq state '(missing conflict)) 'vc-dir-status-warning)
+ ((memq state '(missing conflict)) 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
@@ -835,7 +836,7 @@ or an empty string if none."
(propertize "Nothing stashed"
'help-echo vc-git-stash-shared-help
'keymap vc-git-stash-shared-map
- 'face 'vc-dir-ignored))))))
+ 'face 'vc-dir-header-value))))))
(defun vc-git-branches ()
"Return the existing branches, as a list of strings.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1d163a6..adb0fce 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"."
(cons (capitalize (match-string 1)) (match-string
2))
(cons "" (buffer-substring (point)
(line-end-position))))))
(concat
- (propertize (format "%-11s: " (car entry)) 'face
'font-lock-type-face)
- (propertize (cdr entry) 'face 'font-lock-variable-name-face)))
+ (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header)
+ (propertize (cdr entry) 'face 'vc-dir-header-value)))
result)
(forward-line))
(nreverse result))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index da54711..22becc9 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory
DIR."
(concat
(cond (repo
(concat
- (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t "")))))
(defun vc-svn-working-revision (file)
diff --git a/src/fns.c b/src/fns.c
index 02743c6..c16f9c6 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5769,7 +5769,7 @@ visible part of the buffer. If ABSOLUTE is non-nil,
count the lines
from the absolute start of the buffer. */)
(register Lisp_Object position, Lisp_Object absolute)
{
- ptrdiff_t pos, start = BEGV;
+ ptrdiff_t pos, start = BEGV_BYTE;
if (MARKERP (position))
pos = marker_position (position);
diff --git a/src/lread.c b/src/lread.c
index 010194c..dea1b23 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4833,7 +4833,8 @@ to find all the symbols in an obarray, use `mapatoms'.
*/);
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read,
evaluated and printed.
-Order is reverse chronological. */);
+Order is reverse chronological.
+This variable is obsolete as of Emacs 28.1 and should not be used. */);
XSYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
diff --git a/test/lisp/cedet/cedet-files-tests.el
b/test/lisp/cedet/cedet-files-tests.el
new file mode 100644
index 0000000..5502d42
--- /dev/null
+++ b/test/lisp/cedet/cedet-files-tests.el
@@ -0,0 +1,54 @@
+;;; cedet-files-tests.el --- Tests for cedet-files.el -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'cedet-files)
+
+(defvar cedet-files-utest-list
+ '(
+ ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
+ ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
+ ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
+ ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
+ )
+ "List of different file names to test.
+Each entry is a cons cell of ( FNAME . CONVERTED )
+where FNAME is some file name, and CONVERTED is what it should be
+converted into.")
+
+(ert-deftest cedet-files-utest ()
+ "Test out some file name conversions."
+ (interactive)
+ (dolist (FT cedet-files-utest-list)
+ (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
+ (file->dir (cedet-file-name-to-directory-name (cdr FT) t)))
+ (should (string= (cdr FT) dir->file))
+ (should (string= file->dir (car FT))))))
+
+(provide 'cedet-files-tests)
+
+;;; cedet-files-tests.el ends here
diff --git a/test/lisp/cedet/inversion-tests.el
b/test/lisp/cedet/inversion-tests.el
new file mode 100644
index 0000000..c8b45d6
--- /dev/null
+++ b/test/lisp/cedet/inversion-tests.el
@@ -0,0 +1,81 @@
+;;; inversion-tests.el --- Tests for inversion.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'inversion)
+(require 'ert)
+
+(ert-deftest inversion-unit-test ()
+ "Test inversion to make sure it can identify different version strings."
+ (interactive)
+ (let ((c1 (inversion-package-version 'inversion))
+ (c1i (inversion-package-incompatibility-version 'inversion))
+ (c2 (inversion-decode-version "1.3alpha2"))
+ (c3 (inversion-decode-version "1.3beta4"))
+ (c4 (inversion-decode-version "1.3 beta5"))
+ (c5 (inversion-decode-version "1.3.4"))
+ (c6 (inversion-decode-version "2.3alpha"))
+ (c7 (inversion-decode-version "1.3"))
+ (c8 (inversion-decode-version "1.3pre1"))
+ (c9 (inversion-decode-version "2.4 (patch 2)"))
+ (c10 (inversion-decode-version "2.4 (patch 3)"))
+ (c11 (inversion-decode-version "2.4.2.1"))
+ (c12 (inversion-decode-version "2.4.2.2")))
+ (should (inversion-= c1 c1))
+ (should (inversion-< c1i c1))
+ (should (inversion-< c2 c3))
+ (should (inversion-< c3 c4))
+ (should (inversion-< c4 c5))
+ (should (inversion-< c5 c6))
+ (should (inversion-< c2 c4))
+ (should (inversion-< c2 c5))
+ (should (inversion-< c2 c6))
+ (should (inversion-< c3 c5))
+ (should (inversion-< c3 c6))
+ (should (inversion-< c7 c6))
+ (should (inversion-< c4 c7))
+ (should (inversion-< c2 c7))
+ (should (inversion-< c8 c6))
+ (should (inversion-< c8 c7))
+ (should (inversion-< c4 c8))
+ (should (inversion-< c2 c8))
+ (should (inversion-< c9 c10))
+ (should (inversion-< c10 c11))
+ (should (inversion-< c11 c12))
+ ;; Negatives
+ (should-not (inversion-< c3 c2))
+ (should-not (inversion-< c4 c3))
+ (should-not (inversion-< c5 c4))
+ (should-not (inversion-< c6 c5))
+ (should-not (inversion-< c7 c2))
+ (should-not (inversion-< c7 c8))
+ (should-not (inversion-< c12 c11))
+ ;; Test the tester on inversion
+ (should-not (inversion-test 'inversion inversion-version))
+ (should (stringp (inversion-test 'inversion "0.0.0")))
+ (should (stringp (inversion-test 'inversion "1000.0")))))
+
+;;; inversion-tests.el ends here
diff --git a/test/lisp/cedet/semantic-utest-fmt.el
b/test/lisp/cedet/semantic-utest-fmt.el
deleted file mode 100644
index d6e5ce7..0000000
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ /dev/null
@@ -1,127 +0,0 @@
-;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*-
lexical-binding:t -*-
-
-;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Unit tests for the formatting feature.
-;;
-;; Using test code from the tests source directory, parse the source
-;; file. After parsing, read the comments for each signature, and
-;; make sure that the semantic-tag-format-* functions in question
-;; created the desired output.
-
-(require 'semantic)
-(require 'semantic/format)
-
-;;; Code:
-
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-fmt-utest-file-list
- '("tests/test-fmt.cpp"
- ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
- )
- "List of files to run unit tests in.")
-
-(defvar semantic-fmt-utest-error-log-list nil
- "Log errors during testing in this variable.")
-
-(ert-deftest semantic-fmt-utest ()
- "Visit all file entries, and run formatting test.
-Files to visit are in `semantic-fmt-utest-file-list'."
- (save-current-buffer
- (semantic-mode 1)
- (let ((fl semantic-fmt-utest-file-list)
- (fname nil)
- )
-
- (dolist (FILE fl)
-
- (save-current-buffer
- (setq fname (expand-file-name FILE cedet-utest-directory))
-
- ;; Make sure we have the files we think we have.
- (should (file-exists-p fname))
- ;; (error "Cannot find unit test file: %s" fname))
-
- ;; Run the tests.
- (let ((fb (find-buffer-visiting fname))
- (b (semantic-find-file-noselect fname))
- (tags nil))
-
- (save-current-buffer
- (set-buffer b)
- (should (semantic-active-p))
- ;;(error "Cannot open %s for format tests" fname))
-
- ;; This will force a reparse, removing any chance of semanticdb
cache
- ;; using stale data.
- (semantic-clear-toplevel-cache)
- ;; Force the reparse
- (setq tags (semantic-fetch-tags))
-
- (save-excursion
- (while tags
- (let* ((T (car tags))
- (start (semantic-tag-end T))
- (end (if (cdr tags)
- (semantic-tag-start (car (cdr tags)))
- (point-max)))
- (TESTS nil)
- )
- (goto-char start)
- ;; Scan the space between tags for all test condition
matches.
- (while (re-search-forward "## \\([a-z-]+\\)
\"\\([^\n\"]+\\)\"$" end t)
- (push (cons (match-string 1) (match-string 2)) TESTS))
- (setq TESTS (nreverse TESTS))
-
- (dolist (TST TESTS)
- (let* ( ;; For each test, convert CAR into a
semantic-format-tag* fcn
- (sym (intern (concat "semantic-format-tag-" (car
TST))))
- ;; Convert the desired result from a string syntax
to a string.
- (desired (cdr TST))
- ;; What does the fmt function do?
- (actual (funcall sym T))
- )
- (when (not (string= desired actual))
- (should-not (list "Desired" desired
- "Actual" actual
- "Formatter" (car TST))))
- )))
- (setq tags (cdr tags)))
-
- ))
-
- ;; If it wasn't already in memory, whack it.
- (when (and b (not fb))
- (kill-buffer b)))
- ))
-
- )))
-
-
-(provide 'cedet/semantic/fmt-utest)
-
-;;; semantic-fmt-utest.el ends here
diff --git a/test/manual/cedet/tests/test.mk
b/test/lisp/cedet/semantic-utest-ia-resources/test.mk
similarity index 100%
rename from test/manual/cedet/tests/test.mk
rename to test/lisp/cedet/semantic-utest-ia-resources/test.mk
diff --git a/test/manual/cedet/tests/test.srt
b/test/lisp/cedet/semantic-utest-ia-resources/test.srt
similarity index 100%
rename from test/manual/cedet/tests/test.srt
rename to test/lisp/cedet/semantic-utest-ia-resources/test.srt
diff --git a/test/manual/cedet/tests/test.texi
b/test/lisp/cedet/semantic-utest-ia-resources/test.texi
similarity index 100%
rename from test/manual/cedet/tests/test.texi
rename to test/lisp/cedet/semantic-utest-ia-resources/test.texi
diff --git a/test/manual/cedet/tests/testdoublens.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
similarity index 100%
rename from test/manual/cedet/tests/testdoublens.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
diff --git a/test/manual/cedet/tests/testdoublens.hpp
b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
similarity index 100%
rename from test/manual/cedet/tests/testdoublens.hpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
diff --git a/test/manual/cedet/tests/testfriends.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
similarity index 99%
rename from test/manual/cedet/tests/testfriends.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
index 20425f9..f84ed5a 100644
--- a/test/manual/cedet/tests/testfriends.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
@@ -35,4 +35,3 @@ int B::testB() {
int B::testAB() { // %1% ( ( "testfriends.cpp" ) ( "B" "B::testAB" ) )
}
-
diff --git a/test/manual/cedet/tests/testjavacomp.java
b/test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
similarity index 100%
rename from test/manual/cedet/tests/testjavacomp.java
rename to test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
diff --git a/test/manual/cedet/tests/testlocalvars.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
similarity index 100%
rename from test/manual/cedet/tests/testlocalvars.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
diff --git a/test/manual/cedet/tests/testnsp.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
similarity index 100%
rename from test/manual/cedet/tests/testnsp.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
diff --git a/test/manual/cedet/tests/testsppcomplete.c
b/test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
similarity index 100%
rename from test/manual/cedet/tests/testsppcomplete.c
rename to test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
diff --git a/test/manual/cedet/tests/teststruct.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
similarity index 100%
rename from test/manual/cedet/tests/teststruct.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
diff --git a/test/manual/cedet/tests/testsubclass.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
similarity index 100%
rename from test/manual/cedet/tests/testsubclass.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
diff --git a/test/manual/cedet/tests/testsubclass.hh
b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
similarity index 100%
rename from test/manual/cedet/tests/testsubclass.hh
rename to test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
diff --git a/test/manual/cedet/tests/testtemplates.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
similarity index 100%
rename from test/manual/cedet/tests/testtemplates.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
diff --git a/test/manual/cedet/tests/testtypedefs.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
similarity index 100%
rename from test/manual/cedet/tests/testtypedefs.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
diff --git a/test/manual/cedet/tests/testusing.cpp
b/test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
similarity index 100%
rename from test/manual/cedet/tests/testusing.cpp
rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
diff --git a/test/manual/cedet/tests/testusing.hh
b/test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
similarity index 100%
rename from test/manual/cedet/tests/testusing.hh
rename to test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
diff --git a/test/manual/cedet/tests/testvarnames.c
b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
similarity index 100%
rename from test/manual/cedet/tests/testvarnames.c
rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
diff --git a/test/manual/cedet/tests/testvarnames.java
b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
similarity index 100%
rename from test/manual/cedet/tests/testvarnames.java
rename to test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
diff --git a/test/manual/cedet/tests/testwisent.wy
b/test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
similarity index 100%
rename from test/manual/cedet/tests/testwisent.wy
rename to test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
diff --git a/test/lisp/cedet/semantic-utest-ia.el
b/test/lisp/cedet/semantic-utest-ia.el
index 7210f66..122c431 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -30,121 +30,94 @@
;; (Replace // with contents of comment-start for the language being tested.)
;;; Code:
+(require 'ert)
+(require 'ert-x)
(require 'semantic)
(require 'semantic/analyze)
(require 'semantic/analyze/refs)
(require 'semantic/symref)
(require 'semantic/symref/filter)
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-utest-test-directory (expand-file-name "tests"
cedet-utest-directory)
- "Location of test files.")
-
(ert-deftest semantic-utest-ia-doublens.cpp ()
- (let ((tst (expand-file-name "testdoublens.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testdoublens.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-subclass.cpp ()
- (let ((tst (expand-file-name "testsubclass.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsubclass.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-typedefs.cpp ()
- (let ((tst (expand-file-name "testtypedefs.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtypedefs.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-struct.cpp ()
- (let ((tst (expand-file-name "teststruct.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "teststruct.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-union.cpp ()
-;; (let ((tst (expand-file-name "testunion.cpp"
semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testunion.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-templates.cpp ()
- (let ((tst (expand-file-name "testtemplates.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtemplates.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-friends.cpp ()
-;; (let ((tst (expand-file-name "testfriends.cpp"
semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testfriends.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-using.cpp ()
- (let ((tst (expand-file-name "testusing.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testusing.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-nsp.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-localvars.cpp ()
- (let ((tst (expand-file-name "testlocalvars.cpp"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testlocalvars.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-namespace.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-sppcomplete.c ()
- (let ((tst (expand-file-name "testsppcomplete.c"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsppcomplete.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.c ()
- (let ((tst (expand-file-name "testvarnames.c"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-javacomp.java ()
- (let ((tst (expand-file-name "testjavacomp.java"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testjavacomp.java")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.java ()
- (let ((tst (expand-file-name "testvarnames.java"
semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.java")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-f90.f90 ()
-;; (let ((tst (expand-file-name "testf90.f90" semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testf90.f90")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-wisent.wy ()
- (let ((tst (expand-file-name "testwisent.wy" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testwisent.wy")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-texi ()
- (let ((tst (expand-file-name "test.texi" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.texi")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-make ()
- (let ((tst (expand-file-name "test.mk" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.mk")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-srecoder ()
- (let ((tst (expand-file-name "test.srt" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.srt")))
(should-not (semantic-ia-utest tst))))
;;; Core testing utility
diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el
b/test/lisp/cedet/semantic/bovine/gcc-tests.el
new file mode 100644
index 0000000..e1a18c6
--- /dev/null
+++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el
@@ -0,0 +1,129 @@
+;;; gcc-tests.el --- Tests for semantic/bovine/gcc.el -*- lexical-binding:t
-*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/bovine/gcc)
+
+;;; From bovine-gcc:
+
+;; Example output of "gcc -v"
+(defvar semantic-gcc-test-strings
+ '(;; My old box:
+ "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--host=i386-redhat-linux
+Thread model: posix
+gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
+ ;; Alex Ott:
+ "Using built-in specs.
+Target: i486-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1'
--with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-chec [...]
+Thread model: posix
+gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
+ ;; My debian box:
+ "Using built-in specs.
+Target: x86_64-unknown-linux-gnu
+Configured with: ../../../sources/gcc/configure
--prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3
--with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr
--enable-languages=c,c++,fortran
--with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as
--with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
+Thread model: posix
+gcc version 4.2.3"
+ ;; My mac:
+ "Using built-in specs.
+Target: i686-apple-darwin8
+Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure
--disable-checking -enable-werror --prefix=/usr --mandir=/share/man
--enable-languages=c,objc,c++,obj-c++
--program-transform-name=/^[cg][^.-]*$/s/$/-4.0/
--with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib
--build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott
--program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
+Thread model: posix
+gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
+ ;; Ubuntu Intrepid
+ "Using built-in specs.
+Target: x86_64-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-checking=release --build [...]
+Thread model: posix
+gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Red Hat EL4
+ "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
+Thread model: posix
+gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
+ ;; Red Hat EL5
+ "Using built-in specs.
+Target: x86_64-redhat-linux
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--enable-checking=release --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-libgcj-multifile
--enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk
--disable-dssi --enable-plugin
--with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic
--host=x86_64-redhat-linux
+Thread model: posix
+gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
+ ;; David Engster's german gcc on ubuntu 4.3
+ "Es werden eingebaute Spezifikationen verwendet.
+Ziel: i486-linux-gnu
+Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-ch [...]
+Thread-Modell: posix
+gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Damien Deville bsd
+ "Using built-in specs.
+Target: i386-undermydesk-freebsd
+Configured with: FreeBSD/i386 system compiler
+Thread model: posix
+gcc version 4.2.1 20070719 [FreeBSD]"
+ )
+ "A bunch of sample gcc -v outputs from different machines.")
+
+(defvar semantic-gcc-test-strings-fail
+ '(;; A really old solaris box I found
+ "Reading specs from
/usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
+gcc version 2.95.2 19991024 (release)"
+ )
+ "A bunch of sample gcc -v outputs that fail to provide the info we want.")
+
+(defun semantic-gcc-test-output-parser ()
+ "Test the output parser against some collected strings."
+ (dolist (S semantic-gcc-test-strings)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc 'target fields))
+ (cdr (assoc '--target fields))
+ (cdr (assoc '--host fields))))
+ (p (cdr (assoc '--prefix fields))))
+ ;; No longer test for prefixes.
+ (when (not (and v h))
+ (let ((strs (split-string S "\n")))
+ (error "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)))))
+ (dolist (S semantic-gcc-test-strings-fail)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc '--host fields))
+ (cdr (assoc 'target fields))))
+ (p (cdr (assoc '--prefix fields)))
+ )
+ (when (and v h p)
+ (error "Negative test failed on %S" S)))))
+
+(ert-deftest semantic-gcc-test-output-parser ()
+ (semantic-gcc-test-output-parser))
+
+(ert-deftest semantic-gcc-test-output-parser-this-machine ()
+ "Test the output parser against the machine currently running Emacs."
+ (skip-unless (executable-find "gcc"))
+ (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
+ (semantic-gcc-test-output-parser)))
+
+;;; gcc-tests.el ends here
diff --git a/test/manual/cedet/tests/test-fmt.cpp
b/test/lisp/cedet/semantic/format-resources/test-fmt.cpp
similarity index 100%
rename from test/manual/cedet/tests/test-fmt.cpp
rename to test/lisp/cedet/semantic/format-resources/test-fmt.cpp
diff --git a/test/manual/cedet/tests/test-fmt.el
b/test/lisp/cedet/semantic/format-resources/test-fmt.el
similarity index 95%
rename from test/manual/cedet/tests/test-fmt.el
rename to test/lisp/cedet/semantic/format-resources/test-fmt.el
index 1225713..941aaae 100644
--- a/test/manual/cedet/tests/test-fmt.el
+++ b/test/lisp/cedet/semantic/format-resources/test-fmt.el
@@ -1,4 +1,4 @@
-;;; test-fmt.el --- test semantic tag formatting
+;;; test-fmt.el --- test semantic tag formatting -*- lexical-binding: t -*-
;;; Copyright (C) 2012, 2019-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/cedet/semantic/format-tests.el
b/test/lisp/cedet/semantic/format-tests.el
new file mode 100644
index 0000000..e82c97b
--- /dev/null
+++ b/test/lisp/cedet/semantic/format-tests.el
@@ -0,0 +1,95 @@
+;;; semantic/format-tests.el --- Parsing / Formatting tests -*-
lexical-binding:t -*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for the formatting feature.
+;;
+;; Using test code from the tests source directory, parse the source
+;; file. After parsing, read the comments for each signature, and
+;; make sure that the semantic-tag-format-* functions in question
+;; created the desired output.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'semantic/format)
+
+(defvar semantic-fmt-utest-file-list
+ (list (ert-resource-file "test-fmt.cpp")
+ ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
+ )
+ "List of files to run unit tests in.")
+
+(ert-deftest semantic-fmt-utest ()
+ "Visit all file entries, and run formatting test. "
+ (save-current-buffer
+ (semantic-mode 1)
+ (dolist (fname semantic-fmt-utest-file-list)
+ (let ((fb (find-buffer-visiting fname))
+ (b (semantic-find-file-noselect fname))
+ (tags nil))
+ (save-current-buffer
+ (set-buffer b)
+ (should (semantic-active-p))
+ ;;(error "Cannot open %s for format tests" fname))
+
+ ;; This will force a reparse, removing any chance of semanticdb cache
+ ;; using stale data.
+ (semantic-clear-toplevel-cache)
+ ;; Force the reparse
+ (setq tags (semantic-fetch-tags))
+
+ (save-excursion
+ (while tags
+ (let* ((T (car tags))
+ (start (semantic-tag-end T))
+ (end (if (cdr tags)
+ (semantic-tag-start (car (cdr tags)))
+ (point-max)))
+ (TESTS nil))
+ (goto-char start)
+ ;; Scan the space between tags for all test condition matches.
+ (while (re-search-forward "## \\([a-z-]+\\)
\"\\([^\n\"]+\\)\"$" end t)
+ (push (cons (match-string 1) (match-string 2)) TESTS))
+ (setq TESTS (nreverse TESTS))
+
+ (dolist (TST TESTS)
+ (let* ( ;; For each test, convert CAR into a
semantic-format-tag* fcn
+ (sym (intern (concat "semantic-format-tag-" (car
TST))))
+ ;; Convert the desired result from a string syntax to
a string.
+ (desired (cdr TST))
+ ;; What does the fmt function do?
+ (actual (funcall sym T)))
+ (when (not (string= desired actual))
+ (should-not (list "Desired" desired
+ "Actual" actual
+ "Formatter" (car TST)))))))
+ (setq tags (cdr tags)))))
+
+ ;; If it wasn't already in memory, whack it.
+ (when (and b (not fb))
+ (kill-buffer b))))))
+
+(provide 'format-tests)
+
+;;; format-tests.el ends here
diff --git a/test/lisp/cedet/semantic/fw-tests.el
b/test/lisp/cedet/semantic/fw-tests.el
new file mode 100644
index 0000000..62d665d
--- /dev/null
+++ b/test/lisp/cedet/semantic/fw-tests.el
@@ -0,0 +1,45 @@
+;;; fw-tests.el --- Tests for semantic/fw.el -*- lexical-binding:t -*-
+
+;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/fw)
+
+;;; From semantic-fw:
+
+(ert-deftest semantic-test-data-cache ()
+ "Test the data cache."
+ (let ((data '(a b c)))
+ (with-current-buffer (get-buffer-create " *semantic-test-data-cache*")
+ (erase-buffer)
+ (insert "The Moose is Loose")
+ (goto-char (point-min))
+ (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+ data 'moose 'exit-cache-zone)
+ ;; retrieve cached data
+ (should (equal (semantic-get-cache-data 'moose) data)))))
+
+;;; gw-tests.el ends here
diff --git a/test/lisp/cedet/srecode/document-tests.el
b/test/lisp/cedet/srecode/document-tests.el
new file mode 100644
index 0000000..0bc6e10
--- /dev/null
+++ b/test/lisp/cedet/srecode/document-tests.el
@@ -0,0 +1,80 @@
+;;; document-tests.el --- Tests for srecode/document.el -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Extracted from srecode-document.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'srecode/document)
+
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-document-function-comment-extract-test ()
+ "Test old comment extraction.
+Dump out the extracted dictionary."
+ :tags '(:unstable)
+ (interactive)
+
+ (srecode-load-tables-for-mode major-mode)
+ (srecode-load-tables-for-mode major-mode 'document)
+
+ (should (srecode-table))
+ ;; (error "No template table found for mode %s" major-mode)
+
+ (let* ((temp (srecode-template-get-table (srecode-table)
+ "function-comment"
+ "declaration"
+ 'document))
+ (fcn-in (semantic-current-tag)))
+
+ (should temp)
+ ;; (error "No templates for function comments")
+
+ ;; Try to figure out the tag we want to use.
+ (should fcn-in)
+ (should (semantic-tag-of-class-p fcn-in 'function))
+ ;; (error "No tag of class 'function to insert comment for")
+
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex)))
+
+ (should lextok)
+ ;; (error "No comment to attempt an extraction")
+
+ (let ((s (semantic-lex-token-start lextok))
+ (e (semantic-lex-token-end lextok))
+ (extract nil))
+
+ (pulse-momentary-highlight-region s e)
+
+ ;; Extract text from the existing comment.
+ (setq extract (srecode-extract temp s e))
+
+ (with-output-to-temp-buffer "*SRECODE DUMP*"
+ (princ "EXTRACTED DICTIONARY FOR ")
+ (princ (semantic-tag-name fcn-in))
+ (princ "\n--------------------------------------------\n")
+ (srecode-dump extract))))))
+
+;;; document-tests.el ends here
diff --git a/test/manual/cedet/srecode-tests.el
b/test/lisp/cedet/srecode/fields-tests.el
similarity index 75%
rename from test/manual/cedet/srecode-tests.el
rename to test/lisp/cedet/srecode/fields-tests.el
index ebc3261..5f634a5 100644
--- a/test/manual/cedet/srecode-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -1,4 +1,4 @@
-;;; srecode-tests.el --- Some tests for CEDET's srecode
+;;; srecode/fields-tests.el --- Tests for srecode/fields.el -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -21,13 +21,15 @@
;;; Commentary:
-;; Extracted from srecode-fields.el and srecode-document.el in the
-;; CEDET distribution.
+;; Extracted from srecode-fields.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
;;; Code:
;;; From srecode-fields:
+(require 'ert)
(require 'srecode/fields)
(defvar srecode-field-utest-text
@@ -36,13 +38,10 @@
It is filled with some text."
"Text for tests.")
-(defun srecode-field-utest ()
- "Test the srecode field manager."
- (interactive)
- (srecode-field-utest-impl))
-
-(defun srecode-field-utest-impl ()
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-field-utest-impl ()
"Implementation of the SRecode field utest."
+ :tags '(:unstable)
(save-excursion
(find-file "/tmp/srecode-field-test.txt")
@@ -131,15 +130,15 @@ It is filled with some text."
;; Various sizes
(mapc (lambda (T)
- (if (string= (object-name-string T) "Test4")
+ (if (string= (eieio-object-name-string T) "Test4")
(progn
(when (not (srecode-empty-region-p T))
(error "Field %s is not empty"
- (object-name T)))
+ (eieio-object-name T)))
)
(when (not (= (srecode-region-size T) 5))
(error "Calculated size of %s was not 5"
- (object-name T)))))
+ (eieio-object-name T)))))
fields)
;; Make sure things stay up after a 'command'.
@@ -151,21 +150,21 @@ It is filled with some text."
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
(srecode-field-next)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 1 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 1 fields))))
+ (eieio-object-name (nth 1 fields))))
(srecode-field-prev)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
;; Move cursor out of the region and have everything cleaned up.
(goto-char 42)
@@ -176,7 +175,7 @@ It is filled with some text."
(mapc (lambda (T)
(when (slot-boundp T 'overlay)
(error "Overlay did not clear off of field %s"
- (object-name T))))
+ (eieio-object-name T))))
fields)
;; End of LET
@@ -187,8 +186,7 @@ It is filled with some text."
(f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8))
(f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30))
(f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40))
- (reg (srecode-template-inserted-region "REG" :start 4 :end 40))
- )
+ (reg (srecode-template-inserted-region "REG" :start 4 :end 40)))
(srecode-overlaid-activate reg)
(when (not (string= (srecode-overlaid-text f1)
@@ -233,62 +231,8 @@ It is filled with some text."
(error "Linkage Test: tail-insert string on dissimilar fields is now
the same"))
;; Cleanup
- (srecode-delete reg)
- )
-
- (set-buffer-modified-p nil)
-
- (message " All field tests passed.")
- ))
-
-;;; From srecode-document:
-
-(require 'srecode/document)
-
-(defun srecode-document-function-comment-extract-test ()
- "Test old comment extraction.
-Dump out the extracted dictionary."
- (interactive)
-
- (srecode-load-tables-for-mode major-mode)
- (srecode-load-tables-for-mode major-mode 'document)
-
- (if (not (srecode-table))
- (error "No template table found for mode %s" major-mode))
-
- (let* ((temp (srecode-template-get-table (srecode-table)
- "function-comment"
- "declaration"
- 'document))
- (fcn-in (semantic-current-tag)))
-
- (if (not temp)
- (error "No templates for function comments"))
-
- ;; Try to figure out the tag we want to use.
- (when (or (not fcn-in)
- (not (semantic-tag-of-class-p fcn-in 'function)))
- (error "No tag of class 'function to insert comment for"))
-
- (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
- )
-
- (when (not lextok)
- (error "No comment to attempt an extraction"))
-
- (let ((s (semantic-lex-token-start lextok))
- (e (semantic-lex-token-end lextok))
- (extract nil))
-
- (pulse-momentary-highlight-region s e)
-
- ;; Extract text from the existing comment.
- (setq extract (srecode-extract temp s e))
+ (srecode-delete reg))
- (with-output-to-temp-buffer "*SRECODE DUMP*"
- (princ "EXTRACTED DICTIONARY FOR ")
- (princ (semantic-tag-name fcn-in))
- (princ "\n--------------------------------------------\n")
- (srecode-dump extract))))))
+ (set-buffer-modified-p nil)))
-;;; srecode-tests.el ends here
+;;; srecode/fields-tests.el ends here
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
index 95f62e0..97b3349 100644
--- a/test/lisp/cus-edit-tests.el
+++ b/test/lisp/cus-edit-tests.el
@@ -53,9 +53,9 @@
(customize-apropos "cus-edit-tests")
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
-(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
+(ert-deftest cus-edit-tests-customize-changed/hide-obsolete ()
(with-cus-edit-test "*Customize Changed Options*"
- (customize-changed-options "917.2") ; some future version
+ (customize-changed "917.2") ;; Some future version.
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
diff --git a/test/lisp/play/cookie1-resources/cookies
b/test/lisp/play/cookie1-resources/cookies
new file mode 100644
index 0000000..7bf569f
--- /dev/null
+++ b/test/lisp/play/cookie1-resources/cookies
@@ -0,0 +1,8 @@
+This fortune intentionally left blank.
+%
+This fortune intentionally not included.
+%
+This fortune intentionally says nothing.
+%
+This fortune is false.
+%
diff --git a/test/lisp/play/cookie1-tests.el b/test/lisp/play/cookie1-tests.el
new file mode 100644
index 0000000..d63ecb9
--- /dev/null
+++ b/test/lisp/play/cookie1-tests.el
@@ -0,0 +1,40 @@
+;;; fortune-tests.el --- Tests for fortune.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'cookie1)
+
+(ert-deftest cookie1-tests-cookie ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (cookie fortune-file)))))
+
+(ert-deftest cookie1-testss-cookie-apropos ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (car (cookie-apropos "false" fortune-file))))
+ (should (= (length (cookie-apropos "false" fortune-file)) 1))))
+
+(provide 'fortune-tests)
+;;; fortune-tests.el ends here
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index b4007a6..f2ddc2e 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -67,6 +67,11 @@
(insert (propertize "\nbar\nbaz\nzut" 'invisible t))
(should (= (count-lines (point-min) (point-max) t) 2))))
+(ert-deftest simple-text-count-lines-non-ascii ()
+ (with-temp-buffer
+ (insert "あ\nい\nう\nえ\nお\n")
+ (should (= (count-lines (point) (point)) 0))))
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
diff --git a/test/manual/cedet/cedet-utests.el
b/test/manual/cedet/cedet-utests.el
index 7805fce..e421054 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -26,7 +26,6 @@
;; into one command.
(require 'cedet)
-(require 'inversion)
(defvar cedet-utest-directory
(let* ((C (file-name-directory (locate-library "cedet")))
@@ -36,7 +35,6 @@
(defvar cedet-utest-libs '("ede-tests"
"semantic-tests"
- "srecode-tests"
)
"List of test srcs that need to be loaded.")
@@ -48,7 +46,7 @@
;;
;; Test inversion
- ("inversion" . inversion-unit-test)
+ ;; ("inversion" . inversion-unit-test) ; moved to automated suite
;; EZ Image dumping.
("ezimage associations" . ezimage-image-association-dump)
@@ -60,7 +58,7 @@
("pulse interactive test" . (lambda () (pulse-test t)))
;; Files
- ("cedet file conversion" . cedet-files-utest)
+ ;; ("cedet file conversion" . cedet-files-utest) ; moved to automated suite
;;
;; EIEIO
@@ -100,14 +98,14 @@
(message " ** Skipping test in noninteractive mode.")
(semantic-test-throw-on-input))))
- ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
+ ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
; moved to automated suite
;;
;; SRECODE
;;
;; TODO - fix the fields test
- ;;("srecode: fields" . srecode-field-utest)
+ ;;("srecode: fields" . srecode-field-utest) ; moved to automated suite
;;("srecode: templates" . srecode-utest-template-output)
("srecode: show maps" . srecode-get-maps)
;;("srecode: getset" . srecode-utest-getset-output)
@@ -376,7 +374,7 @@ Optional argument PRECR indicates to prefix the done msg w/
a newline."
(cedet-utest-add-log-item-start testname)
))
-(defun cedet-utest-log(format &rest args)
+(defun cedet-utest-log (format &rest args)
"Log the text string FORMAT.
The rest of the ARGS are used to fill in FORMAT with `format'."
(if noninteractive
@@ -392,99 +390,6 @@ The rest of the ARGS are used to fill in FORMAT with
`format'."
(cedet-utest-show-log-end)
)
-;;; Inversion tests
-
-(defun inversion-unit-test ()
- "Test inversion to make sure it can identify different version strings."
- (interactive)
- (let ((c1 (inversion-package-version 'inversion))
- (c1i (inversion-package-incompatibility-version 'inversion))
- (c2 (inversion-decode-version "1.3alpha2"))
- (c3 (inversion-decode-version "1.3beta4"))
- (c4 (inversion-decode-version "1.3 beta5"))
- (c5 (inversion-decode-version "1.3.4"))
- (c6 (inversion-decode-version "2.3alpha"))
- (c7 (inversion-decode-version "1.3"))
- (c8 (inversion-decode-version "1.3pre1"))
- (c9 (inversion-decode-version "2.4 (patch 2)"))
- (c10 (inversion-decode-version "2.4 (patch 3)"))
- (c11 (inversion-decode-version "2.4.2.1"))
- (c12 (inversion-decode-version "2.4.2.2"))
- )
- (if (not (and
- (inversion-= c1 c1)
- (inversion-< c1i c1)
- (inversion-< c2 c3)
- (inversion-< c3 c4)
- (inversion-< c4 c5)
- (inversion-< c5 c6)
- (inversion-< c2 c4)
- (inversion-< c2 c5)
- (inversion-< c2 c6)
- (inversion-< c3 c5)
- (inversion-< c3 c6)
- (inversion-< c7 c6)
- (inversion-< c4 c7)
- (inversion-< c2 c7)
- (inversion-< c8 c6)
- (inversion-< c8 c7)
- (inversion-< c4 c8)
- (inversion-< c2 c8)
- (inversion-< c9 c10)
- (inversion-< c10 c11)
- (inversion-< c11 c12)
- ;; Negatives
- (not (inversion-< c3 c2))
- (not (inversion-< c4 c3))
- (not (inversion-< c5 c4))
- (not (inversion-< c6 c5))
- (not (inversion-< c7 c2))
- (not (inversion-< c7 c8))
- (not (inversion-< c12 c11))
- ;; Test the tester on inversion
- (not (inversion-test 'inversion inversion-version))
- ;; Test that we throw an error
- (inversion-test 'inversion "0.0.0")
- (inversion-test 'inversion "1000.0")
- ))
- (error "Inversion tests failed")
- (message "Inversion tests passed."))))
-
-;;; cedet-files unit test
-
-(defvar cedet-files-utest-list
- '(
- ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
- ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
- ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
- ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
- )
- "List of different file names to test.
-Each entry is a cons cell of ( FNAME . CONVERTED )
-where FNAME is some file name, and CONVERTED is what it should be
-converted into.")
-
-(defun cedet-files-utest ()
- "Test out some file name conversions."
- (interactive)
- (let ((idx 0))
- (dolist (FT cedet-files-utest-list)
-
- (setq idx (+ idx 1))
-
- (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
- (file->dir (cedet-file-name-to-directory-name (cdr FT) t))
- )
-
- (unless (string= (cdr FT) dir->file)
- (error "Failed: %d. Found: %S Wanted: %S"
- idx dir->file (cdr FT))
- )
-
- (unless (string= file->dir (car FT))
- (error "Failed: %d. Found: %S Wanted: %S"
- idx file->dir (car FT)))))))
-
;;; pulse test
(defun pulse-test (&optional no-error)
diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el
index eb31323..2af5086 100644
--- a/test/manual/cedet/ede-tests.el
+++ b/test/manual/cedet/ede-tests.el
@@ -1,4 +1,4 @@
-;;; ede-tests.el --- Some tests for the Emacs Development Environment
+;;; ede-tests.el --- Some tests for the Emacs Development Environment -*-
lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -42,8 +42,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-global (file)
"Test EDE Locate on FILE using GNU Global type.
@@ -55,8 +54,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-idutils (file)
"Test EDE Locate on FILE using ID Utils type.
@@ -68,8 +66,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-cscope (file)
"Test EDE Locate on FILE using CScope type.
@@ -81,7 +78,6 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
;;; ede-test.el ends here
diff --git a/test/manual/cedet/semantic-tests.el
b/test/manual/cedet/semantic-tests.el
index 716bcc7..3d72fa2 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -138,21 +138,6 @@ Optional argument ARG specifies not to use color."
(require 'semantic/fw)
-(defun semantic-test-data-cache ()
- "Test the data cache."
- (interactive)
- (let ((data '(a b c)))
- (save-excursion
- (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
- (erase-buffer)
- (insert "The Moose is Loose")
- (goto-char (point-min))
- (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
- data 'moose 'exit-cache-zone)
- (if (equal (semantic-get-cache-data 'moose) data)
- (message "Successfully retrieved cached data.")
- (error "Failed to retrieve cached data")))))
-
(defun semantic-test-throw-on-input ()
"Test that throw on input will work."
(interactive)
@@ -281,110 +266,3 @@ tag that contains point, and return that."
Lcount (semantic-tag-name target)
(semantic-elapsed-time start nil)))
Lcount)))
-
-;;; From bovine-gcc:
-
-(require 'semantic/bovine/gcc)
-
-;; Example output of "gcc -v"
-(defvar semantic-gcc-test-strings
- '(;; My old box:
- "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--host=i386-redhat-linux
-Thread model: posix
-gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
- ;; Alex Ott:
- "Using built-in specs.
-Target: i486-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1'
--with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-chec [...]
-Thread model: posix
-gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
- ;; My debian box:
- "Using built-in specs.
-Target: x86_64-unknown-linux-gnu
-Configured with: ../../../sources/gcc/configure
--prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3
--with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr
--enable-languages=c,c++,fortran
--with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as
--with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
-Thread model: posix
-gcc version 4.2.3"
- ;; My mac:
- "Using built-in specs.
-Target: i686-apple-darwin8
-Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure
--disable-checking -enable-werror --prefix=/usr --mandir=/share/man
--enable-languages=c,objc,c++,obj-c++
--program-transform-name=/^[cg][^.-]*$/s/$/-4.0/
--with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib
--build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott
--program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
-Thread model: posix
-gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
- ;; Ubuntu Intrepid
- "Using built-in specs.
-Target: x86_64-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-checking=release --build [...]
-Thread model: posix
-gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Red Hat EL4
- "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--disable-checking --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
-Thread model: posix
-gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
- ;; Red Hat EL5
- "Using built-in specs.
-Target: x86_64-redhat-linux
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man
--infodir=/usr/share/info --enable-shared --enable-threads=posix
--enable-checking=release --with-system-zlib --enable-__cxa_atexit
--disable-libunwind-exceptions --enable-libgcj-multifile
--enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk
--disable-dssi --enable-plugin
--with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic
--host=x86_64-redhat-linux
-Thread model: posix
-gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
- ;; David Engster's german gcc on ubuntu 4.3
- "Es werden eingebaute Spezifikationen verwendet.
-Ziel: i486-linux-gnu
-Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu
4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3
--program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug
--enable-objc-gc --enable-mpfr --enable-targets=all --enable-ch [...]
-Thread-Modell: posix
-gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Damien Deville bsd
- "Using built-in specs.
-Target: i386-undermydesk-freebsd
-Configured with: FreeBSD/i386 system compiler
-Thread model: posix
-gcc version 4.2.1 20070719 [FreeBSD]"
- )
- "A bunch of sample gcc -v outputs from different machines.")
-
-(defvar semantic-gcc-test-strings-fail
- '(;; A really old solaris box I found
- "Reading specs from
/usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
-gcc version 2.95.2 19991024 (release)"
- )
- "A bunch of sample gcc -v outputs that fail to provide the info we want.")
-
-(defun semantic-gcc-test-output-parser ()
- "Test the output parser against some collected strings."
- (interactive)
- (let ((fail nil))
- (dolist (S semantic-gcc-test-strings)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc 'target fields))
- (cdr (assoc '--target fields))
- (cdr (assoc '--host fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- ;; No longer test for prefixes.
- (when (not (and v h))
- (let ((strs (split-string S "\n")))
- (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
- (setq fail t))
- ))
- (dolist (S semantic-gcc-test-strings-fail)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc '--host fields))
- (cdr (assoc 'target fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- (when (and v h p)
- (message "Negative test failed on %S" S)
- (setq fail t))
- ))
- (if (not fail) (message "Tests passed."))
- ))
-
-(defun semantic-gcc-test-output-parser-this-machine ()
- "Test the output parser against the machine currently running Emacs."
- (interactive)
- (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
- (semantic-gcc-test-output-parser))
- )
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index 3bc945d..a54c253 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -1,4 +1,4 @@
-;;; test.el --- Unit test file for Semantic Emacs Lisp support.
+;;; test.el --- Unit test file for Semantic Emacs Lisp support. -*-
lexical-binding: t -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 3de1551..e6b060f 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -2143,11 +2143,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1035
diff --git a/test/manual/etags/el-src/TAGTEST.EL
b/test/manual/etags/el-src/TAGTEST.EL
index 89a6791..3e6599a 100644
--- a/test/manual/etags/el-src/TAGTEST.EL
+++ b/test/manual/etags/el-src/TAGTEST.EL
@@ -1,3 +1,5 @@
+;;; -*- lexical-binding: t -*-
+
(foo::defmumble bletch beuarghh)
(defun foo==bar () (message "hi")) ; Bug#5624
;;; Ctags test file for lisp mode.