diff options
Diffstat (limited to 'lisp/cedet')
50 files changed, 328 insertions, 330 deletions
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index e6befb10e91..c33ac850722 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -25,15 +25,12 @@ ;;; Commentary: ;;; Code: -;; -;; This file depends on the major components of CEDET, so that you can -;; load them all by doing (require 'cedet). This is mostly for -;; compatibility with the upstream, stand-alone CEDET distribution. (declare-function inversion-find-version "inversion") (defconst cedet-version "2.0" "Current version of CEDET.") +(make-obsolete-variable 'cedet-version 'emacs-version "29.1") (defconst cedet-packages `( @@ -45,6 +42,7 @@ (ede "1.2" nil "ede" ) ) "Table of CEDET packages to install.") +(make-obsolete-variable 'cedet-packages 'package-built-in-p "29.1") (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu"))) diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index 0edc853edda..e7635c0aec5 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -854,7 +854,6 @@ If PARENT is non-nil, it is somehow related as a parent to thing." table) "Syntax table used in data-debug macro buffers.") -(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1") (defvar data-debug-mode-map (let ((km (make-sparse-keymap))) (suppress-keymap km) @@ -1028,11 +1027,9 @@ Do nothing if already contracted." (defun data-debug-edebug-expr (expr) "Dump out the contents of some expression EXPR in edebug with ddebug." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)) - )) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let ((v (eval expr t))) (if (not v) (message "Expression %s is nil." expr) @@ -1043,10 +1040,9 @@ Do nothing if already contracted." If the result is something simple, show it in the echo area. If the result is a list or vector, then use the data debugger to display it." (interactive - (list (let ((minibuffer-completing-symbol t)) - (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history)))) + (list (read-from-minibuffer "Eval: " + nil read-expression-map t + 'read-expression-history))) (let (result) (if (null eval-expression-debug-on-error) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 4ea14e33c5d..e6bfd0b1e85 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1,10 +1,10 @@ ;;; ede.el --- Emacs Development Environment gloss -*- lexical-binding: t; -*- -;; Copyright (C) 1998-2005, 2007-2022 Free Software Foundation, Inc. +;; Copyright (C) 1998-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make -;; Version: 1.2 +;; Version: 2.0 ;; This file is part of GNU Emacs. @@ -39,6 +39,8 @@ ;; ;; (global-ede-mode t) +;;; Code: + (require 'cedet) (require 'cl-lib) (require 'eieio) @@ -66,10 +68,11 @@ (defconst ede-version "2.0" "Current version of the Emacs EDE.") +(make-obsolete-variable 'ede-version 'emacs-version "29.1") -;;; Code: (defun ede-version () "Display the current running version of EDE." + (declare (obsolete emacs-version "29.1")) (interactive) (message "EDE %s" ede-version)) (defgroup ede nil diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index 7af9987de17..7e3cac616fd 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -234,6 +234,7 @@ type is required and the load function used.") (display-buffer b) )) +;;;###autoload (defun ede-add-project-autoload (projauto &optional flag) "Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'. Optional argument FLAG indicates how this autoload should be diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 9d23909d62e..9182fcd5ac9 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -141,7 +141,7 @@ For some project types, this will be the file that stores the project configurat In other projects types, this file is merely a unique identifier to this type of project.") (rootproject ; :initarg - no initarg, don't save this slot! :initform nil - :type (or null ede-project-placeholder-child) + :type (or null ede-project-placeholder) :documentation "Pointer to our root project.") ) "Placeholder object for projects not loaded into memory. @@ -171,7 +171,7 @@ For Automake based projects, each directory is treated as a project.") :label "Local Targets" :group (targets) :documentation "List of top level targets in this project.") - (locate-obj :type (or null ede-locate-base-child) + (locate-obj :type (or null ede-locate-base) :documentation "A locate object to use as a backup to `ede-expand-filename'.") (tool-cache :initarg :tool-cache @@ -204,7 +204,7 @@ This is a URL to be sent to a web site for documentation.") :group name :documentation "A directory where web pages can be found by Emacs. -For remote locations use a path compatible with ange-ftp or EFS. +For remote locations use a path compatible with ange-ftp. You can also use TRAMP for use with rcp & scp.") (web-site-file :initarg :web-site-file :initform "" @@ -214,7 +214,7 @@ You can also use TRAMP for use with rcp & scp.") :documentation "A file which contains the website for this project. This file can be relative to slot `web-site-directory'. -This can be a local file, use ange-ftp, EFS, or TRAMP.") +This can be a local file, use ange-ftp or TRAMP.") (ftp-site :initarg :ftp-site :initform "" :type string diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el index 529b96f2b00..8c4f52647bc 100644 --- a/lisp/cedet/ede/config.el +++ b/lisp/cedet/ede/config.el @@ -65,7 +65,7 @@ (defclass ede-extra-config (eieio-persistent) ((extension :initform ".ede") (file-header-line :initform ";; EDE Project Configuration") - (project :type ede-project-with-config-child + (project :type ede-project-with-config :documentation "The project this config is bound to.") (ignored-file :initform nil @@ -102,7 +102,7 @@ initialize the :file slot of the persistent baseclass.") :documentation "The class of the configuration used by this project.") (config :initform nil - :type (or null ede-extra-config-child) + :type (or null ede-extra-config) :documentation "The configuration object for this project.") ) diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index 2d4f408e961..0854c8cc47f 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el @@ -35,7 +35,9 @@ (require 'ede) (eval-when-compile (require 'eieio-custom)) -(defvar eieio-ede-old-variables nil +(define-obsolete-variable-alias 'ede-eieio-old-variables + 'eieio-ede-old-variables "29.1") +(defvar ede-eieio-old-variables nil "The old variables for a project.") ;;; Customization Commands @@ -50,7 +52,7 @@ (let* ((ov (oref (ede-current-project) local-variables)) (cp (ede-current-project))) (ede-customize cp) - (setq-local eieio-ede-old-variables ov))) + (setq-local ede-eieio-old-variables ov))) ;;;###autoload (defalias 'customize-project #'ede-customize-project) @@ -178,9 +180,9 @@ OBJ is the target object to customize." ;; These hooks are used when finishing up a customization. (cl-defmethod eieio-done-customizing ((proj ede-project)) "Call this when a user finishes customizing PROJ." - (let ((ov eieio-ede-old-variables) + (let ((ov ede-eieio-old-variables) (nv (oref proj local-variables))) - (setq eieio-ede-old-variables nil) + (setq ede-eieio-old-variables nil) (while ov (if (not (assoc (car (car ov)) nv)) (save-excursion diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 5a23f504f78..c83e6873679 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -59,7 +59,7 @@ Return a tuple of ( EMACSNAME . VERSION )." (file-exists-p (setq configure_ac "configure.in"))) (insert-file-contents configure_ac) (goto-char (point-min)) - (re-search-forward "AC_INIT(\\(?:GNU \\)?[eE]macs,\\s-*\\([0-9.]+\\)\\s-*[,)]") + (re-search-forward "AC_INIT(\\[?\\(?:GNU \\)?[eE]macs]?,\\s-*\\[?\\([0-9.]+\\)]?\\s-*[,)]") (setq ver (match-string 1)) ) ) @@ -80,7 +80,6 @@ ROOTPROJ is nil, since there is only one project." ;; Doesn't already exist, so let's make one. (let* ((vertuple (ede-emacs-version dir))) (ede-emacs-project - (car vertuple) :name (car vertuple) :version (cdr vertuple) :directory (file-name-as-directory dir) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 3b9002a6e31..e44ddea32f6 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -257,7 +257,7 @@ If optional EXACT is non-nil, only return exact matches for DIR." (defun ede-flush-directory-hash () "Flush the project directory hash. Do this only when developing new projects that are incorrectly putting -'nomatch tokens into the hash." +`nomatch' tokens into the hash." (interactive) (setq ede-project-directory-hash (make-hash-table :test 'equal)) ;; Also slush the current project's locator hash. @@ -340,7 +340,7 @@ Optional FORCE means to ignore the hash of known directories." ;; ;; These utilities will identify the "toplevel" of a project. ;; -;; NOTE: These two -toplevel- functions return a directory even though +;; NOTE: This -toplevel- function returns a directory even though ;; the function name implies a project. (defun ede-toplevel-project (dir) @@ -365,8 +365,6 @@ If DIR is not part of a project, return nil." (t nil)))) -(defalias 'ede-toplevel-project-or-nil #'ede-toplevel-project) - ;;; DIRECTORY CONVERSION STUFF ;; (cl-defmethod ede-convert-path ((this ede-project) path) @@ -535,6 +533,7 @@ Argument DIR is the directory to trim upwards." nil fnd))) +(define-obsolete-function-alias 'ede-toplevel-project-or-nil #'ede-toplevel-project "29.1") (provide 'ede/files) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 0c65af15c4a..7c56ca19936 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -319,8 +319,7 @@ Lays claim to all .elc files that match .el files in this target." ("require" . "$(foreach r,$(1),(require (quote $(r))))")) :commands '("$(EMACS) $(EMACSFLAGS) $(addprefix -L ,$(LOADPATH)) \ ---eval '(setq generated-autoload-file \"$(abspath $(LOADDEFS))\")' \ --f batch-update-autoloads $(abspath $(LOADDIRS))") +-f loaddefs-generate-batch $(abspath $(LOADDEFS)) $(abspath $(LOADDIRS))") :rules (list (ede-makefile-rule :target "clean-autoloads" :phony t :rules '("rm -f $(LOADDEFS)"))) :sourcetype '(ede-source-emacs) ) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 2803e1c3071..544e39b8729 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -191,8 +191,9 @@ other meta-variable based on this name.") "Encode one makefile.") ;;; Code: -(cl-defmethod project-add-file ((ot project-am-target)) +(cl-defmethod project-add-file ((ot project-am-target) &optional _file) "Add the current buffer into a project. +_FILE is ignored. OT is the object target. DIR is the directory to start in." (let* ((target (if ede-object (error "Already associated w/ a target") (let ((amf (project-am-load default-directory))) diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index f99a1d114b1..604b660344c 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -62,7 +62,7 @@ (defvar ede-speedbar-menu '([ "Compile" ede-speedbar-compile-line t] [ "Compile Project" ede-speedbar-compile-project - (ede-project-child-p (speedbar-line-token)) ] + (cl-typep (speedbar-line-token) 'ede-project) ] "---" [ "Edit File/Tag" speedbar-edit-line (not (eieio-object-p (speedbar-line-token)))] @@ -79,7 +79,7 @@ (eieio-object-p (speedbar-line-token)) ] [ "Edit Project File" ede-speedbar-edit-projectfile t] [ "Make Distribution" ede-speedbar-make-distribution - (ede-project-child-p (speedbar-line-token)) ] + (cl-typep (speedbar-line-token) 'ede-project) ] ) "Menu part in easymenu format used in speedbar while browsing objects.") diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el index 2da16b37d72..b4fc95c6073 100644 --- a/lisp/cedet/ede/system.el +++ b/lisp/cedet/ede/system.el @@ -133,7 +133,7 @@ Download tramp, and use /r:machine: for names on remote sites w/out FTP access." (defun ede-vc-project-directory () "Run `vc-dir' on the current project." (interactive) - (let ((top (ede-toplevel-project-or-nil default-directory))) + (let ((top (ede-toplevel-project default-directory))) (vc-dir top nil))) (provide 'ede/system) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index f1fdcbca1ad..ce37a28c351 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -156,7 +156,7 @@ local variables have been defined." DOCSTRING is optional and not used. To work properly, this should be put after PARENT mode local variables definition." - (declare (obsolete define-derived-mode "27.1")) + (declare (obsolete define-derived-mode "27.1") (indent 2)) `(mode-local--set-parent ',mode ',parent)) (defun mode-local-use-bindings-p (this-mode desired-mode) @@ -567,6 +567,7 @@ appropriate arguments deduced from ARGS. OVERARGS is a list of arguments passed to the override and `NAME-default' function, in place of those deduced from ARGS." (declare (doc-string 3) + (indent defun) (debug (&define name lambda-list stringp def-body))) `(eval-and-compile (defun ,name ,args @@ -595,6 +596,7 @@ DOCSTRING is the documentation string. BODY is the implementation of this function." ;; FIXME: Make this obsolete and use cl-defmethod with &context instead. (declare (doc-string 4) + (indent defun) (debug (&define name symbolp lambda-list stringp def-body))) (let ((newname (intern (format "%s-%s" name mode)))) `(progn @@ -875,10 +877,9 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)." "Display mode local bindings active in BUFFER-OR-MODE. Optional argument INTERACTIVE-P is non-nil if the calling command was invoked interactively." - (when (fboundp 'help-setup-xref) - (help-setup-xref - (list 'mode-local-describe-bindings-1 buffer-or-mode) - interactive-p)) + (help-setup-xref + (list 'mode-local-describe-bindings-1 buffer-or-mode) + interactive-p) (with-output-to-temp-buffer (help-buffer) ; "*Help*" (with-current-buffer standard-output (mode-local-describe-bindings-2 buffer-or-mode)))) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index dc6751db6cf..3166279de40 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -34,6 +34,8 @@ ;; menu). To enable it at startup, put (semantic-mode 1) in your init ;; file. +;;; Code: + (require 'cedet) (require 'semantic/tag) (require 'semantic/lex) @@ -41,6 +43,7 @@ (defvar semantic-version "2.2" "Current version of Semantic.") +(make-obsolete-variable 'semantic-version 'emacs-version "29.1") (declare-function inversion-test "inversion") (declare-function semanticdb-load-ebrowse-caches "semantic/db-ebrowse") @@ -73,9 +76,6 @@ introduced." (require 'semantic/fw) -;;; Code: -;; - ;;; Variables and Configuration ;; (defvar-local semantic--parse-table nil @@ -497,8 +497,8 @@ is requested." (defvar semantic-working-type 'percent "The type of working message to use when parsing. -'percent means we are doing a linear parse through the buffer. -'dynamic means we are reparsing specific tags.") +`percent' means we are doing a linear parse through the buffer. +`dynamic' means we are reparsing specific tags.") (defvar semantic-minimum-working-buffer-size (* 1024 5) "The minimum size of a buffer before working messages are displayed. diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 1e52b1f8504..a6cf8d89a4f 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -143,14 +143,14 @@ list of semantic tokens found." cvl nil ;re-init the collected value list. lte (car matchlist) ;Get the local matchlist entry. ) - (if (or (byte-code-function-p (car lte)) + (if (or (compiled-function-p (car lte)) (listp (car lte))) ;; In this case, we have an EMPTY match! Make ;; stuff up. (setq cvl (list nil)))) (while (and lte - (not (byte-code-function-p (car lte))) + (not (compiled-function-p (car lte))) (not (listp (car lte)))) ;; GRAMMAR SOURCE DEBUGGING! diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index e099ef7902e..ee1cbcad4da 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -1466,36 +1466,32 @@ Override function for `semantic-tag-protection'." (prot nil)) ;; Check the modifiers for protection if we are not a child ;; of some class type. - (when (or (not parent) (not (eq (semantic-tag-class parent) 'type))) - (while (and (not prot) mods) - (if (stringp (car mods)) - (let ((s (car mods))) - ;; A few silly defaults to get things started. - (cond ((or (string= s "extern") - (string= s "export")) - 'public) - ((string= s "static") - 'private)))) - (setq mods (cdr mods)))) - ;; If we have a typed parent, look for :public style labels. - (when (and parent (eq (semantic-tag-class parent) 'type)) + (if (not (and parent (eq (semantic-tag-class parent) 'type))) + (while (and (not prot) mods) + (if (stringp (car mods)) + (let ((s (car mods))) + ;; A few silly defaults to get things started. + (setq prot (pcase s + ((or "extern" "export") 'public) + ("static" 'private))))) + (setq mods (cdr mods))) + ;; If we have a typed parent, look for :public style labels. (let ((pp (semantic-tag-type-members parent))) (while (and pp (not (semantic-equivalent-tag-p (car pp) tag))) (when (eq (semantic-tag-class (car pp)) 'label) (setq prot - (cond ((string= (semantic-tag-name (car pp)) "public") - 'public) - ((string= (semantic-tag-name (car pp)) "private") - 'private) - ((string= (semantic-tag-name (car pp)) "protected") - 'protected))) + (pcase (semantic-tag-name (car pp)) + ("public" 'public) + ("private" 'private) + ("protected" 'protected))) ) (setq pp (cdr pp))))) (when (and (not prot) (eq (semantic-tag-class parent) 'type)) (setq prot - (cond ((string= (semantic-tag-type parent) "class") 'private) - ((string= (semantic-tag-type parent) "struct") 'public) - (t 'unknown)))) + (pcase (semantic-tag-type parent) + ("class" 'private) + ("struct" 'public) + (_ 'unknown)))) (or prot (if (and parent (semantic-tag-of-class-p parent 'type)) 'public diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index d478b12f645..67366ad445e 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -260,7 +260,8 @@ QUOTEMODE is the mode in which quoted symbols are slurred." (insert ")\n"))) ) -(defun bovine-grammar-parsetable-builder () +(define-mode-local-override semantic-grammar-parsetable-builder + bovine-grammar-mode () "Return the parser table expression as a string value. The format of a bovine parser table is: @@ -409,7 +410,8 @@ The source directory is relative to some root in the load path." newdir)) (error (buffer-name)))) -(defun bovine-grammar-setupcode-builder () +(define-mode-local-override semantic-grammar-setupcode-builder + bovine-grammar-mode () "Return the text of the setup code." (format "(setq semantic--parse-table %s\n\ @@ -435,10 +437,7 @@ Menu items are appended to the common grammar menu.") ;;;###autoload (define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY" "Major mode for editing Bovine grammars." - (semantic-grammar-setup-menu bovine-grammar-menu) - (semantic-install-function-overrides - '((semantic-grammar-parsetable-builder . bovine-grammar-parsetable-builder) - (semantic-grammar-setupcode-builder . bovine-grammar-setupcode-builder)))) + (semantic-grammar-setup-menu bovine-grammar-menu)) (add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode)) @@ -461,7 +460,7 @@ Menu items are appended to the common grammar menu.") (defun bovine--make-parser-1 (infile &optional outdir) (if outdir (setq outdir (file-name-directory (expand-file-name outdir)))) ;; It would be nicer to use a temp-buffer rather than find-file-noselect. - ;; The only thing stopping us is bovine-grammar-setupcode-builder's + ;; The only thing stopping us is bovine's semantic-grammar-setupcode-builder's ;; use of (buffer-name). Perhaps that could be changed to ;; (file-name-nondirectory (buffer-file-name)) ? ;; (with-temp-buffer diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 5969232a054..dc270603a0c 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -224,11 +224,10 @@ HISTORY is a symbol representing a variable to story the history in." ;; @todo - move from () to into the editable area (if (string-match ":" prompt) - (setq prompt (concat - (substring prompt 0 (match-beginning 0)) - " (default " default-as-string ")" - (substring prompt (match-beginning 0)))) - (setq prompt (concat prompt " (" default-as-string "): ")))) + (setq prompt (format-prompt + (substring prompt 0 (match-beginning 0)) + default-as-string)) + (setq prompt (format-prompt prompt default-as-string)))) ;; ;; Perform the Completion ;; @@ -312,11 +311,43 @@ HISTORY is a symbol representing a variable to story the history in." (defvar semantic-complete-current-matched-tag nil "Variable used to pass the tags being matched to the prompt.") -;; semantic-displayer-focus-abstract-child-p is part of the -;; semantic-displayer-focus-abstract class, defined later in this -;; file. -(declare-function semantic-displayer-focus-abstract-child-p "semantic/complete" - t t) + + +;; Abstract baseclass for any displayer which supports focus + +(defclass semantic-displayer-abstract () + ((table :type (or null semanticdb-find-result-with-nil) + :initform nil + :protection :protected + :documentation "List of tags this displayer is showing.") + (last-prefix :type string + :protection :protected + :documentation "Prefix associated with slot `table'.") + ) + "Abstract displayer baseclass. +Manages the display of some number of tags. +Provides the basics for a displayer, including interacting with +a collector, and tracking tables of completion to display." + :abstract t) + +(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) + ((focus :type number + :protection :protected + :documentation "A tag index from `table' which has focus. +Multiple calls to the display function can choose to focus on a +given tag, by highlighting its location.") + (find-file-focus + :allocation :class + :initform nil + :documentation + "Non-nil if focusing requires a tag's buffer be in memory.") + ) + "Abstract displayer supporting `focus'. +A displayer which has the ability to focus in on one tag. +Focusing is a way of differentiating among multiple tags +which have the same name." + :abstract t) + (defun semantic-complete-current-match () "Calculate a match from the current completion environment. @@ -347,7 +378,7 @@ Return value can be: ((setq matchlist (semantic-collector-current-exact-match collector)) (if (= (semanticdb-find-result-length matchlist) 1) (setq answer (semanticdb-find-result-nth-in-buffer matchlist 0)) - (if (semantic-displayer-focus-abstract-child-p displayer) + (if (cl-typep displayer 'semantic-displayer-focus-abstract) ;; For focusing displayers, we can claim this is ;; not unique. Multiple focuses can choose the correct ;; one. @@ -1012,20 +1043,14 @@ Output must be in semanticdb Find result format." (oref obj last-prefix))) (completionlist (cond ((or same-prefix-p - (and last-prefix (eq (compare-strings - last-prefix 0 nil - prefix 0 (length last-prefix)) - t))) + (and last-prefix (string-prefix-p last-prefix prefix t))) ;; We have the same prefix, or last-prefix is a ;; substring of the of new prefix, in which case we are ;; refining our symbol so just re-use cache. (oref obj last-all-completions)) ((and last-prefix (> (length prefix) 1) - (eq (compare-strings - prefix 0 nil - last-prefix 0 (length prefix)) - t)) + (string-prefix-p prefix last-prefix t)) ;; The new prefix is a substring of the old ;; prefix, and it's longer than one character. ;; Perform a full search to pull in additional @@ -1308,21 +1333,6 @@ Uses semanticdb for searching all tags in the current project." ;; * semantic-displayer-scroll-request ;; * semantic-displayer-focus-request -(defclass semantic-displayer-abstract () - ((table :type (or null semanticdb-find-result-with-nil) - :initform nil - :protection :protected - :documentation "List of tags this displayer is showing.") - (last-prefix :type string - :protection :protected - :documentation "Prefix associated with slot `table'.") - ) - "Abstract displayer baseclass. -Manages the display of some number of tags. -Provides the basics for a displayer, including interacting with -a collector, and tracking tables of completion to display." - :abstract t) - (define-obsolete-function-alias 'semantic-displayor-cleanup #'semantic-displayer-cleanup "27.1") (cl-defmethod semantic-displayer-cleanup ((_obj semantic-displayer-abstract)) @@ -1414,24 +1424,7 @@ to click on the items to aid in completion.") ) ) -;;; Abstract baseclass for any displayer which supports focus -(defclass semantic-displayer-focus-abstract (semantic-displayer-abstract) - ((focus :type number - :protection :protected - :documentation "A tag index from `table' which has focus. -Multiple calls to the display function can choose to focus on a -given tag, by highlighting its location.") - (find-file-focus - :allocation :class - :initform nil - :documentation - "Non-nil if focusing requires a tag's buffer be in memory.") - ) - "Abstract displayer supporting `focus'. -A displayer which has the ability to focus in on one tag. -Focusing is a way of differentiating among multiple tags -which have the same name." - :abstract t) +;;; Methods for any displayer which supports focus (define-obsolete-function-alias 'semantic-displayor-next-action #'semantic-displayer-next-action "27.1") @@ -1639,8 +1632,10 @@ This will not happen if you directly set this variable via `setq'." :set (lambda (sym var) (set-default sym var) (when (boundp 'x-max-tooltip-size) - (setcdr x-max-tooltip-size (max (1+ var) (cdr x-max-tooltip-size)))))) - + (if (not (consp x-max-tooltip-size)) + (setq x-max-tooltip-size '(80 . 40))) + (setcdr x-max-tooltip-size + (max (1+ var) (cdr x-max-tooltip-size)))))) (defclass semantic-displayer-tooltip (semantic-displayer-traditional) ((mode :initarg :mode @@ -1762,7 +1757,8 @@ Return a cons cell (X . Y)." (defvar tooltip-frame-parameters) -(declare-function tooltip-show "tooltip" (text &optional use-echo-area)) +(declare-function tooltip-show "tooltip" (text &optional use-echo-area + text-face default-face)) (defun semantic-displayer-tooltip-show (text) "Display a tooltip with TEXT near cursor." diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 73ef37ea2aa..02ebde40785 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -213,9 +213,7 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) nil ;; return type (semantic-elisp-desymbolify arglist) - :user-visible-flag (condition-case nil - (interactive-form sym) - (error nil))))) + :user-visible-flag (commandp sym)))) ((and (eq toktype 'variable) (boundp sym)) (semantic-tag-new-variable (symbol-name sym) diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index d00ab47ce69..e2c9d618ba2 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -29,7 +29,7 @@ (require 'cedet-files) (require 'data-debug) -(defvar semanticdb-file-version semantic-version +(defvar semanticdb-file-version "2.2" "Version of semanticdb we are writing files to disk with.") (defvar semanticdb-file-incompatible-version "1.4" "Version of semanticdb we are not reverse compatible with.") diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 38caac2292c..efc1ab2c5f9 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -362,7 +362,7 @@ a master list." ;; don't include ourselves in this crazy list. (when (and i (not (eq i table)) ;; @todo - This eieio fcn can be slow! Do I need it? - ;; (semanticdb-table-child-p i) + ;; (cl-typep i 'semanticdb-table) ) (setq incstream (semanticdb-typecache-merge-streams diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 7f25a848918..ff62f53d3cf 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -115,11 +115,13 @@ for a new table not associated with a buffer." "Return a nil, meaning abstract table OBJ is not in a buffer." nil) -(cl-defmethod semanticdb-get-buffer ((_obj semanticdb-abstract-table)) - "Return a buffer associated with OBJ. +(cl-defgeneric semanticdb-get-buffer (_obj) + "Return a buffer associated with semanticdb table OBJ. If the buffer is not in memory, load it with `find-file-noselect'." nil) +;; FIXME: Should we merge `semanticdb-get-buffer' and +;; `semantic-tag-parent-buffer'? ;; This generic method allows for sloppier coding. Many ;; functions treat "table" as something that could be a buffer, ;; file name, or other. This makes use of table more robust. @@ -271,6 +273,9 @@ For C/C++, the C preprocessor macros can be saved here.") ) "A single table of tags derived from file.") +(cl-defmethod semantic-tag-parent-buffer ((parent semanticdb-table)) + (semanticdb-get-buffer parent)) ;FIXME: η-redex! + (cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table)) "Return a buffer associated with OBJ. If the buffer is in memory, return that buffer." @@ -609,7 +614,7 @@ The file associated with OBJ does not need to be in a buffer." (or (not (slot-boundp obj 'tags)) ;; (not (oref obj tags)) --> not needed anymore? (/= (or (oref obj fsize) 0) actualsize) - (not (equal (oref obj lastmodtime) actualmod)) + (not (time-equal-p (oref obj lastmodtime) actualmod)) ) )))) @@ -729,7 +734,7 @@ Exit the save between databases if there is user input." (defvar semanticdb-project-predicate-functions nil "List of predicates to try that indicate a directory belongs to a project. This list is used when `semanticdb-persistent-path' contains the value -'project. If the predicate list is nil, then presume all paths are valid. +`project'. If the predicate list is nil, then presume all paths are valid. Project Management software (such as EDE and JDE) should add their own predicates with `add-hook' to this variable, and semanticdb will save tag diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 41b50797221..ad215db0f63 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -391,6 +391,7 @@ etc., found in the semantic-decorate library. To add other kind of decorations on a tag, `NAME-highlight' must use `semantic-decorate-tag', and other functions of the semantic decoration API found in this library." + (declare (indent 1)) (let ((predicate (semantic-decorate-style-predicate name)) (highlighter (semantic-decorate-style-highlighter name)) (predicatedef (semantic-decorate-style-predicate-default name)) diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 38eb732e465..eb922a12507 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -82,6 +82,7 @@ users will customize. Creates a customizable variable users can customize that will keep semantic data structures up to date." + (declare (indent defun)) `(progn ;; Create a variable users can customize. (defcustom ,name ,value diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 76230d438a1..4679500ed99 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -610,7 +610,7 @@ This function is for internal use by `semantic-edits-incremental-parser'." (setq last-cond "Beginning of buffer") (setq parse-start ;; Don't worry about parents since - ;; there there would be an exact + ;; there would be an exact ;; match in the tag list otherwise ;; and the routine would fail. (point-min) diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index e894022315f..92644ce0066 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -591,7 +591,7 @@ in the new list. If optional argument SEARCH-PARTS is non-nil, all sub-parts of tags are searched. The overloadable function `semantic-tag-components' is used for the searching child lists. If SEARCH-PARTS is the symbol -'positiononly, then only children that have positional information are +`positiononly', then only children that have positional information are searched. If SEARCH-INCLUDES has not been implemented. diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 2ce6976d644..113323cb339 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -66,8 +66,6 @@ (defalias 'semantic-mode-line-update #'force-mode-line-update) -;; Since Emacs 22 major mode functions should use `run-mode-hooks' to -;; run major mode hooks. (define-obsolete-function-alias 'semantic-run-mode-hooks #'run-mode-hooks "28.1") ;; Fancy compat usage now handled in cedet-compat @@ -193,12 +191,20 @@ will throw a warning when it encounters this symbol." (not (string-match "cedet" (macroexp-file-name))) ) (make-obsolete-overload oldfnalias newfn when) - (byte-compile-warn - "%s: `%s' obsoletes overload `%s'" - (macroexp-file-name) - newfn - (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) - (semantic-overload-symbol-from-function oldfnalias))))) + (if (fboundp 'byte-compile-warn-x) + (byte-compile-warn-x + newfn + "%s: `%s' obsoletes overload `%s'" + (macroexp-file-name) + newfn + (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) + (semantic-overload-symbol-from-function oldfnalias))) + (byte-compile-warn + "%s: `%s' obsoletes overload `%s'" + (macroexp-file-name) + newfn + (with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function)) + (semantic-overload-symbol-from-function oldfnalias)))))) (defun semantic-varalias-obsolete (oldvaralias newvar when) "Make OLDVARALIAS an alias for variable NEWVAR. @@ -211,10 +217,14 @@ will throw a warning when it encounters this symbol." (error ;; Only throw this warning when byte compiling things. (when (macroexp-compiling-p) - (byte-compile-warn - "variable `%s' obsoletes, but isn't alias of `%s'" - newvar oldvaralias) - )))) + (if (fboundp 'byte-compile-warn-x) + (byte-compile-warn-x + newvar + "variable `%s' obsoletes, but isn't alias of `%s'" + newvar oldvaralias) + (byte-compile-warn + "variable `%s' obsoletes, but isn't alias of `%s'" + newvar oldvaralias)))))) ;;; Help debugging ;; @@ -277,7 +287,8 @@ later installation should be done in MODE hook." (cons (intern (format "semantic-%s" name)) (cdr e))))) overrides) (list 'constant-flag (not transient) - 'override-flag t))) + 'override-flag t) + nil)) ;;; User Interrupt handling ;; diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 74d4a229fac..97456265ead 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1123,8 +1123,6 @@ END is the limit of the search." ;;;; Define major mode ;;;; -(define-obsolete-variable-alias 'semantic-grammar-syntax-table - 'semantic-grammar-mode-syntax-table "24.1") (defvar semantic-grammar-mode-syntax-table (let ((table (make-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?\: "." table) ;; COLON @@ -1197,8 +1195,6 @@ END is the limit of the search." semantic-grammar-mode-keywords-1 "Font Lock keywords used to highlight Semantic grammar buffers.") -(define-obsolete-variable-alias 'semantic-grammar-map - 'semantic-grammar-mode-map "24.1") (defvar semantic-grammar-mode-map (let ((km (make-sparse-keymap))) diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el index f61bcbdef9a..376fab89c23 100644 --- a/lisp/cedet/semantic/grm-wy-boot.el +++ b/lisp/cedet/semantic/grm-wy-boot.el @@ -149,10 +149,10 @@ ((type_decl)) ((use_macros_decl))) (default_prec_decl - ((DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("t"))))) + ((DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("t"))))) (no_default_prec_decl ((NO-DEFAULT-PREC) `(wisent-raw-tag diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el index 718ce3c4c74..00e19dbc892 100644 --- a/lisp/cedet/semantic/html.el +++ b/lisp/cedet/semantic/html.el @@ -82,6 +82,11 @@ or tag :members (mapcar #'semantic-html-expand-tag chil))) (car (semantic--tag-expand tag)))) +(define-mode-local-override semantic-tag-components html-mode (tag) + "Return components belonging to TAG." + ;; Keep this η-regexp because `semantic-html-components' is called + ;; from elsewhere. + (semantic-html-components tag)) (defun semantic-html-components (tag) "Return components belonging to TAG." (semantic-tag-get-attribute tag :members)) @@ -245,12 +250,7 @@ tag with greater section value than LEVEL is found." senator-step-at-start-end-tag-classes '(section) senator-step-at-tag-classes '(section) semantic-stickyfunc-sticky-classes '(section) - ) - (semantic-install-function-overrides - '((semantic-tag-components . semantic-html-components) - ) - t) - ) + )) ;; `html-helper-mode' hasn't been updated since 2004, so it's not very ;; relevant nowadays. diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 235965a9955..37dc9632729 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -39,7 +39,8 @@ (require 'semantic/sort) (require 'imenu) -(declare-function pulse-momentary-highlight-one-line "pulse" (o &optional face)) +(declare-function pulse-momentary-highlight-one-line "pulse" + (&optional point face)) (declare-function semanticdb-semantic-init-hook-fcn "db-mode") ;; Because semantic imenu tags will hose the current imenu handling diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index a7c02032e22..53fd4de2975 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -37,25 +37,24 @@ ;;; Lexical analysis ;; (defconst semantic-java-number-regexp - (eval-when-compile - (concat "\\(" - "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][fFdD]\\>" - "\\|" - "\\<[0-9]+[.]" - "\\|" - "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<0[xX][[:xdigit:]]+[lL]?\\>" - "\\|" - "\\<[0-9]+[lLfFdD]?\\>" - "\\)" - )) + (concat "\\(" + "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][fFdD]\\>" + "\\|" + "\\<[0-9]+[.]" + "\\|" + "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<0[xX][[:xdigit:]]+[lL]?\\>" + "\\|" + "\\<[0-9]+[lLfFdD]?\\>" + "\\)" + ) "Lexer regexp to match Java number terminals. Following is the specification of Java number literals. @@ -391,7 +390,7 @@ That is TAG `symbol-name' without the leading `@'." Return the list of FUN results. If optional PROPERTY is non-nil only call FUN for javadoc keywords which have a value for PROPERTY. FUN receives two arguments: the javadoc keyword and its associated -'javadoc property list. It can return any value. All nil values are +`javadoc' property list. It can return any value. All nil values are removed from the result list." (delq nil (mapcar diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 5912a887848..4bdaaf77acf 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -726,7 +726,7 @@ Returns position with the end of that macro." (point)))))) (defun semantic-lex-spp-get-overlay (&optional point) - "Return first overlay which has a 'semantic-spp property." + "Return first overlay which has a `semantic-spp' property." (let ((overlays (overlays-at (or point (point))))) (while (and overlays (null (overlay-get (car overlays) 'semantic-spp))) @@ -1074,7 +1074,7 @@ and variable state from the current buffer." )) ;; Second Cheat: copy key variables regarding macro state from the - ;; the originating buffer we are parsing. We need to do this every time + ;; originating buffer we are parsing. We need to do this every time ;; since the state changes. (dolist (V important-vars) (set V (buffer-local-value V origbuff))) @@ -1165,7 +1165,8 @@ of type `spp-macro-def' is to be created. VALFORM are forms that return the value to be saved for this macro, or nil. When implementing a macro, you can use `semantic-lex-spp-stream-for-macro' to convert text into a lexical stream for storage in the macro." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) @@ -1199,7 +1200,8 @@ REGEXP is a regular expression for the analyzer to match. See `define-lex-regex-analyzer' for more on regexp. TOKIDX is an index into REGEXP for which a new lexical token of type `spp-macro-undef' is to be created." - (declare (debug (&define name stringp stringp form))) + (declare (debug (&define name stringp stringp form)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end"))) `(define-lex-regex-analyzer ,name @@ -1260,7 +1262,8 @@ type of include. The return value should be of the form: (NAME . TYPE) where NAME is the name of the include, and TYPE is the type of the include, where a valid symbol is `system', or nil." - (declare (debug (&define name stringp stringp form def-body))) + (declare (debug (&define name stringp stringp form def-body)) + (indent 1)) (let ((start (make-symbol "start")) (end (make-symbol "end")) (val (make-symbol "val")) diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 72864a8da52..9c64cc9f7e5 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -574,25 +574,24 @@ may need to be overridden for some special languages.") (defvar-local semantic-lex-number-expression ;; This expression was written by David Ponce for Java, and copied ;; here for C and any other similar language. - (eval-when-compile - (concat "\\(" - "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][fFdD]\\>" - "\\|" - "\\<[0-9]+[.]" - "\\|" - "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<0[xX][[:xdigit:]]+[lL]?\\>" - "\\|" - "\\<[0-9]+[lLfFdD]?\\>" - "\\)" - )) + (concat "\\(" + "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][fFdD]\\>" + "\\|" + "\\<[0-9]+[.]" + "\\|" + "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<0[xX][[:xdigit:]]+[lL]?\\>" + "\\|" + "\\<[0-9]+[lLfFdD]?\\>" + "\\)" + ) "Regular expression for matching a number. If this value is nil, no number extraction is done during lex. This expression tries to match C and Java like numbers. @@ -760,7 +759,7 @@ If two analyzers can match the same text, it is important to order the analyzers so that the one you want to match first occurs first. For example, it is good to put a number analyzer in front of a symbol analyzer which might mistake a number for a symbol." - (declare (debug (&define name stringp (&rest symbolp)))) + (declare (debug (&define name stringp (&rest symbolp))) (indent 1)) `(defun ,name (start end &optional depth length) ,(concat doc "\nSee `semantic-lex' for more information.") ;; Make sure the state of block parsing starts over. @@ -1096,7 +1095,7 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to after the location of the analyzed entry, and to add any discovered tokens at the beginning of `semantic-lex-token-stream'. This can be done by using `semantic-lex-push-token'." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(eval-and-compile ;; This is the real info used by `define-lex' (via semantic-lex-one-token). (defconst ,name '(,condition ,@forms) ,doc) @@ -1118,7 +1117,7 @@ This can be done by using `semantic-lex-push-token'." "Create a lexical analyzer with NAME and DOC that will match REGEXP. FORMS are evaluated upon a successful match. See `define-lex-analyzer' for more about analyzers." - (declare (debug (&define name stringp form def-body))) + (declare (debug (&define name stringp form def-body)) (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1137,7 +1136,8 @@ FORMS are evaluated upon a successful match BEFORE the new token is created. It is valid to ignore FORMS. See `define-lex-analyzer' for more about analyzers." (declare (debug - (&define name stringp form symbolp [ &optional form ] def-body))) + (&define name stringp form symbolp [ &optional form ] def-body)) + (indent 1)) `(define-lex-analyzer ,name ,doc (looking-at ,regexp) @@ -1162,7 +1162,8 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM and CLOSE-DELIM are respectively the open and close delimiters identifying a block. OPEN-SYM and CLOSE-SYM are respectively the symbols returned in open and close tokens." - (declare (debug (&define name stringp form (&rest form)))) + (declare (debug (&define name stringp form (&rest form))) + (indent 1)) (let ((specs (cons spec1 specs)) spec open olist clist) (while specs @@ -1471,6 +1472,7 @@ syntax as specified by the syntax table." (defmacro define-lex-keyword-type-analyzer (name doc syntax) "Define a keyword type analyzer NAME with DOC string. SYNTAX is the regexp that matches a keyword syntactic expression." + (declare (indent 1)) (let ((key (make-symbol "key"))) `(define-lex-analyzer ,name ,doc @@ -1486,6 +1488,7 @@ SYNTAX is the regexp that matches a keyword syntactic expression." "Define a sexp type analyzer NAME with DOC string. SYNTAX is the regexp that matches the beginning of the s-expression. TOKEN is the lexical token returned when SYNTAX matches." + (declare (indent 1)) `(define-lex-regex-analyzer ,name ,doc ,syntax @@ -1504,6 +1507,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1536,6 +1540,7 @@ SYNTAX is the regexp that matches a syntactic expression. MATCHES is an alist of lexical elements used to refine the syntactic expression. DEFAULT is the default lexical token returned when no MATCHES." + (declare (indent 1)) (if matches (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) @@ -1633,6 +1638,7 @@ When the lexer encounters the open-paren delimiter \"(\": - If the maximum depth of parenthesis tracking is reached (current depth >= max depth), it returns the whole parenthesis block as a (PAREN_BLOCK start . end) token." + (declare (indent 1)) (let* ((val (make-symbol "val")) (lst (make-symbol "lst")) (elt (make-symbol "elt"))) diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index ebc4159a4c5..1d16b024a5e 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -735,12 +735,9 @@ yanked to." Optional argument KILL-FLAG will delete the text of the tag to the kill ring. -Interactively, reads the register using `register-read-with-preview', -if available." - (interactive (list (if (fboundp 'register-read-with-preview) - (register-read-with-preview "Tag to register: ") - (read-char "Tag to register: ")) - current-prefix-arg)) +Interactively, reads the register using `register-read-with-preview'." + (interactive (list (register-read-with-preview "Tag to register: ") + current-prefix-arg)) (semantic-fetch-tags) (let ((ft (semantic-obtain-foreign-tag))) (when ft diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 1503a766dc8..756b949c0d1 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -310,7 +310,7 @@ may re-organize the list with side-effects." ;; class tag. ;; (defvar-local semantic-orphaned-member-metaparent-type "class" - "In `semantic-adopt-external-members', the type of 'type for metaparents. + "In `semantic-adopt-external-members', the type of `type' for metaparents. A metaparent is a made-up type semantic token used to hold the child list of orphaned members of a named type.") diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index ba236059f66..e48cefa4ca6 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -101,7 +101,7 @@ Where PREDICATE is a function that takes a directory name for the root of a project, and returns non-nil if the tool represented by KEY is supported. -If no tools are supported, then 'grep is assumed.") +If no tools are supported, then `grep' is assumed.") (defun semantic-symref-calculate-rootdir () "Calculate the root directory for a symref search. @@ -475,7 +475,7 @@ already." Return the Semantic tag associated with HIT. SEARCHTXT is the text that is being searched for. Used to narrow the in-buffer search. -SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +SEARCHTYPE is the type of search (such as `symbol' or `tagname'). If there is no database, or if the searchtype is wrong, return nil." ;; Allowed search types for this mechanism: ;; tagname, tagregexp, tagcompletions @@ -506,7 +506,7 @@ If there is no database, or if the searchtype is wrong, return nil." Return the Semantic tag associated with HIT. SEARCHTXT is the text that is being searched for. Used to narrow the in-buffer search. -SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +SEARCHTYPE is the type of search (such as `symbol' or `tagname'). Optional OPEN-BUFFERS, when nil will use a faster version of `find-file' when a file needs to be opened. If non-nil, then normal buffer initialization will be used. diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index 7a80bccb533..a5220f622ab 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -28,8 +28,6 @@ (require 'semantic/tag) (defvar ede-minor-mode) -(declare-function semanticdb-table-child-p "semantic/db" t t) -(declare-function semanticdb-get-buffer "semantic/db") (declare-function semantic-dependency-find-file-on-path "semantic/dep") (declare-function ede-toplevel "ede/base") @@ -37,68 +35,66 @@ ;;; Location a TAG came from. ;; + +(cl-defgeneric semantic-tag-parent-buffer (parent) + "Return the buffer in which a tag can be found, knowing its PARENT." + (cond ((and (semantic-tag-p parent) (semantic-tag-in-buffer-p parent)) + ;; We have a parent with a buffer, then go there. + (semantic-tag-buffer parent)) + ((and (semantic-tag-p parent) (semantic-tag-file-name parent)) + ;; The parent only has a file-name, then + ;; find that file, and switch to that buffer. + (find-file-noselect (semantic-tag-file-name parent))))) + ;;;###autoload -(define-overloadable-function semantic-go-to-tag (tag &optional parent) +(defun semantic-go-to-tag (tag &optional parent) "Go to the location of TAG. TAG may be a stripped element, in which case PARENT specifies a parent tag that has position information. PARENT can also be a `semanticdb-table' object." - (:override - (save-match-data + (save-match-data + (set-buffer (cond ((semantic-tag-in-buffer-p tag) ;; We have a linked tag, go to that buffer. - (set-buffer (semantic-tag-buffer tag))) + (semantic-tag-buffer tag)) ((semantic-tag-file-name tag) ;; If it didn't have a buffer, but does have a file ;; name, then we need to get to that file so the tag ;; location is made accurate. - (set-buffer (find-file-noselect (semantic-tag-file-name tag)))) - ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent)) - ;; The tag had nothing useful, but we have a parent with - ;; a buffer, then go there. - (set-buffer (semantic-tag-buffer parent))) - ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent)) - ;; Tag had nothing, and the parent only has a file-name, then - ;; find that file, and switch to that buffer. - (set-buffer (find-file-noselect (semantic-tag-file-name parent)))) - ((and parent (featurep 'semantic/db) - (semanticdb-table-child-p parent)) - (set-buffer (semanticdb-get-buffer parent))) - (t - ;; Well, just assume things are in the current buffer. - nil - ))) - ;; We should be in the correct buffer now, try and figure out - ;; where the tag is. - (cond ((semantic-tag-with-position-p tag) - ;; If it's a number, go there - (goto-char (semantic-tag-start tag))) - ((semantic-tag-with-position-p parent) - ;; Otherwise, it's a trimmed vector, such as a parameter, - ;; or a structure part. If there is a parent, we can use it - ;; as a bounds for searching. - (goto-char (semantic-tag-start parent)) - ;; Here we make an assumption that the text returned by - ;; the parser and concocted by us actually exists - ;; in the buffer. - (re-search-forward (semantic-tag-name tag) - (semantic-tag-end parent) - t)) - ((semantic-tag-get-attribute tag :line) - ;; The tag has a line number in it. Go there. - (goto-char (point-min)) - (forward-line (1- (semantic-tag-get-attribute tag :line)))) - ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line)) - ;; The tag has a line number in it. Go there. - (goto-char (point-min)) - (forward-line (1- (semantic-tag-get-attribute parent :line))) - (re-search-forward (semantic-tag-name tag) nil t)) - (t - ;; Take a guess that the tag has a unique name, and just - ;; search for it from the beginning of the buffer. - (goto-char (point-min)) - (re-search-forward (semantic-tag-name tag) nil t))) - ) + (find-file-noselect (semantic-tag-file-name tag))) + ((and parent (semantic-tag-parent-buffer parent))) + ;; Well, just assume things are in the current buffer. + (t (current-buffer))))) + ;; We should be in the correct buffer now, try and figure out + ;; where the tag is. + (cond ((semantic-tag-with-position-p tag) + ;; If it's a number, go there + (goto-char (semantic-tag-start tag))) + ((semantic-tag-with-position-p parent) + ;; Otherwise, it's a trimmed vector, such as a parameter, + ;; or a structure part. If there is a parent, we can use it + ;; as a bounds for searching. + (goto-char (semantic-tag-start parent)) + ;; Here we make an assumption that the text returned by + ;; the parser and concocted by us actually exists + ;; in the buffer. + (re-search-forward (semantic-tag-name tag) + (semantic-tag-end parent) + t)) + ((semantic-tag-get-attribute tag :line) + ;; The tag has a line number in it. Go there. + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute tag :line)))) + ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line)) + ;; The tag has a line number in it. Go there. + (goto-char (point-min)) + (forward-line (1- (semantic-tag-get-attribute parent :line))) + (re-search-forward (semantic-tag-name tag) nil t)) + (t + ;; Take a guess that the tag has a unique name, and just + ;; search for it from the beginning of the buffer. + (goto-char (point-min)) + (re-search-forward (semantic-tag-name tag) nil t))) ) ;;; Dependencies diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 1917bcb40a6..d005b7a854c 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -55,20 +55,17 @@ The field position is the field number (based at 1) where the name of this section is.") ;;; Code: -(defun semantic-texi-parse-region (&rest _ignore) +(define-mode-local-override semantic-parse-region texinfo-mode (&rest _ignore) "Parse the current texinfo buffer for semantic tags. IGNORE any arguments, always parse the whole buffer. Each tag returned is of the form: (\"NAME\" section (:members CHILDREN)) or - (\"NAME\" def) - -It is an override of `semantic-parse-region' and must be installed by the -function `semantic-install-function-overrides'." + (\"NAME\" def)" (mapcar #'semantic-texi-expand-tag (semantic-texi-parse-headings))) -(defun semantic-texi-parse-changes () +(define-mode-local-override semantic-parse-changes texinfo-mode () "Parse changes in the current texinfo buffer." ;; NOTE: For now, just schedule a full reparse. ;; To be implemented later. @@ -445,9 +442,6 @@ that start with that symbol." (defun semantic-default-texi-setup () "Set up a buffer for parsing of Texinfo files." ;; This will use our parser. - (semantic-install-function-overrides - '((semantic-parse-region . semantic-texi-parse-region) - (semantic-parse-changes . semantic-texi-parse-changes))) (setq semantic-parser-name "TEXI" ;; Setup a dummy parser table to enable parsing! semantic--parse-table t diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 69a7c8f59ca..24f71a2dcc1 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -77,7 +77,6 @@ If FILE is not loaded, and semanticdb is not available, find the file (with-current-buffer (find-file-noselect file) (semantic-fetch-tags)))))) -(declare-function semanticdb-abstract-table-child-p "semantic/db" (obj) t) (declare-function semanticdb-refresh-table "semantic/db") (declare-function semanticdb-get-tags "semantic/db" (arg &rest args) t) (declare-function semanticdb-find-results-p "semantic/db-find" (resultp)) @@ -115,8 +114,6 @@ buffer, or a filename. If SOMETHING is nil return nil." (require 'semantic/db-mode) (semanticdb-minor-mode-p) (progn - (declare-function semanticdb-abstract-table--eieio-childp - "semantic/db") (cl-typep something 'semanticdb-abstract-table))) (semanticdb-refresh-table something) (semanticdb-get-tags something)) diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index 454ddde219b..55eeef453ea 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -66,7 +66,7 @@ Returned tokens must have the form: (TOKSYM VALUE START . END) where VALUE is the buffer substring between START and END positions." - (declare (debug (&define name stringp def-body))) + (declare (debug (&define name stringp def-body)) (indent 1)) `(defun ,name () ,doc (cond diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index f842b3c364b..e24f6128a68 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -38,6 +38,7 @@ ;;; Code: (require 'semantic/wisent) (eval-when-compile (require 'cl-lib)) +(require 'subr-x) ; `string-pad' ;;;; ------------------- ;;;; Misc. useful things @@ -65,6 +66,7 @@ (defmacro wisent-defcontext (name &rest vars) "Define a context NAME that will bind variables VARS." (declare (indent 1)) + (declare-function wisent-context-name nil (name)) (let* ((context (wisent-context-name name)) (declarations (mapcar (lambda (v) (list 'defvar v)) vars))) `(progn @@ -75,21 +77,17 @@ (defmacro wisent-with-context (name &rest body) "Bind variables in context NAME then eval BODY." (declare (indent 1)) + (declare-function wisent-context-bindings nil (name)) `(dlet ,(wisent-context-bindings name) ,@body)) -;; Other utilities - (defsubst wisent-pad-string (s n &optional left) "Fill string S with spaces. Return a new string of at least N characters. Insert spaces on right. If optional LEFT is non-nil insert spaces on left." - (let ((i (length s))) - (if (< i n) - (if left - (concat (make-string (- n i) ?\ ) s) - (concat s (make-string (- n i) ?\ ))) - s))) + (declare (obsolete string-pad "29.1")) + (string-pad s n nil left)) + ;;;; ------------------------ ;;;; Environment dependencies @@ -702,7 +700,7 @@ S must be a vector of integers." (setq i 1) (while (<= i nrules) (unless (aref ruseful i) - (wisent-log "#%s " (wisent-pad-string (format "%d" i) 4)) + (wisent-log "#%s " (string-pad (format "%d" i) 4)) (wisent-log "%s:" (wisent-tag (aref rlhs i))) (setq r (aref rrhs i)) (while (natnump (aref ritem r)) @@ -2296,7 +2294,7 @@ there are any reduce/reduce conflicts." ;; Don't print rules disabled in `wisent-reduce-grammar-tables'. (when (aref ruseful i) (wisent-log " %s %s ->" - (wisent-pad-string (number-to-string i) 6) + (string-pad (number-to-string i) 6) (wisent-tag (aref rlhs i))) (setq r (aref rrhs i)) (if (> (aref ritem r) 0) diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index 5ca22bac86c..a4104e333d3 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -284,13 +284,15 @@ Return the expanded expression." (assocs (wisent-grammar-assocs))) (cons terminals (cons assocs nonterminals)))) -(defun wisent-grammar-parsetable-builder () +(define-mode-local-override semantic-grammar-parsetable-builder + wisent-grammar-mode () "Return the value of the parser table." `(wisent-compiled-grammar ,(wisent-grammar-grammar) ,(semantic-grammar-start))) -(defun wisent-grammar-setupcode-builder () +(define-mode-local-override semantic-grammar-setupcode-builder + wisent-grammar-mode () "Return the parser setup code." (format "(semantic-install-function-overrides\n\ @@ -322,10 +324,7 @@ Menu items are appended to the common grammar menu.") (define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY" "Major mode for editing Wisent grammars." (semantic-grammar-setup-menu wisent-grammar-menu) - (setq-local semantic-grammar-require-form '(require 'semantic/wisent)) - (semantic-install-function-overrides - '((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder) - (semantic-grammar-setupcode-builder . wisent-grammar-setupcode-builder)))) + (setq-local semantic-grammar-require-form '(require 'semantic/wisent))) (defvar-mode-local wisent-grammar-mode semantic-grammar-macros '( diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index 941efbbbef3..6b2833ef448 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -1,6 +1,6 @@ ;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t; -*- -;; Copyright (C) 2002, 2004, 2006-2022 Free Software Foundation, Inc. +;; Copyright (C) 2002-2022 Free Software Foundation, Inc. ;; Author: Richard Kim <emacs18@gmail.com> ;; Created: June 2002 @@ -27,9 +27,7 @@ ;;; Code: -;; Try to load python support, but fail silently since it is only used -;; for optional functionality -(require 'python nil t) +(require 'python) (require 'semantic/wisent) (require 'semantic/wisent/python-wy) diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index 7c054d4c100..9691f906a4c 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -37,14 +37,16 @@ ;; ;; See the srecode manual for specific details. +;;; Code: + (require 'eieio) (require 'mode-local) (load "srecode/loaddefs" nil 'nomessage) (defvar srecode-version "1.2" "Current version of the Semantic Recoder.") +(make-obsolete-variable 'srecode-version 'emacs-version "29.1") -;;; Code: (defgroup srecode nil "Semantic Recoder." :group 'extensions diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 37c83be8112..bed74861ca0 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -38,9 +38,6 @@ (require 'srecode/table) (require 'srecode/dictionary) -(declare-function srecode-template-inserter-newline-child-p "srecode/insert" - t t) - ;;; Code: ;;; Template Class @@ -378,8 +375,11 @@ It is hard if the previous inserter is a newline object." (while (and comp (stringp (car comp))) (setq comp (cdr comp))) (or (not comp) - (progn (require 'srecode/insert) - (srecode-template-inserter-newline-child-p (car comp))))) + (srecord-compile-inserter-newline-p (car comp)))) + +(cl-defgeneric srecord-compile-inserter-newline-p (_obj) + "Non-nil if OBJ is a newline inserter object." + nil) (defun srecode-compile-split-code (tag str STATE &optional end-name) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 8dd5d251576..c0260c62a91 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -319,6 +319,10 @@ by themselves.") Specify the :indent argument to enable automatic indentation when newlines occur in your template.") +(cl-defmethod srecord-compile-inserter-newline-p + ((_ srecode-template-inserter-newline)) + t) + (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline) dictionary) "Insert the STI inserter." diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 3dfbb9d58b1..f77898f9065 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -200,13 +200,13 @@ INIT are the initialization parameters for the new template table." ;; go front-to-back, the highest priority items are put ;; into the search table first, allowing lower priority items ;; to be the items found in the search table. - (object-sort-list mt 'modetables (lambda (a b) - (> (oref a priority) - (oref b priority)))) + (srecode-object-sort-list mt 'modetables (lambda (a b) + (> (oref a priority) + (oref b priority)))) ;; Return it. new)) -(defun object-sort-list (object slot predicate) +(defun srecode-object-sort-list (object slot predicate) "Sort the items in OBJECT's SLOT. Use PREDICATE is the same as for the `sort' function." (when (slot-boundp object slot) @@ -284,6 +284,8 @@ Use PREDICATE is the same as for the `sort' function." (setq temp (cdr temp)))) ) +(define-obsolete-function-alias 'object-sort-list + #'srecode-object-sort-list "29.1") (provide 'srecode/table) diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el index 50b0e150ff3..c297429e408 100644 --- a/lisp/cedet/srecode/texi.el +++ b/lisp/cedet/srecode/texi.el @@ -246,7 +246,7 @@ that class. class => @code{class} @xref{class} unknown => @code{unknown} \"text\" => \\=`\\=`text\\='\\=' - 'quoteme => @code{quoteme} + \\='quoteme => @code{quoteme} non-nil => non-@code{nil} t => @code{t} :tag => @code{:tag} |