[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 344b48f490 1/2: CEDET: Remove left-over uses of obsolete <class>-
|
From: |
Stefan Monnier |
|
Subject: |
master 344b48f490 1/2: CEDET: Remove left-over uses of obsolete <class>-child-p predicates |
|
Date: |
Tue, 2 Aug 2022 13:08:31 -0400 (EDT) |
branch: master
commit 344b48f490416cb1200e19b28d356e7fb5b04387
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
CEDET: Remove left-over uses of obsolete <class>-child-p predicates
Those predicates were still sometimes used in a few places, notably via
`:type ... <class>-child` which was never technically correct.
* lisp/cedet/ede/config.el (ede-extra-config, ede-project-with-config):
* lisp/cedet/ede/base.el (ede-project-placeholder): Avoid pseudo-type
`<class>-child`.
* lisp/cedet/semantic/complete.el (semantic-displayer-focus-abstract):
Move before use of `cl-typep` on it.
(semantic-complete-current-match):
* lisp/cedet/ede/speedbar.el (ede-speedbar-menu): Use `cl-typep`
instead of `<class>-child-p`.
* lisp/cedet/semantic/db.el (semanticdb-get-buffer):
Use `cl-defgeneric` for the main/default definition.
(semantic-tag-parent-buffer): Add method.
* lisp/cedet/semantic/tag-file.el (semantic-tag-parent-buffer):
New generic function extracted from `semantic-go-to-tag`.
This allows us to keep the semanticdb-table part in semantic/db and
thus break a cyclic dependency.
(semantic-go-to-tag): Use it.
Demote to a plain `defun` since it's not overloaded anywhere.
* lisp/cedet/semantic/util.el (semanticdb-abstract-table-child-p):
Remove unused declaration.
* lisp/cedet/srecode/compile.el (srecode-template-inserter-newline-child-p):
Remove unused declaration.
(srecord-compile-inserter-newline-p): New generic function, so we can
move the `srecode-template-inserter-newline` case to `srecode/insert.el`,
to avoid a cyclic dependency.
* lisp/cedet/srecode/insert.el (srecord-compile-inserter-newline-p):
New method.
---
lisp/cedet/ede/base.el | 2 +-
lisp/cedet/ede/config.el | 4 +-
lisp/cedet/ede/speedbar.el | 4 +-
lisp/cedet/semantic/complete.el | 47 ++++++++---------
lisp/cedet/semantic/db-typecache.el | 2 +-
lisp/cedet/semantic/db.el | 9 +++-
lisp/cedet/semantic/tag-file.el | 102 +++++++++++++++++-------------------
lisp/cedet/semantic/util.el | 3 --
lisp/cedet/srecode/compile.el | 10 ++--
lisp/cedet/srecode/insert.el | 4 ++
10 files changed, 94 insertions(+), 93 deletions(-)
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 8f5db8db18..9182fcd5ac 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.
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index 529b96f2b0..8c4f52647b 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/speedbar.el b/lisp/cedet/ede/speedbar.el
index f99a1d114b..604b660344 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/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 436ad08c5f..2597a431e1 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -311,11 +311,27 @@ 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-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.
@@ -346,7 +362,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.
@@ -1407,24 +1423,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")
diff --git a/lisp/cedet/semantic/db-typecache.el
b/lisp/cedet/semantic/db-typecache.el
index 38caac2292..efc1ab2c5f 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 757e46677e..ff62f53d3c 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."
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index 7a80bccb53..a5220f622a 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/util.el b/lisp/cedet/semantic/util.el
index 69a7c8f59c..24f71a2dcc 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/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 37c83be811..bed74861ca 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 8dd5d25157..c0260c62a9 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."