mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 18:40:39 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/cedet: Use cl-generic instead of EIEIO's defgeneric/defmethod

Browse source 
* lisp/cedet/**/*.el: Mechanically replace all calls to defmethod/defgeneric
by calls to cl-defmethod/cl-defgeneric.
* lisp/cedet/srecode/table.el:
* lisp/cedet/srecode/fields.el:
* lisp/cedet/srecode/dictionary.el:
* lisp/cedet/srecode/compile.el:
* lisp/cedet/semantic/debug.el:
* lisp/cedet/semantic/db-ref.el:
* lisp/cedet/ede/base.el:
* lisp/cedet/ede/auto.el:
* lisp/cedet/ede.el: Require `cl-generic'.
This commit is contained in:
Stefan Monnier 2015-02-04 13:49:49 -05:00
parent 102a21d689
commit 73b17f7c2b
64 changed files with 836 additions and 812 deletions
Download patch file Download diff file Expand all files Collapse all files

15
lisp/cedet/ChangeLog
View file

@ -1,3 +1,18 @@
2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
Use cl-generic instead of EIEIO's defgeneric/defmethod.
* **/*.el: Mechanically replace all calls to defmethod/defgeneric by
calls to cl-defmethod/cl-defgeneric.
* srecode/table.el:
* srecode/fields.el:
* srecode/dictionary.el:
* srecode/compile.el:
* semantic/debug.el:
* semantic/db-ref.el:
* ede/base.el:
* ede/auto.el:
* ede.el: Require `cl-generic'.
2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
Don't use <class> as a variable and don't assume that <class>-list-p is Don't use <class> as a variable and don't assume that <class>-list-p is

79
lisp/cedet/ede.el
View file

@ -41,6 +41,7 @@
(require 'cedet) (require 'cedet)
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'eieio-speedbar) (require 'eieio-speedbar)
(require 'ede/source) (require 'ede/source)
(require 'ede/base) (require 'ede/base)
@ -430,7 +431,7 @@ version of the keymap."
;;; Menu building methods for building ;;; Menu building methods for building
;; ;;
(defmethod ede-menu-items-build ((obj ede-project) &optional current) (cl-defmethod ede-menu-items-build ((obj ede-project) &optional current)
"Return a list of menu items for building project OBJ. "Return a list of menu items for building project OBJ.
If optional argument CURRENT is non-nil, return sub-menu code." If optional argument CURRENT is non-nil, return sub-menu code."
(if current (if current
@ -440,7 +441,7 @@ If optional argument CURRENT is non-nil, return sub-menu code."
(concat "Build Project " (ede-name obj)) (concat "Build Project " (ede-name obj))
`(project-compile-project ,obj)))))) `(project-compile-project ,obj))))))
(defmethod ede-menu-items-build ((obj ede-target) &optional current) (cl-defmethod ede-menu-items-build ((obj ede-target) &optional current)
"Return a list of menu items for building target OBJ. "Return a list of menu items for building target OBJ.
If optional argument CURRENT is non-nil, return sub-menu code." If optional argument CURRENT is non-nil, return sub-menu code."
(if current (if current
@ -821,7 +822,7 @@ Optional argument NAME is the name to give this project."
;; Allert the user ;; Allert the user
(message "Project created and saved. You may now create targets.")) (message "Project created and saved. You may now create targets."))
(defmethod ede-add-subproject ((proj-a ede-project) proj-b) (cl-defmethod ede-add-subproject ((proj-a ede-project) proj-b)
"Add into PROJ-A, the subproject PROJ-B." "Add into PROJ-A, the subproject PROJ-B."
(oset proj-a subproj (cons proj-b (oref proj-a subproj)))) (oset proj-a subproj (cons proj-b (oref proj-a subproj))))
@ -986,75 +987,75 @@ Optional argument FORCE forces the file to be removed without asking."
;; files should inherit from `ede-project'. Create the appropriate ;; files should inherit from `ede-project'. Create the appropriate
;; methods based on those below. ;; methods based on those below.
(defmethod project-interactive-select-target ((this ede-project-placeholder) prompt) (cl-defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
; checkdoc-params: (prompt) ; checkdoc-params: (prompt)
"Make sure placeholder THIS is replaced with the real thing, and pass through." "Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-interactive-select-target this prompt)) (project-interactive-select-target this prompt))
(defmethod project-interactive-select-target ((this ede-project) prompt) (cl-defmethod project-interactive-select-target ((this ede-project) prompt)
"Interactively query for a target that exists in project THIS. "Interactively query for a target that exists in project THIS.
Argument PROMPT is the prompt to use when querying the user for a target." Argument PROMPT is the prompt to use when querying the user for a target."
(let ((ob (object-assoc-list 'name (oref this targets)))) (let ((ob (object-assoc-list 'name (oref this targets))))
(cdr (assoc (completing-read prompt ob nil t) ob)))) (cdr (assoc (completing-read prompt ob nil t) ob))))
(defmethod project-add-file ((this ede-project-placeholder) file) (cl-defmethod project-add-file ((this ede-project-placeholder) file)
; checkdoc-params: (file) ; checkdoc-params: (file)
"Make sure placeholder THIS is replaced with the real thing, and pass through." "Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-add-file this file)) (project-add-file this file))
(defmethod project-add-file ((ot ede-target) file) (cl-defmethod project-add-file ((ot ede-target) file)
"Add the current buffer into project project target OT. "Add the current buffer into project project target OT.
Argument FILE is the file to add." Argument FILE is the file to add."
(error "add-file not supported by %s" (eieio-object-name ot))) (error "add-file not supported by %s" (eieio-object-name ot)))
(defmethod project-remove-file ((ot ede-target) fnnd) (cl-defmethod project-remove-file ((ot ede-target) fnnd)
"Remove the current buffer from project target OT. "Remove the current buffer from project target OT.
Argument FNND is an argument." Argument FNND is an argument."
(error "remove-file not supported by %s" (eieio-object-name ot))) (error "remove-file not supported by %s" (eieio-object-name ot)))
(defmethod project-edit-file-target ((ot ede-target)) (cl-defmethod project-edit-file-target ((ot ede-target))
"Edit the target OT associated with this file." "Edit the target OT associated with this file."
(find-file (oref (ede-current-project) file))) (find-file (oref (ede-current-project) file)))
(defmethod project-new-target ((proj ede-project) &rest args) (cl-defmethod project-new-target ((proj ede-project) &rest args)
"Create a new target. It is up to the project PROJ to get the name." "Create a new target. It is up to the project PROJ to get the name."
(error "new-target not supported by %s" (eieio-object-name proj))) (error "new-target not supported by %s" (eieio-object-name proj)))
(defmethod project-new-target-custom ((proj ede-project)) (cl-defmethod project-new-target-custom ((proj ede-project))
"Create a new target. It is up to the project PROJ to get the name." "Create a new target. It is up to the project PROJ to get the name."
(error "New-target-custom not supported by %s" (eieio-object-name proj))) (error "New-target-custom not supported by %s" (eieio-object-name proj)))
(defmethod project-delete-target ((ot ede-target)) (cl-defmethod project-delete-target ((ot ede-target))
"Delete the current target OT from its parent project." "Delete the current target OT from its parent project."
(error "add-file not supported by %s" (eieio-object-name ot))) (error "add-file not supported by %s" (eieio-object-name ot)))
(defmethod project-compile-project ((obj ede-project) &optional command) (cl-defmethod project-compile-project ((obj ede-project) &optional command)
"Compile the entire current project OBJ. "Compile the entire current project OBJ.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
(error "compile-project not supported by %s" (eieio-object-name obj))) (error "compile-project not supported by %s" (eieio-object-name obj)))
(defmethod project-compile-target ((obj ede-target) &optional command) (cl-defmethod project-compile-target ((obj ede-target) &optional command)
"Compile the current target OBJ. "Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(error "compile-target not supported by %s" (eieio-object-name obj))) (error "compile-target not supported by %s" (eieio-object-name obj)))
(defmethod project-debug-target ((obj ede-target)) (cl-defmethod project-debug-target ((obj ede-target))
"Run the current project target OBJ in a debugger." "Run the current project target OBJ in a debugger."
(error "debug-target not supported by %s" (eieio-object-name obj))) (error "debug-target not supported by %s" (eieio-object-name obj)))
(defmethod project-run-target ((obj ede-target)) (cl-defmethod project-run-target ((obj ede-target))
"Run the current project target OBJ." "Run the current project target OBJ."
(error "run-target not supported by %s" (eieio-object-name obj))) (error "run-target not supported by %s" (eieio-object-name obj)))
(defmethod project-make-dist ((this ede-project)) (cl-defmethod project-make-dist ((this ede-project))
"Build a distribution for the project based on THIS project." "Build a distribution for the project based on THIS project."
(error "Make-dist not supported by %s" (eieio-object-name this))) (error "Make-dist not supported by %s" (eieio-object-name this)))
(defmethod project-dist-files ((this ede-project)) (cl-defmethod project-dist-files ((this ede-project))
"Return a list of files that constitute a distribution of THIS project." "Return a list of files that constitute a distribution of THIS project."
(error "Dist-files is not supported by %s" (eieio-object-name this))) (error "Dist-files is not supported by %s" (eieio-object-name this)))
(defmethod project-rescan ((this ede-project)) (cl-defmethod project-rescan ((this ede-project))
"Rescan the EDE project THIS." "Rescan the EDE project THIS."
(error "Rescanning a project is not supported by %s" (eieio-object-name this))) (error "Rescanning a project is not supported by %s" (eieio-object-name this)))
@ -1248,7 +1249,7 @@ that contains the target that becomes buffer's object."
;; Return our findings. ;; Return our findings.
ede-object)) ede-object))
(defmethod ede-target-in-project-p ((proj ede-project) target) (cl-defmethod ede-target-in-project-p ((proj ede-project) target)
"Is PROJ the parent of TARGET? "Is PROJ the parent of TARGET?
If TARGET belongs to a subproject, return that project file." If TARGET belongs to a subproject, return that project file."
(if (and (slot-boundp proj 'targets) (if (and (slot-boundp proj 'targets)
@ -1273,7 +1274,7 @@ could become slow in time."
projs (cdr projs))) projs (cdr projs)))
ans))) ans)))
(defmethod ede-find-target ((proj ede-project) buffer) (cl-defmethod ede-find-target ((proj ede-project) buffer)
"Fetch the target in PROJ belonging to BUFFER or nil." "Fetch the target in PROJ belonging to BUFFER or nil."
(with-current-buffer buffer (with-current-buffer buffer
@ -1295,16 +1296,16 @@ could become slow in time."
(setq targets (cdr targets))) (setq targets (cdr targets)))
f))))) f)))))
(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source) (cl-defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
"Return non-nil if object THIS is in BUFFER to a SOURCE list. "Return non-nil if object THIS is in BUFFER to a SOURCE list.
Handles complex path issues." Handles complex path issues."
(member (ede-convert-path this (buffer-file-name buffer)) source)) (member (ede-convert-path this (buffer-file-name buffer)) source))
(defmethod ede-buffer-mine ((this ede-project) buffer) (cl-defmethod ede-buffer-mine ((this ede-project) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER." "Return non-nil if object THIS lays claim to the file in BUFFER."
nil) nil)
(defmethod ede-buffer-mine ((this ede-target) buffer) (cl-defmethod ede-buffer-mine ((this ede-target) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER." "Return non-nil if object THIS lays claim to the file in BUFFER."
(condition-case nil (condition-case nil
(ede-target-buffer-in-sourcelist this buffer (oref this source)) (ede-target-buffer-in-sourcelist this buffer (oref this source))
@ -1354,22 +1355,22 @@ This includes buffers controlled by a specific target of PROJECT."
"Execute PROC on all buffers controlled by EDE." "Execute PROC on all buffers controlled by EDE."
(mapcar proc (ede-buffers))) (mapcar proc (ede-buffers)))
(defmethod ede-map-project-buffers ((this ede-project) proc) (cl-defmethod ede-map-project-buffers ((this ede-project) proc)
"For THIS, execute PROC on all buffers belonging to THIS." "For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-project-buffers this))) (mapcar proc (ede-project-buffers this)))
(defmethod ede-map-target-buffers ((this ede-target) proc) (cl-defmethod ede-map-target-buffers ((this ede-target) proc)
"For THIS, execute PROC on all buffers belonging to THIS." "For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-target-buffers this))) (mapcar proc (ede-target-buffers this)))
;; other types of mapping ;; other types of mapping
(defmethod ede-map-subprojects ((this ede-project) proc) (cl-defmethod ede-map-subprojects ((this ede-project) proc)
"For object THIS, execute PROC on all direct subprojects. "For object THIS, execute PROC on all direct subprojects.
This function does not apply PROC to sub-sub projects. This function does not apply PROC to sub-sub projects.
See also `ede-map-all-subprojects'." See also `ede-map-all-subprojects'."
(mapcar proc (oref this subproj))) (mapcar proc (oref this subproj)))
(defmethod ede-map-all-subprojects ((this ede-project) allproc) (cl-defmethod ede-map-all-subprojects ((this ede-project) allproc)
"For object THIS, execute PROC on THIS and all subprojects. "For object THIS, execute PROC on THIS and all subprojects.
This function also applies PROC to sub-sub projects. This function also applies PROC to sub-sub projects.
See also `ede-map-subprojects'." See also `ede-map-subprojects'."
@ -1383,11 +1384,11 @@ See also `ede-map-subprojects'."
;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file))) ;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file)))
(defmethod ede-map-targets ((this ede-project) proc) (cl-defmethod ede-map-targets ((this ede-project) proc)
"For object THIS, execute PROC on all targets." "For object THIS, execute PROC on all targets."
(mapcar proc (oref this targets))) (mapcar proc (oref this targets)))
(defmethod ede-map-any-target-p ((this ede-project) proc) (cl-defmethod ede-map-any-target-p ((this ede-project) proc)
"For project THIS, map PROC to all targets and return if any non-nil. "For project THIS, map PROC to all targets and return if any non-nil.
Return the first non-nil value returned by PROC." Return the first non-nil value returned by PROC."
(eval (cons 'or (ede-map-targets this proc)))) (eval (cons 'or (ede-map-targets this proc))))
@ -1399,15 +1400,15 @@ Return the first non-nil value returned by PROC."
;; configuring items for Semantic. ;; configuring items for Semantic.
;; Generic paths ;; Generic paths
(defmethod ede-system-include-path ((this ede-project)) (cl-defmethod ede-system-include-path ((this ede-project))
"Get the system include path used by project THIS." "Get the system include path used by project THIS."
nil) nil)
(defmethod ede-system-include-path ((this ede-target)) (cl-defmethod ede-system-include-path ((this ede-target))
"Get the system include path used by project THIS." "Get the system include path used by project THIS."
nil) nil)
(defmethod ede-source-paths ((this ede-project) mode) (cl-defmethod ede-source-paths ((this ede-project) mode)
"Get the base to all source trees in the current project for MODE. "Get the base to all source trees in the current project for MODE.
For example, <root>/src for sources of c/c++, Java, etc, For example, <root>/src for sources of c/c++, Java, etc,
and <root>/doc for doc sources." and <root>/doc for doc sources."
@ -1435,20 +1436,20 @@ and <root>/doc for doc sources."
(message "Choosing preprocessor syms for project %s" (message "Choosing preprocessor syms for project %s"
(eieio-object-name (car objs))))))) (eieio-object-name (car objs)))))))
(defmethod ede-system-include-path ((this ede-project)) (cl-defmethod ede-system-include-path ((this ede-project))
"Get the system include path used by project THIS." "Get the system include path used by project THIS."
nil) nil)
(defmethod ede-preprocessor-map ((this ede-project)) (cl-defmethod ede-preprocessor-map ((this ede-project))
"Get the pre-processor map for project THIS." "Get the pre-processor map for project THIS."
nil) nil)
(defmethod ede-preprocessor-map ((this ede-target)) (cl-defmethod ede-preprocessor-map ((this ede-target))
"Get the pre-processor map for project THIS." "Get the pre-processor map for project THIS."
nil) nil)
;; Java ;; Java
(defmethod ede-java-classpath ((this ede-project)) (cl-defmethod ede-java-classpath ((this ede-project))
"Return the classpath for this project." "Return the classpath for this project."
;; @TODO - Can JDEE add something here? ;; @TODO - Can JDEE add something here?
nil) nil)
@ -1504,7 +1505,7 @@ It does not apply the value to buffers."
(error "Cannot set project variable until it is added with `ede-make-project-local-variable'")) (error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
(setcdr va value))) (setcdr va value)))
(defmethod ede-set-project-variables ((project ede-project) &optional buffer) (cl-defmethod ede-set-project-variables ((project ede-project) &optional buffer)
"Set variables local to PROJECT in BUFFER." "Set variables local to PROJECT in BUFFER."
(if (not buffer) (setq buffer (current-buffer))) (if (not buffer) (setq buffer (current-buffer)))
(with-current-buffer buffer (with-current-buffer buffer
@ -1512,7 +1513,7 @@ It does not apply the value to buffers."
(make-local-variable (car v)) (make-local-variable (car v))
(set (car v) (cdr v))))) (set (car v) (cdr v)))))
(defmethod ede-commit-local-variables ((proj ede-project)) (cl-defmethod ede-commit-local-variables ((proj ede-project))
"Commit change to local variables in PROJ." "Commit change to local variables in PROJ."
nil) nil)

13
lisp/cedet/ede/auto.el
View file

@ -30,6 +30,7 @@
;;; Code: ;;; Code:
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(declare-function ede-directory-safe-p "ede") (declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede") (declare-function ede-add-project-to-global-list "ede")
@ -62,7 +63,7 @@ location is varied dependent on other complex criteria, this class
can be used to define that match without loading the specific project can be used to define that match without loading the specific project
into memory.") into memory.")
(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch)) (cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system." "Return non-nil if the tool DIRMATCH might match is installed on the system."
(let ((fc (oref dirmatch fromconfig))) (let ((fc (oref dirmatch fromconfig)))
@ -77,7 +78,7 @@ into memory.")
(t (error "Unknown dirmatch type."))))) (t (error "Unknown dirmatch type.")))))
(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file) (cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE." "Does DIRMATCH match the filename FILE."
(let ((fc (oref dirmatch fromconfig))) (let ((fc (oref dirmatch fromconfig)))
@ -271,7 +272,7 @@ added. Possible values are:
;; ;;
;; New method using detect.el ;; New method using detect.el
(defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir) (cl-defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir)
"Return non-nil if THIS project autoload is found in DIR." "Return non-nil if THIS project autoload is found in DIR."
(let* ((d (file-name-as-directory dir)) (let* ((d (file-name-as-directory dir))
(pf (oref this proj-file)) (pf (oref this proj-file))
@ -288,7 +289,7 @@ added. Possible values are:
;(message "Dirmatch %S not installed." dirmatch) ;(message "Dirmatch %S not installed." dirmatch)
))))))) )))))))
(defmethod ede-auto-load-project ((this ede-project-autoload) dir) (cl-defmethod ede-auto-load-project ((this ede-project-autoload) dir)
"Load in the project associated with THIS project autoload description. "Load in the project associated with THIS project autoload description.
THIS project description should be valid for DIR, where the project will THIS project description should be valid for DIR, where the project will
be loaded. be loaded.
@ -315,13 +316,13 @@ NOTE: Do not call this - it should only be called from `ede-load-project-file'."
;; See if we can do without them. ;; See if we can do without them.
;; @FIXME - delete from loaddefs to remove this. ;; @FIXME - delete from loaddefs to remove this.
(defmethod ede-project-root ((this ede-project-autoload)) (cl-defmethod ede-project-root ((this ede-project-autoload))
"If a project knows its root, return it here. "If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems." Allows for one-project-object-for-a-tree type systems."
nil) nil)
;; @FIXME - delete from loaddefs to remove this. ;; @FIXME - delete from loaddefs to remove this.
(defmethod ede-project-root-directory ((this ede-project-autoload) &optional file) (cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
"" nil) "" nil)
(provide 'ede/auto) (provide 'ede/auto)

35
lisp/cedet/ede/base.el
View file

@ -27,6 +27,7 @@
;;; Code: ;;; Code:
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'eieio-speedbar) (require 'eieio-speedbar)
(require 'ede/auto) (require 'ede/auto)
@ -402,7 +403,7 @@ If set to nil, then the cache is not saved."
;; ;;
;; Mode related methods are in ede.el. These methods are related ;; Mode related methods are in ede.el. These methods are related
;; project specific activities not directly tied to a keybinding. ;; project specific activities not directly tied to a keybinding.
(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in) (cl-defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
"Get a path name for PROJ which is relative to the parent project. "Get a path name for PROJ which is relative to the parent project.
If PARENT is specified, then be relative to the PARENT project. If PARENT is specified, then be relative to the PARENT project.
Specifying PARENT is useful for sub-sub projects relative to the root project." Specifying PARENT is useful for sub-sub projects relative to the root project."
@ -412,7 +413,7 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
(file-relative-name dir (file-name-directory (oref parent file))) (file-relative-name dir (file-name-directory (oref parent file)))
""))) "")))
(defmethod ede-subproject-p ((proj ede-project)) (cl-defmethod ede-subproject-p ((proj ede-project))
"Return non-nil if PROJ is a sub project." "Return non-nil if PROJ is a sub project."
;; @TODO - Use this in more places, and also pay attention to ;; @TODO - Use this in more places, and also pay attention to
;; metasubproject in ede/proj.el ;; metasubproject in ede/proj.el
@ -425,26 +426,26 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
;; no need to in most situations because they are either a) simple, or ;; no need to in most situations because they are either a) simple, or
;; b) cosmetic. ;; b) cosmetic.
(defmethod ede-name ((this ede-target)) (cl-defmethod ede-name ((this ede-target))
"Return the name of THIS target." "Return the name of THIS target."
(oref this name)) (oref this name))
(defmethod ede-target-name ((this ede-target)) (cl-defmethod ede-target-name ((this ede-target))
"Return the name of THIS target, suitable for make or debug style commands." "Return the name of THIS target, suitable for make or debug style commands."
(oref this name)) (oref this name))
(defmethod ede-name ((this ede-project)) (cl-defmethod ede-name ((this ede-project))
"Return a short-name for THIS project file. "Return a short-name for THIS project file.
Do this by extracting the lowest directory name." Do this by extracting the lowest directory name."
(oref this name)) (oref this name))
(defmethod ede-description ((this ede-project)) (cl-defmethod ede-description ((this ede-project))
"Return a description suitable for the minibuffer about THIS." "Return a description suitable for the minibuffer about THIS."
(format "Project %s: %d subprojects, %d targets." (format "Project %s: %d subprojects, %d targets."
(ede-name this) (length (oref this subproj)) (ede-name this) (length (oref this subproj))
(length (oref this targets)))) (length (oref this targets))))
(defmethod ede-description ((this ede-target)) (cl-defmethod ede-description ((this ede-target))
"Return a description suitable for the minibuffer about THIS." "Return a description suitable for the minibuffer about THIS."
(format "Target %s: with %d source files." (format "Target %s: with %d source files."
(ede-name this) (length (oref this source)))) (ede-name this) (length (oref this source))))
@ -463,11 +464,11 @@ Not all buffers need headers, so return nil if no applicable."
(ede-buffer-header-file ede-object (current-buffer)) (ede-buffer-header-file ede-object (current-buffer))
nil)) nil))
(defmethod ede-buffer-header-file ((this ede-project) buffer) (cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
"Return nil, projects don't have header files." "Return nil, projects don't have header files."
nil) nil)
(defmethod ede-buffer-header-file ((this ede-target) buffer) (cl-defmethod ede-buffer-header-file ((this ede-target) buffer)
"There are no default header files in EDE. "There are no default header files in EDE.
Do a quick check to see if there is a Header tag in this buffer." Do a quick check to see if there is a Header tag in this buffer."
(with-current-buffer buffer (with-current-buffer buffer
@ -489,12 +490,12 @@ Some projects may have multiple documentation files, so return a list."
(ede-buffer-documentation-files ede-object (current-buffer)) (ede-buffer-documentation-files ede-object (current-buffer))
nil)) nil))
(defmethod ede-buffer-documentation-files ((this ede-project) buffer) (cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
"Return all documentation in project THIS based on BUFFER." "Return all documentation in project THIS based on BUFFER."
;; Find the info node. ;; Find the info node.
(ede-documentation this)) (ede-documentation this))
(defmethod ede-buffer-documentation-files ((this ede-target) buffer) (cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
"Check for some documentation files for THIS. "Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER." Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer (with-current-buffer buffer
@ -505,7 +506,7 @@ Also do a quick check to see if there is a Documentation tag in this BUFFER."
(let ((cp (ede-toplevel))) (let ((cp (ede-toplevel)))
(ede-buffer-documentation-files cp (current-buffer)))))) (ede-buffer-documentation-files cp (current-buffer))))))
(defmethod ede-documentation ((this ede-project)) (cl-defmethod ede-documentation ((this ede-project))
"Return a list of files that provide documentation. "Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other Documentation is not for object THIS, but is provided by THIS for other
files in the project." files in the project."
@ -520,7 +521,7 @@ files in the project."
proj (cdr proj))) proj (cdr proj)))
found)) found))
(defmethod ede-documentation ((this ede-target)) (cl-defmethod ede-documentation ((this ede-target))
"Return a list of files that provide documentation. "Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other Documentation is not for object THIS, but is provided by THIS for other
files in the project." files in the project."
@ -531,7 +532,7 @@ files in the project."
(ede-html-documentation (ede-toplevel)) (ede-html-documentation (ede-toplevel))
) )
(defmethod ede-html-documentation ((this ede-project)) (cl-defmethod ede-html-documentation ((this ede-project))
"Return a list of HTML files provided by project THIS." "Return a list of HTML files provided by project THIS."
) )
@ -541,7 +542,7 @@ files in the project."
;; These methods are used to determine if a target "wants", or could ;; These methods are used to determine if a target "wants", or could
;; somehow handle a file, or some source type. ;; somehow handle a file, or some source type.
;; ;;
(defmethod ede-want-file-p ((this ede-target) file) (cl-defmethod ede-want-file-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE." "Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide. ;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this))) (let ((src (ede-target-sourcecode this)))
@ -549,7 +550,7 @@ files in the project."
(setq src (cdr src))) (setq src (cdr src)))
src)) src))
(defmethod ede-want-file-source-p ((this ede-target) file) (cl-defmethod ede-want-file-source-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE." "Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide. ;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this))) (let ((src (ede-target-sourcecode this)))
@ -557,7 +558,7 @@ files in the project."
(setq src (cdr src))) (setq src (cdr src)))
src)) src))
(defmethod ede-target-sourcecode ((this ede-target)) (cl-defmethod ede-target-sourcecode ((this ede-target))
"Return the sourcecode objects which THIS permits." "Return the sourcecode objects which THIS permits."
(let ((sc (oref this sourcetype)) (let ((sc (oref this sourcetype))
(rs nil)) (rs nil))

30
lisp/cedet/ede/config.el
View file

@ -113,7 +113,7 @@ initialize the :file slot of the persistent baseclass.")
;;; Rescanning ;;; Rescanning
(defmethod project-rescan ((this ede-project-with-config)) (cl-defmethod project-rescan ((this ede-project-with-config))
"Rescan this generic project from the sources." "Rescan this generic project from the sources."
;; Force the config to be rescanned. ;; Force the config to be rescanned.
(oset this config nil) (oset this config nil)
@ -123,7 +123,7 @@ initialize the :file slot of the persistent baseclass.")
;;; Project Methods for configuration ;;; Project Methods for configuration
(defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask) (cl-defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask)
"Return the configuration for the project PROJ. "Return the configuration for the project PROJ.
If optional LOADASK is non-nil, then if a project file exists, and if If optional LOADASK is non-nil, then if a project file exists, and if
the directory isn't on the `safe' list, ask to add it to the safe list." the directory isn't on the `safe' list, ask to add it to the safe list."
@ -170,28 +170,28 @@ the directory isn't on the `safe' list, ask to add it to the safe list."
(oset config project proj))) (oset config project proj)))
config)) config))
(defmethod ede-config-setup-configuration ((proj ede-project-with-config) config) (cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
"Default configuration setup method." "Default configuration setup method."
nil) nil)
(defmethod ede-commit-project ((proj ede-project-with-config)) (cl-defmethod ede-commit-project ((proj ede-project-with-config))
"Commit any change to PROJ to its file." "Commit any change to PROJ to its file."
(let ((config (ede-config-get-configuration proj))) (let ((config (ede-config-get-configuration proj)))
(ede-commit config))) (ede-commit config)))
;;; Customization ;;; Customization
;; ;;
(defmethod ede-customize ((proj ede-project-with-config)) (cl-defmethod ede-customize ((proj ede-project-with-config))
"Customize the EDE project PROJ by actually configuring the config object." "Customize the EDE project PROJ by actually configuring the config object."
(let ((config (ede-config-get-configuration proj t))) (let ((config (ede-config-get-configuration proj t)))
(eieio-customize-object config))) (eieio-customize-object config)))
(defmethod ede-customize ((target ede-target-with-config)) (cl-defmethod ede-customize ((target ede-target-with-config))
"Customize the EDE TARGET by actually configuring the config object." "Customize the EDE TARGET by actually configuring the config object."
;; Nothing unique for the targets, use the project. ;; Nothing unique for the targets, use the project.
(ede-customize-project)) (ede-customize-project))
(defmethod eieio-done-customizing ((config ede-extra-config)) (cl-defmethod eieio-done-customizing ((config ede-extra-config))
"Called when EIEIO is done customizing the configuration object. "Called when EIEIO is done customizing the configuration object.
We need to go back through the old buffers, and update them with We need to go back through the old buffers, and update them with
the new configuration." the new configuration."
@ -206,7 +206,7 @@ the new configuration."
(with-current-buffer b (with-current-buffer b
(ede-apply-target-options))))))) (ede-apply-target-options)))))))
(defmethod ede-commit ((config ede-extra-config)) (cl-defmethod ede-commit ((config ede-extra-config))
"Commit all changes to the configuration to disk." "Commit all changes to the configuration to disk."
;; So long as the user is trying to safe this config, make sure they can ;; So long as the user is trying to safe this config, make sure they can
;; get at it again later. ;; get at it again later.
@ -253,7 +253,7 @@ the new configuration."
This class brings in method overloads for running and debugging This class brings in method overloads for running and debugging
programs from a project.") programs from a project.")
(defmethod project-debug-target ((target ede-target-with-config-program)) (cl-defmethod project-debug-target ((target ede-target-with-config-program))
"Run the current project derived from TARGET in a debugger." "Run the current project derived from TARGET in a debugger."
(let* ((proj (ede-target-parent target)) (let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t)) (config (ede-config-get-configuration proj t))
@ -268,7 +268,7 @@ programs from a project.")
(cmdsym (intern-soft (car cmdsplit)))) (cmdsym (intern-soft (car cmdsplit))))
(call-interactively cmdsym t))) (call-interactively cmdsym t)))
(defmethod project-run-target ((target ede-target-with-config-program)) (cl-defmethod project-run-target ((target ede-target-with-config-program))
"Run the current project derived from TARGET." "Run the current project derived from TARGET."
(let* ((proj (ede-target-parent target)) (let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t)) (config (ede-config-get-configuration proj t))
@ -299,14 +299,14 @@ This class brings in method overloads for building.")
"Class to mix into a project with configuration for builds. "Class to mix into a project with configuration for builds.
This class brings in method overloads for for building.") This class brings in method overloads for for building.")
(defmethod project-compile-project ((proj ede-project-with-config-build) &optional command) (cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
"Compile the entire current project PROJ. "Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
(let* ((config (ede-config-get-configuration proj t)) (let* ((config (ede-config-get-configuration proj t))
(comp (oref config :build-command))) (comp (oref config :build-command)))
(compile comp))) (compile comp)))
(defmethod project-compile-target ((obj ede-target-with-config-build) &optional command) (cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
"Compile the current target OBJ. "Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command)) (project-compile-project (ede-current-project) command))
@ -358,7 +358,7 @@ parsed again."))
This target brings in methods used by Semantic to query This target brings in methods used by Semantic to query
the preprocessor map, and include paths.") the preprocessor map, and include paths.")
(defmethod ede-preprocessor-map ((this ede-target-with-config-c)) (cl-defmethod ede-preprocessor-map ((this ede-target-with-config-c))
"Get the pre-processor map for some generic C code." "Get the pre-processor map for some generic C code."
(let* ((proj (ede-target-parent this)) (let* ((proj (ede-target-parent this))
(root (ede-project-root proj)) (root (ede-project-root proj))
@ -380,7 +380,7 @@ the preprocessor map, and include paths.")
filemap filemap
)) ))
(defmethod ede-system-include-path ((this ede-target-with-config-c)) (cl-defmethod ede-system-include-path ((this ede-target-with-config-c))
"Get the system include path used by project THIS." "Get the system include path used by project THIS."
(let* ((proj (ede-target-parent this)) (let* ((proj (ede-target-parent this))
(config (ede-config-get-configuration proj))) (config (ede-config-get-configuration proj)))
@ -402,7 +402,7 @@ java class path.")
() ()
"Class to mix into a project to support java.") "Class to mix into a project to support java.")
(defmethod ede-java-classpath ((proj ede-project-with-config-java)) (cl-defmethod ede-java-classpath ((proj ede-project-with-config-java))
"Return the classpath for this project." "Return the classpath for this project."
(oref (ede-config-get-configuration proj) :classpath)) (oref (ede-config-get-configuration proj) :classpath))

38
lisp/cedet/ede/cpp-root.el
View file

@ -276,11 +276,11 @@ Each directory needs a project file to control it.")
;; find previous copies of this project, and make sure that one of the ;; find previous copies of this project, and make sure that one of the
;; objects is deleted. ;; objects is deleted.
(defmethod initialize-instance ((this ede-cpp-root-project) (cl-defmethod initialize-instance ((this ede-cpp-root-project)
&rest fields) &rest fields)
"Make sure the :file is fully expanded." "Make sure the :file is fully expanded."
;; Add ourselves to the master list ;; Add ourselves to the master list
(call-next-method) (cl-call-next-method)
(let ((f (expand-file-name (oref this :file)))) (let ((f (expand-file-name (oref this :file))))
;; Remove any previous entries from the main list. ;; Remove any previous entries from the main list.
(let ((old (eieio-instance-tracker-find (file-name-directory f) (let ((old (eieio-instance-tracker-find (file-name-directory f)
@ -311,7 +311,7 @@ Each directory needs a project file to control it.")
;; This is a way to allow a subdirectory to point back to the root ;; This is a way to allow a subdirectory to point back to the root
;; project, simplifying authoring new single-point projects. ;; project, simplifying authoring new single-point projects.
(defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project) (cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
dir) dir)
"Return PROJ, for handling all subdirs below DIR." "Return PROJ, for handling all subdirs below DIR."
proj) proj)
@ -321,7 +321,7 @@ Each directory needs a project file to control it.")
;; Creating new targets on a per directory basis is a good way to keep ;; Creating new targets on a per directory basis is a good way to keep
;; files organized. See ede-emacs for an example with multiple file ;; files organized. See ede-emacs for an example with multiple file
;; types. ;; types.
(defmethod ede-find-target ((proj ede-cpp-root-project) buffer) (cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
"Find an EDE target in PROJ for BUFFER. "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory." If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets)) (let* ((targets (oref proj targets))
@ -347,13 +347,13 @@ If one doesn't exist, create a new one for this directory."
;; ;;
;; This tools also uses the ede-locate setup for augmented file name ;; This tools also uses the ede-locate setup for augmented file name
;; lookup using external tools. ;; lookup using external tools.
(defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name) (cl-defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
"Within this project PROJ, find the file NAME. "Within this project PROJ, find the file NAME.
This knows details about or source tree." This knows details about or source tree."
;; The slow part of the original is looping over subprojects. ;; The slow part of the original is looping over subprojects.
;; This version has no subprojects, so this will handle some ;; This version has no subprojects, so this will handle some
;; basic cases. ;; basic cases.
(let ((ans (call-next-method))) (let ((ans (cl-call-next-method)))
(unless ans (unless ans
(let* ((lf (oref proj locate-fcn)) (let* ((lf (oref proj locate-fcn))
(dir (file-name-directory (oref proj file)))) (dir (file-name-directory (oref proj file))))
@ -372,16 +372,16 @@ This knows details about or source tree."
(setq ans tmp)) (setq ans tmp))
(setq ip (cdr ip)) )) (setq ip (cdr ip)) ))
;; Else, do the usual. ;; Else, do the usual.
(setq ans (call-next-method))) (setq ans (cl-call-next-method)))
))) )))
;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here? ;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here?
(or ans (call-next-method)))) (or ans (cl-call-next-method))))
(defmethod ede-project-root ((this ede-cpp-root-project)) (cl-defmethod ede-project-root ((this ede-cpp-root-project))
"Return my root." "Return my root."
this) this)
(defmethod ede-project-root-directory ((this ede-cpp-root-project)) (cl-defmethod ede-project-root-directory ((this ede-cpp-root-project))
"Return my root." "Return my root."
(oref this directory)) (oref this directory))
@ -390,12 +390,12 @@ This knows details about or source tree."
;; The following code is specific to setting up header files, ;; The following code is specific to setting up header files,
;; include lists, and Preprocessor symbol tables. ;; include lists, and Preprocessor symbol tables.
(defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name) (cl-defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
"Non nil if in PROJ the filename NAME is a header." "Non nil if in PROJ the filename NAME is a header."
(save-match-data (save-match-data
(string-match (oref proj header-match-regexp) name))) (string-match (oref proj header-match-regexp) name)))
(defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename) (cl-defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
"For PROJ, translate a user specified FILENAME. "For PROJ, translate a user specified FILENAME.
This is for project include paths and spp source files." This is for project include paths and spp source files."
;; Step one: Root of this project. ;; Step one: Root of this project.
@ -411,11 +411,11 @@ This is for project include paths and spp source files."
filename)) filename))
(defmethod ede-system-include-path ((this ede-cpp-root-project)) (cl-defmethod ede-system-include-path ((this ede-cpp-root-project))
"Get the system include path used by project THIS." "Get the system include path used by project THIS."
(oref this system-include-path)) (oref this system-include-path))
(defmethod ede-preprocessor-map ((this ede-cpp-root-project)) (cl-defmethod ede-preprocessor-map ((this ede-cpp-root-project))
"Get the pre-processor map for project THIS." "Get the pre-processor map for project THIS."
(require 'semantic/db) (require 'semantic/db)
(let ((spp (oref this spp-table)) (let ((spp (oref this spp-table))
@ -445,15 +445,15 @@ This is for project include paths and spp source files."
(oref this spp-files)) (oref this spp-files))
spp)) spp))
(defmethod ede-system-include-path ((this ede-cpp-root-target)) (cl-defmethod ede-system-include-path ((this ede-cpp-root-target))
"Get the system include path used by target THIS." "Get the system include path used by target THIS."
(ede-system-include-path (ede-target-parent this))) (ede-system-include-path (ede-target-parent this)))
(defmethod ede-preprocessor-map ((this ede-cpp-root-target)) (cl-defmethod ede-preprocessor-map ((this ede-cpp-root-target))
"Get the pre-processor map for project THIS." "Get the pre-processor map for project THIS."
(ede-preprocessor-map (ede-target-parent this))) (ede-preprocessor-map (ede-target-parent this)))
(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command) (cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
"Compile the entire current project PROJ. "Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work ;; we need to be in the proj root dir for this to work
@ -469,14 +469,14 @@ Argument COMMAND is the command to use when compiling."
(let ((default-directory (ede-project-root-directory proj))) (let ((default-directory (ede-project-root-directory proj)))
(compile cmd-str))))) (compile cmd-str)))))
(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command) (cl-defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
"Compile the current target OBJ. "Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(when (oref obj :project) (when (oref obj :project)
(project-compile-project (oref obj :project) command))) (project-compile-project (oref obj :project) command)))
(defmethod project-rescan ((this ede-cpp-root-project)) (cl-defmethod project-rescan ((this ede-cpp-root-project))
"Don't rescan this project from the sources." "Don't rescan this project from the sources."
(message "cpp-root has nothing to rescan.")) (message "cpp-root has nothing to rescan."))

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

@ -76,11 +76,11 @@ OBJ is the target object to customize."
(error "No logical target to customize")) (error "No logical target to customize"))
(ede-customize obj)) (ede-customize obj))
(defmethod ede-customize ((proj ede-project)) (cl-defmethod ede-customize ((proj ede-project))
"Customize the EDE project PROJ." "Customize the EDE project PROJ."
(eieio-customize-object proj 'default)) (eieio-customize-object proj 'default))
(defmethod ede-customize ((target ede-target)) (cl-defmethod ede-customize ((target ede-target))
"Customize the EDE TARGET." "Customize the EDE TARGET."
(eieio-customize-object target 'default)) (eieio-customize-object target 'default))
@ -177,7 +177,7 @@ OBJ is the target object to customize."
;;; Customization hooks ;;; Customization hooks
;; ;;
;; These hooks are used when finishing up a customization. ;; These hooks are used when finishing up a customization.
(defmethod eieio-done-customizing ((proj ede-project)) (cl-defmethod eieio-done-customizing ((proj ede-project))
"Call this when a user finishes customizing PROJ." "Call this when a user finishes customizing PROJ."
(let ((ov eieio-ede-old-variables) (let ((ov eieio-ede-old-variables)
(nv (oref proj local-variables))) (nv (oref proj local-variables)))
@ -196,11 +196,11 @@ OBJ is the target object to customize."
;; These two methods should be implemented by subclasses of ;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified ;; project and targets in order to account for user specified
;; changes. ;; changes.
(defmethod eieio-done-customizing ((target ede-target)) (cl-defmethod eieio-done-customizing ((target ede-target))
"Call this when a user finishes customizing TARGET." "Call this when a user finishes customizing TARGET."
nil) nil)
(defmethod ede-commit-project ((proj ede-project)) (cl-defmethod ede-commit-project ((proj ede-project))
"Commit any change to PROJ to its file." "Commit any change to PROJ to its file."
nil nil
) )

20
lisp/cedet/ede/emacs.el
View file

@ -141,25 +141,25 @@ All directories need at least one target.")
"EDE Emacs Project target for Misc files. "EDE Emacs Project target for Misc files.
All directories need at least one target.") All directories need at least one target.")
(defmethod initialize-instance ((this ede-emacs-project) (cl-defmethod initialize-instance ((this ede-emacs-project)
&rest fields) &rest fields)
"Make sure the targets slot is bound." "Make sure the targets slot is bound."
(call-next-method) (cl-call-next-method)
(unless (slot-boundp this 'targets) (unless (slot-boundp this 'targets)
(oset this :targets nil))) (oset this :targets nil)))
;;; File Stuff ;;; File Stuff
;; ;;
(defmethod ede-project-root-directory ((this ede-emacs-project) (cl-defmethod ede-project-root-directory ((this ede-emacs-project)
&optional file) &optional file)
"Return the root for THIS Emacs project with file." "Return the root for THIS Emacs project with file."
(ede-up-directory (file-name-directory (oref this file)))) (ede-up-directory (file-name-directory (oref this file))))
(defmethod ede-project-root ((this ede-emacs-project)) (cl-defmethod ede-project-root ((this ede-emacs-project))
"Return my root." "Return my root."
this) this)
(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project) (cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
dir) dir)
"Return PROJ, for handling all subdirs below DIR." "Return PROJ, for handling all subdirs below DIR."
proj) proj)
@ -176,7 +176,7 @@ All directories need at least one target.")
)) ))
match)) match))
(defmethod ede-find-target ((proj ede-emacs-project) buffer) (cl-defmethod ede-find-target ((proj ede-emacs-project) buffer)
"Find an EDE target in PROJ for BUFFER. "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory." If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer))) (let* ((ext (file-name-extension (buffer-file-name buffer)))
@ -204,7 +204,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT. ;;; UTILITIES SUPPORT.
;; ;;
(defmethod ede-preprocessor-map ((this ede-emacs-target-c)) (cl-defmethod ede-preprocessor-map ((this ede-emacs-target-c))
"Get the pre-processor map for Emacs C code. "Get the pre-processor map for Emacs C code.
All files need the macros from lisp.h!" All files need the macros from lisp.h!"
(require 'semantic/db) (require 'semantic/db)
@ -253,7 +253,7 @@ All files need the macros from lisp.h!"
(setq dirs (cdr dirs)))) (setq dirs (cdr dirs))))
ans)) ans))
(defmethod ede-expand-filename-impl ((proj ede-emacs-project) name) (cl-defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
"Within this project PROJ, find the file NAME. "Within this project PROJ, find the file NAME.
Knows about how the Emacs source tree is organized." Knows about how the Emacs source tree is organized."
(let* ((ext (file-name-extension name)) (let* ((ext (file-name-extension name))
@ -269,13 +269,13 @@ Knows about how the Emacs source tree is organized."
'("doc")) '("doc"))
(t nil))) (t nil)))
) )
(if (not dirs) (call-next-method) (if (not dirs) (cl-call-next-method)
(ede-emacs-find-in-directories name dir dirs)) (ede-emacs-find-in-directories name dir dirs))
)) ))
;;; Command Support ;;; Command Support
;; ;;
(defmethod project-rescan ((this ede-emacs-project)) (cl-defmethod project-rescan ((this ede-emacs-project))
"Rescan this Emacs project from the sources." "Rescan this Emacs project from the sources."
(let ((ver (ede-emacs-version (ede-project-root-directory this)))) (let ((ver (ede-emacs-version (ede-project-root-directory this))))
(oset this name (car ver)) (oset this name (car ver))

22
lisp/cedet/ede/files.el
View file

@ -69,12 +69,12 @@ the current EDE project."
;;; Placeholders for ROOT directory scanning on base objects ;;; Placeholders for ROOT directory scanning on base objects
;; ;;
(defmethod ede-project-root ((this ede-project-placeholder)) (cl-defmethod ede-project-root ((this ede-project-placeholder))
"If a project knows its root, return it here. "If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems." Allows for one-project-object-for-a-tree type systems."
(oref this rootproject)) (oref this rootproject))
(defmethod ede-project-root-directory ((this ede-project-placeholder) (cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
&optional file) &optional file)
"If a project knows its root, return it here. "If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems. Allows for one-project-object-for-a-tree type systems.
@ -116,7 +116,7 @@ of the anchor file for the project."
(ede--put-inode-dir-hash dir (nth 10 fattr)) (ede--put-inode-dir-hash dir (nth 10 fattr))
))))) )))))
(defmethod ede--project-inode ((proj ede-project-placeholder)) (cl-defmethod ede--project-inode ((proj ede-project-placeholder))
"Get the inode of the directory project PROJ is in." "Get the inode of the directory project PROJ is in."
(if (slot-boundp proj 'dirinode) (if (slot-boundp proj 'dirinode)
(oref proj dirinode) (oref proj dirinode)
@ -217,7 +217,7 @@ If optional EXACT is non-nil, only return exact matches for DIR."
;; the short answer we found -> ie - we are in a subproject. ;; the short answer we found -> ie - we are in a subproject.
(or ans shortans))) (or ans shortans)))
(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder) (cl-defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
dir) dir)
"Find a subproject of PROJ that corresponds to DIR." "Find a subproject of PROJ that corresponds to DIR."
(if ede--disable-inode (if ede--disable-inode
@ -374,7 +374,7 @@ If DIR is not part of a project, return nil."
;;; DIRECTORY CONVERSION STUFF ;;; DIRECTORY CONVERSION STUFF
;; ;;
(defmethod ede-convert-path ((this ede-project) path) (cl-defmethod ede-convert-path ((this ede-project) path)
"Convert path in a standard way for a given project. "Convert path in a standard way for a given project.
Default to making it project relative. Default to making it project relative.
Argument THIS is the project to convert PATH to." Argument THIS is the project to convert PATH to."
@ -388,7 +388,7 @@ Argument THIS is the project to convert PATH to."
(substring fptf (match-end 0)) (substring fptf (match-end 0))
(error "Cannot convert relativize path %s" fp)))))) (error "Cannot convert relativize path %s" fp))))))
(defmethod ede-convert-path ((this ede-target) path &optional project) (cl-defmethod ede-convert-path ((this ede-target) path &optional project)
"Convert path in a standard way for a given project. "Convert path in a standard way for a given project.
Default to making it project relative. Default to making it project relative.
Argument THIS is the project to convert PATH to. Argument THIS is the project to convert PATH to.
@ -419,7 +419,7 @@ Get it from the toplevel project. If it doesn't have one, make one."
(oref top locate-obj) (oref top locate-obj)
))) )))
(defmethod ede-expand-filename ((this ede-project) filename &optional force) (cl-defmethod ede-expand-filename ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS. "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled FILENAME should be just a filename which occurs in a directory controlled
by this project. by this project.
@ -476,7 +476,7 @@ is returned."
ans)) ans))
(defmethod ede-expand-filename-impl ((this ede-project) filename &optional force) (cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS. "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled FILENAME should be just a filename which occurs in a directory controlled
by this project. by this project.
@ -496,7 +496,7 @@ doesn't exist."
;; Return it ;; Return it
found)) found))
(defmethod ede-expand-filename-local ((this ede-project) filename) (cl-defmethod ede-expand-filename-local ((this ede-project) filename)
"Expand filename locally to project THIS with filesystem tests." "Expand filename locally to project THIS with filesystem tests."
(let ((path (ede-project-root-directory this))) (let ((path (ede-project-root-directory this)))
(cond ((file-exists-p (expand-file-name filename path)) (cond ((file-exists-p (expand-file-name filename path))
@ -504,7 +504,7 @@ doesn't exist."
((file-exists-p (expand-file-name (concat "include/" filename) path)) ((file-exists-p (expand-file-name (concat "include/" filename) path))
(expand-file-name (concat "include/" filename) path))))) (expand-file-name (concat "include/" filename) path)))))
(defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename) (cl-defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
"Return a fully qualified file name based on project THIS. "Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled FILENAME should be just a filename which occurs in a directory controlled
by this project." by this project."
@ -520,7 +520,7 @@ by this project."
;; Return it ;; Return it
found)) found))
(defmethod ede-expand-filename ((this ede-target) filename &optional force) (cl-defmethod ede-expand-filename ((this ede-target) filename &optional force)
"Return a fully qualified file name based on target THIS. "Return a fully qualified file name based on target THIS.
FILENAME should be a filename which occurs in a directory in which THIS works. FILENAME should be a filename which occurs in a directory in which THIS works.
Optional argument FORCE forces the default filename to be provided even if it Optional argument FORCE forces the default filename to be provided even if it

18
lisp/cedet/ede/generic.el
View file

@ -148,19 +148,19 @@ The class allocated value is replace by different sub classes.")
"The baseclass for all generic EDE project types." "The baseclass for all generic EDE project types."
:abstract t) :abstract t)
(defmethod initialize-instance ((this ede-generic-project) (cl-defmethod initialize-instance ((this ede-generic-project)
&rest fields) &rest fields)
"Make sure the targets slot is bound." "Make sure the targets slot is bound."
(call-next-method) (cl-call-next-method)
(unless (slot-boundp this 'targets) (unless (slot-boundp this 'targets)
(oset this :targets nil)) (oset this :targets nil))
) )
(defmethod ede-project-root ((this ede-generic-project)) (cl-defmethod ede-project-root ((this ede-generic-project))
"Return my root." "Return my root."
this) this)
(defmethod ede-find-subproject-for-directory ((proj ede-generic-project) (cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
dir) dir)
"Return PROJ, for handling all subdirs below DIR." "Return PROJ, for handling all subdirs below DIR."
proj) proj)
@ -216,7 +216,7 @@ All directories need at least one target.")
)) ))
match)) match))
(defmethod ede-find-target ((proj ede-generic-project) buffer) (cl-defmethod ede-find-target ((proj ede-generic-project) buffer)
"Find an EDE target in PROJ for BUFFER. "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory." If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer))) (let* ((ext (file-name-extension (buffer-file-name buffer)))
@ -322,7 +322,7 @@ the class `ede-generic-project' project."
) )
"Generic Project for makefiles.") "Generic Project for makefiles.")
(defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config) (cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
"Setup a configuration for Make." "Setup a configuration for Make."
(oset config build-command "make -k") (oset config build-command "make -k")
(oset config debug-command "gdb ") (oset config debug-command "gdb ")
@ -335,7 +335,7 @@ the class `ede-generic-project' project."
) )
"Generic Project for scons.") "Generic Project for scons.")
(defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config) (cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
"Setup a configuration for SCONS." "Setup a configuration for SCONS."
(oset config build-command "scons") (oset config build-command "scons")
(oset config debug-command "gdb ") (oset config debug-command "gdb ")
@ -348,7 +348,7 @@ the class `ede-generic-project' project."
) )
"Generic Project for cmake.") "Generic Project for cmake.")
(defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config) (cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
"Setup a configuration for CMake." "Setup a configuration for CMake."
(oset config build-command "cmake") (oset config build-command "cmake")
(oset config debug-command "gdb ") (oset config debug-command "gdb ")
@ -359,7 +359,7 @@ the class `ede-generic-project' project."
() ()
"Generic project found via Version Control files.") "Generic project found via Version Control files.")
(defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config) (cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
"Setup a configuration for projects identified by revision control." "Setup a configuration for projects identified by revision control."
) )

24
lisp/cedet/ede/linux.el
View file

@ -231,25 +231,25 @@ All directories need at least one target.")
"EDE Linux Project target for Misc files. "EDE Linux Project target for Misc files.
All directories need at least one target.") All directories need at least one target.")
(defmethod initialize-instance ((this ede-linux-project) (cl-defmethod initialize-instance ((this ede-linux-project)
&rest fields) &rest fields)
"Make sure the targets slot is bound." "Make sure the targets slot is bound."
(call-next-method) (cl-call-next-method)
(unless (slot-boundp this 'targets) (unless (slot-boundp this 'targets)
(oset this :targets nil))) (oset this :targets nil)))
;;; File Stuff ;;; File Stuff
;; ;;
(defmethod ede-project-root-directory ((this ede-linux-project) (cl-defmethod ede-project-root-directory ((this ede-linux-project)
&optional file) &optional file)
"Return the root for THIS Linux project with file." "Return the root for THIS Linux project with file."
(ede-up-directory (file-name-directory (oref this file)))) (ede-up-directory (file-name-directory (oref this file))))
(defmethod ede-project-root ((this ede-linux-project)) (cl-defmethod ede-project-root ((this ede-linux-project))
"Return my root." "Return my root."
this) this)
(defmethod ede-find-subproject-for-directory ((proj ede-linux-project) (cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
dir) dir)
"Return PROJ, for handling all subdirs below DIR." "Return PROJ, for handling all subdirs below DIR."
proj) proj)
@ -266,7 +266,7 @@ All directories need at least one target.")
)) ))
match)) match))
(defmethod ede-find-target ((proj ede-linux-project) buffer) (cl-defmethod ede-find-target ((proj ede-linux-project) buffer)
"Find an EDE target in PROJ for BUFFER. "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory." If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer))) (let* ((ext (file-name-extension (buffer-file-name buffer)))
@ -292,7 +292,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT. ;;; UTILITIES SUPPORT.
;; ;;
(defmethod ede-preprocessor-map ((this ede-linux-target-c)) (cl-defmethod ede-preprocessor-map ((this ede-linux-target-c))
"Get the pre-processor map for Linux C code. "Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!" All files need the macros from lisp.h!"
(require 'semantic/db) (require 'semantic/db)
@ -317,7 +317,7 @@ All files need the macros from lisp.h!"
(let ((F (expand-file-name name (expand-file-name subdir root)))) (let ((F (expand-file-name name (expand-file-name subdir root))))
(when (file-exists-p F) F))) (when (file-exists-p F) F)))
(defmethod ede-expand-filename-impl ((proj ede-linux-project) name) (cl-defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
"Within this project PROJ, find the file NAME. "Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized." Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name)) (let* ((ext (file-name-extension name))
@ -338,11 +338,11 @@ Knows about how the Linux source tree is organized."
((string-match "txt" ext) ((string-match "txt" ext)
(ede-linux-file-exists-name name dir "Documentation")) (ede-linux-file-exists-name name dir "Documentation"))
(t nil)))) (t nil))))
(or F (call-next-method)))) (or F (cl-call-next-method))))
;;; Command Support ;;; Command Support
;; ;;
(defmethod project-compile-project ((proj ede-linux-project) (cl-defmethod project-compile-project ((proj ede-linux-project)
&optional command) &optional command)
"Compile the entire current project. "Compile the entire current project.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
@ -359,7 +359,7 @@ Argument COMMAND is the command to use when compiling."
(compile command))) (compile command)))
(defmethod project-compile-target ((obj ede-linux-target-c) &optional command) (cl-defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
"Compile the current target. "Compile the current target.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(let* ((proj (ede-target-parent obj)) (let* ((proj (ede-target-parent obj))
@ -378,7 +378,7 @@ Argument COMMAND is the command to use for compiling the target."
(compile command))) (compile command)))
(defmethod project-rescan ((this ede-linux-project)) (cl-defmethod project-rescan ((this ede-linux-project))
"Rescan this Linux project from the sources." "Rescan this Linux project from the sources."
(let* ((dir (ede-project-root-directory this)) (let* ((dir (ede-project-root-directory this))
(bdir (ede-linux--get-build-directory dir)) (bdir (ede-linux--get-build-directory dir))

60
lisp/cedet/ede/locate.el
View file

@ -110,34 +110,34 @@ based on `ede-locate-setup-options'."
) )
"Baseclass for LOCATE feature in EDE.") "Baseclass for LOCATE feature in EDE.")
(defmethod initialize-instance ((loc ede-locate-base) &rest fields) (cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
"Make sure we have a hash table." "Make sure we have a hash table."
;; Basic setup. ;; Basic setup.
(call-next-method) (cl-call-next-method)
;; Make sure we have a hash table. ;; Make sure we have a hash table.
(ede-locate-flush-hash loc) (ede-locate-flush-hash loc)
) )
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-base) (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
root) root)
"Is it ok to use this project type under ROOT." "Is it ok to use this project type under ROOT."
t) t)
(defmethod ede-locate-flush-hash ((loc ede-locate-base)) (cl-defmethod ede-locate-flush-hash ((loc ede-locate-base))
"For LOC, flush hashtable and start from scratch." "For LOC, flush hashtable and start from scratch."
(oset loc hash (make-hash-table :test 'equal))) (oset loc hash (make-hash-table :test 'equal)))
(defmethod ede-locate-file-in-hash ((loc ede-locate-base) (cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base)
filestring) filestring)
"For LOC, is the file FILESTRING in our hashtable?" "For LOC, is the file FILESTRING in our hashtable?"
(gethash filestring (oref loc hash))) (gethash filestring (oref loc hash)))
(defmethod ede-locate-add-file-to-hash ((loc ede-locate-base) (cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
filestring fullfilename) filestring fullfilename)
"For LOC, add FILESTR to the hash with FULLFILENAME." "For LOC, add FILESTR to the hash with FULLFILENAME."
(puthash filestring fullfilename (oref loc hash))) (puthash filestring fullfilename (oref loc hash)))
(defmethod ede-locate-file-in-project ((loc ede-locate-base) (cl-defmethod ede-locate-file-in-project ((loc ede-locate-base)
filesubstring filesubstring
) )
"Locate with LOC occurrences of FILESUBSTRING. "Locate with LOC occurrences of FILESUBSTRING.
@ -149,7 +149,7 @@ that created this EDE locate object."
(oset loc lastanswer ans) (oset loc lastanswer ans)
ans)) ans))
(defmethod ede-locate-file-in-project-impl ((loc ede-locate-base) (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
filesubstring filesubstring
) )
"Locate with LOC occurrences of FILESUBSTRING. "Locate with LOC occurrences of FILESUBSTRING.
@ -158,8 +158,8 @@ that created this EDE locate object."
nil nil
) )
(defmethod ede-locate-create/update-root-database :STATIC (cl-defmethod ede-locate-create/update-root-database
((loc ede-locate-base) root) ((loc (subclass ede-locate-base)) root)
"Create or update the database for the current project. "Create or update the database for the current project.
You cannot create projects for the baseclass." You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S" (error "Cannot create/update a database of type %S"
@ -177,13 +177,13 @@ You cannot create projects for the baseclass."
Configure the Emacs `locate-program' variable to also Configure the Emacs `locate-program' variable to also
configure the use of EDE locate.") configure the use of EDE locate.")
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-locate) (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
root) root)
"Is it ok to use this project type under ROOT." "Is it ok to use this project type under ROOT."
(or (featurep 'locate) (locate-library "locate")) (or (featurep 'locate) (locate-library "locate"))
) )
(defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate) (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
filesubstring) filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT. "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project Searches are done under the current root of the EDE project
@ -220,12 +220,12 @@ that created this EDE locate object."
Configure EDE's use of GNU Global through the cedet-global.el Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.") variable `cedet-global-command'.")
(defmethod initialize-instance ((loc ede-locate-global) (cl-defmethod initialize-instance ((loc ede-locate-global)
&rest slots) &rest slots)
"Make sure that we can use GNU Global." "Make sure that we can use GNU Global."
(require 'cedet-global) (require 'cedet-global)
;; Get ourselves initialized. ;; Get ourselves initialized.
(call-next-method) (cl-call-next-method)
;; Do the checks. ;; Do the checks.
(cedet-gnu-global-version-check) (cedet-gnu-global-version-check)
(let* ((default-directory (oref loc root)) (let* ((default-directory (oref loc root))
@ -235,7 +235,7 @@ variable `cedet-global-command'.")
(oref loc root)))) (oref loc root))))
) )
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-global) (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
root) root)
"Is it ok to use this project type under ROOT." "Is it ok to use this project type under ROOT."
(require 'cedet-global) (require 'cedet-global)
@ -244,7 +244,7 @@ variable `cedet-global-command'.")
(newroot (cedet-gnu-global-root))) (newroot (cedet-gnu-global-root)))
newroot)) newroot))
(defmethod ede-locate-file-in-project-impl ((loc ede-locate-global) (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
filesubstring) filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT. "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project Searches are done under the current root of the EDE project
@ -253,8 +253,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root))) (let ((default-directory (oref loc root)))
(cedet-gnu-global-expand-filename filesubstring))) (cedet-gnu-global-expand-filename filesubstring)))
(defmethod ede-locate-create/update-root-database :STATIC (cl-defmethod ede-locate-create/update-root-database
((loc ede-locate-global) root) ((loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project." "Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root)) (cedet-gnu-global-create/update-database root))
@ -272,11 +272,11 @@ that created this EDE locate object."
Configure EDE's use of IDUtils through the cedet-idutils.el Configure EDE's use of IDUtils through the cedet-idutils.el
file name searching variable `cedet-idutils-file-command'.") file name searching variable `cedet-idutils-file-command'.")
(defmethod initialize-instance ((loc ede-locate-idutils) (cl-defmethod initialize-instance ((loc ede-locate-idutils)
&rest slots) &rest slots)
"Make sure that we can use IDUtils." "Make sure that we can use IDUtils."
;; Get ourselves initialized. ;; Get ourselves initialized.
(call-next-method) (cl-call-next-method)
;; Do the checks. ;; Do the checks.
(require 'cedet-idutils) (require 'cedet-idutils)
(cedet-idutils-version-check) (cedet-idutils-version-check)
@ -285,7 +285,7 @@ file name searching variable `cedet-idutils-file-command'.")
(oref loc root))) (oref loc root)))
) )
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-idutils) (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
root) root)
"Is it ok to use this project type under ROOT." "Is it ok to use this project type under ROOT."
(require 'cedet-idutils) (require 'cedet-idutils)
@ -293,7 +293,7 @@ file name searching variable `cedet-idutils-file-command'.")
(when (cedet-idutils-support-for-directory root) (when (cedet-idutils-support-for-directory root)
root)) root))
(defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils) (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
filesubstring) filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT. "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project Searches are done under the current root of the EDE project
@ -302,8 +302,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root))) (let ((default-directory (oref loc root)))
(cedet-idutils-expand-filename filesubstring))) (cedet-idutils-expand-filename filesubstring)))
(defmethod ede-locate-create/update-root-database :STATIC (cl-defmethod ede-locate-create/update-root-database
((loc ede-locate-idutils) root) ((loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project." "Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root)) (cedet-idutils-create/update-database root))
@ -321,11 +321,11 @@ that created this EDE locate object."
Configure EDE's use of Cscope through the cedet-cscope.el Configure EDE's use of Cscope through the cedet-cscope.el
file name searching variable `cedet-cscope-file-command'.") file name searching variable `cedet-cscope-file-command'.")
(defmethod initialize-instance ((loc ede-locate-cscope) (cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest slots) &rest slots)
"Make sure that we can use Cscope." "Make sure that we can use Cscope."
;; Get ourselves initialized. ;; Get ourselves initialized.
(call-next-method) (cl-call-next-method)
;; Do the checks. ;; Do the checks.
(require 'cedet-cscope) (require 'cedet-cscope)
(cedet-cscope-version-check) (cedet-cscope-version-check)
@ -334,7 +334,7 @@ file name searching variable `cedet-cscope-file-command'.")
(oref loc root))) (oref loc root)))
) )
(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope) (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
root) root)
"Is it ok to use this project type under ROOT." "Is it ok to use this project type under ROOT."
(require 'cedet-cscope) (require 'cedet-cscope)
@ -342,7 +342,7 @@ file name searching variable `cedet-cscope-file-command'.")
(when (cedet-cscope-support-for-directory root) (when (cedet-cscope-support-for-directory root)
root)) root))
(defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope) (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
filesubstring) filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT. "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project Searches are done under the current root of the EDE project
@ -351,8 +351,8 @@ that created this EDE locate object."
(require 'cedet-cscope) (require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring))) (cedet-cscope-expand-filename filesubstring)))
(defmethod ede-locate-create/update-root-database :STATIC (cl-defmethod ede-locate-create/update-root-database
((loc ede-locate-cscope) root) ((loc (subclass ede-locate-cscope)) root)
"Create or update the GNU Global database for the current project." "Create or update the GNU Global database for the current project."
(require 'cedet-cscope) (require 'cedet-cscope)
(cedet-cscope-create/update-database root)) (cedet-cscope-create/update-database root))

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

@ -36,11 +36,11 @@ a file, such as AUTHORS. A value of 'never means don't ask, and
don't do it. A value of nil means to just do it.") don't do it. A value of nil means to just do it.")
;;; Code: ;;; Code:
(defmethod ede-proj-configure-file ((this ede-proj-project)) (cl-defmethod ede-proj-configure-file ((this ede-proj-project))
"The configure.ac script used by project THIS." "The configure.ac script used by project THIS."
(ede-expand-filename (ede-toplevel this) "configure.ac" t)) (ede-expand-filename (ede-toplevel this) "configure.ac" t))
(defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file) (cl-defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
"For project THIS, test that the file FILE exists, or create it." "For project THIS, test that the file FILE exists, or create it."
(let ((f (ede-expand-filename (ede-toplevel this) file t))) (let ((f (ede-expand-filename (ede-toplevel this) file t)))
(when (not (file-exists-p f)) (when (not (file-exists-p f))
@ -60,7 +60,7 @@ don't do it. A value of nil means to just do it.")
(error "Quit"))))))) (error "Quit")))))))
(defmethod ede-proj-configure-synchronize ((this ede-proj-project)) (cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
"Synchronize what we know about project THIS into configure.ac." "Synchronize what we know about project THIS into configure.ac."
(let ((b (find-file-noselect (ede-proj-configure-file this))) (let ((b (find-file-noselect (ede-proj-configure-file this)))
;;(td (file-name-directory (ede-proj-configure-file this))) ;;(td (file-name-directory (ede-proj-configure-file this)))
@ -149,7 +149,7 @@ don't do it. A value of nil means to just do it.")
)))) ))))
(defmethod ede-proj-configure-recreate ((this ede-proj-project)) (cl-defmethod ede-proj-configure-recreate ((this ede-proj-project))
"Delete project THIS's configure script and start over." "Delete project THIS's configure script and start over."
(if (not (ede-proj-configure-file this)) (if (not (ede-proj-configure-file this))
(error "Could not determine configure.ac for %S" (eieio-object-name this))) (error "Could not determine configure.ac for %S" (eieio-object-name this)))
@ -159,7 +159,7 @@ don't do it. A value of nil means to just do it.")
(if b (kill-buffer b))) (if b (kill-buffer b)))
(ede-proj-configure-synchronize this)) (ede-proj-configure-synchronize this))
(defmethod ede-proj-tweak-autoconf ((this ede-proj-target)) (cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
"Tweak the configure file (current buffer) to accommodate THIS." "Tweak the configure file (current buffer) to accommodate THIS."
;; Check the compilers belonging to THIS, and call the autoconf ;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers. ;; setup for those compilers.
@ -167,7 +167,7 @@ don't do it. A value of nil means to just do it.")
(mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this)) (mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this))
) )
(defmethod ede-proj-flush-autoconf ((this ede-proj-target)) (cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target))
"Flush the configure file (current buffer) to accommodate THIS. "Flush the configure file (current buffer) to accommodate THIS.
By flushing, remove any cruft that may be in the file. Subsequent By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush." calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
@ -175,13 +175,13 @@ calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
;; @TODO - No-one calls this ??? ;; @TODO - No-one calls this ???
(defmethod ede-proj-configure-add-missing ((this ede-proj-target)) (cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target))
"Query if any files needed by THIS provided by automake are missing. "Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake." Results in --add-missing being passed to automake."
nil) nil)
;; @TODO - No-one implements this yet. ;; @TODO - No-one implements this yet.
(defmethod ede-proj-configure-create-missing ((this ede-proj-target)) (cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target))
"Add any missing files for THIS by creating them." "Add any missing files for THIS by creating them."
nil) nil)

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

@ -52,7 +52,7 @@
(declare-function ede-srecode-insert "ede/srecode") (declare-function ede-srecode-insert "ede/srecode")
;;; Code: ;;; Code:
(defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename) (cl-defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS. "Create a Makefile for all Makefile targets in THIS.
MFILENAME is the makefile to generate." MFILENAME is the makefile to generate."
(require 'ede/srecode) (require 'ede/srecode)
@ -284,26 +284,26 @@ Change . to _ in the variable name."
(setq name (replace-match "_" nil t name))) (setq name (replace-match "_" nil t name)))
name)) name))
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG")) (concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG"))
;;; DEPENDENCY FILE GENERATOR LISTS ;;; DEPENDENCY FILE GENERATOR LISTS
;; ;;
(defmethod ede-proj-makefile-dependency-files ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
"Return a list of source files to convert to dependencies. "Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from." Argument THIS is the target to get sources from."
nil) nil)
;;; GENERIC VARIABLES ;;; GENERIC VARIABLES
;; ;;
(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project) (cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
configuration) configuration)
"Return a list of configuration variables from THIS. "Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query." Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables)))) (cdr (assoc configuration (oref this configuration-variables))))
(defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
"Insert variables needed by target THIS. "Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of NOTE: Not yet in use! This is part of an SRecode conversion of
@ -358,7 +358,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
; )) ; ))
) )
(defmethod ede-proj-makefile-insert-variables ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
"Insert variables needed by target THIS." "Insert variables needed by target THIS."
(let ((conf-table (ede-proj-makefile-configuration-variables (let ((conf-table (ede-proj-makefile-configuration-variables
this (oref this configuration-default))) this (oref this configuration-default)))
@ -392,7 +392,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
(insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " " (insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " "
(file-name-nondirectory (ede-proj-dist-makefile this)) "\n")) (file-name-nondirectory (ede-proj-dist-makefile this)) "\n"))
(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target) (cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
&optional &optional
moresource) moresource)
"Insert the source variables needed by THIS. "Insert the source variables needed by THIS.
@ -406,7 +406,7 @@ sources variable."
(if moresource (if moresource
(insert " \\\n " (mapconcat (lambda (a) a) moresource " ") ""))))) (insert " \\\n " (mapconcat (lambda (a) a) moresource " ") "")))))
(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
moresource) moresource)
"Insert variables needed by target THIS. "Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the Optional argument MORESOURCE is a list of additional sources to add to the
@ -414,18 +414,18 @@ sources variable."
(ede-proj-makefile-insert-source-variables this moresource) (ede-proj-makefile-insert-source-variables this moresource)
) )
(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile) (cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
configuration) configuration)
"Return a list of configuration variables from THIS. "Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query." Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables)))) (cdr (assoc configuration (oref this configuration-variables))))
(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
&optional moresource) &optional moresource)
"Insert variables needed by target THIS. "Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the Optional argument MORESOURCE is a list of additional sources to add to the
sources variable." sources variable."
(call-next-method) (cl-call-next-method)
(let* ((proj (ede-target-parent this)) (let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables (conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default))) this (oref proj configuration-default)))
@ -449,19 +449,19 @@ sources variable."
(ede-linker-only-once linker (ede-linker-only-once linker
(ede-proj-makefile-insert-variables linker))))) (ede-proj-makefile-insert-variables linker)))))
(defmethod ede-proj-makefile-insert-automake-pre-variables (cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target)) ((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES." "Insert variables needed by target THIS in Makefile.am before SOURCES."
nil) nil)
(defmethod ede-proj-makefile-insert-automake-post-variables (cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target)) ((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES." "Insert variables needed by target THIS in Makefile.am after SOURCES."
nil) nil)
;;; GARBAGE PATTERNS ;;; GARBAGE PATTERNS
;; ;;
(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
"Return a list of patterns that are considered garbage to THIS. "Return a list of patterns that are considered garbage to THIS.
These are removed with make clean." These are removed with make clean."
(let ((mc (ede-map-targets (let ((mc (ede-map-targets
@ -476,7 +476,7 @@ These are removed with make clean."
(setq mc (cdr mc))) (setq mc (cdr mc)))
(nreverse uniq))) (nreverse uniq)))
(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
"Return a list of patterns that are considered garbage to THIS. "Return a list of patterns that are considered garbage to THIS.
These are removed with make clean." These are removed with make clean."
;; Get the source object from THIS, and use the specified garbage. ;; Get the source object from THIS, and use the specified garbage.
@ -490,7 +490,7 @@ These are removed with make clean."
;;; RULES ;;; RULES
;; ;;
(defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
"Insert a rule for the project THIS which should be a subproject." "Insert a rule for the project THIS which should be a subproject."
(insert ".PHONY:" (ede-name this)) (insert ".PHONY:" (ede-name this))
(newline) (newline)
@ -501,29 +501,29 @@ These are removed with make clean."
(newline) (newline)
) )
(defmethod ede-proj-makefile-insert-rules ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
"Insert rules needed by THIS target." "Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this inference-rules)) (mapc 'ede-proj-makefile-insert-rules (oref this inference-rules))
) )
(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Argument THIS is the project that should insert stuff." Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets)) (mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
) )
(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff." Argument THIS is the target that should insert stuff."
nil) nil)
(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff." Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-dist-dependencies this) (ede-proj-makefile-insert-dist-dependencies this)
) )
(defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
"Insert a SUBDIRS variable for Automake." "Insert a SUBDIRS variable for Automake."
(proj-comp-insert-variable-once "SUBDIRS" (proj-comp-insert-variable-once "SUBDIRS"
(ede-map-subprojects (ede-map-subprojects
@ -531,11 +531,11 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj)) (insert " " (ede-subproject-relative-path sproj))
)))) ))))
(defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE." "Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede"))) (proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
(defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
"Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST." "Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST."
(let ((junk (ede-proj-makefile-garbage-patterns this)) (let ((junk (ede-proj-makefile-garbage-patterns this))
tmp) tmp)
@ -602,11 +602,11 @@ Argument THIS is the target that should insert stuff."
"\t@false\n\n" "\t@false\n\n"
"\n\n# End of Makefile\n"))) "\n\n# End of Makefile\n")))
(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
"Insert rules needed by THIS target." "Insert rules needed by THIS target."
nil) nil)
(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
"Insert rules needed by THIS target." "Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules)) (mapc 'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers this))) (let ((c (ede-proj-compilers this)))
@ -619,7 +619,7 @@ Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-commands this) (ede-proj-makefile-insert-commands this)
))) )))
(defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile)) (cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
"Insert the commands needed by target THIS. "Insert the commands needed by target THIS.
For targets, insert the commands needed by the chosen compiler." For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this)) (mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this))
@ -627,18 +627,18 @@ For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this)))) (mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project)) (cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
"Insert user specified rules needed by THIS target. "Insert user specified rules needed by THIS target.
This is different from `ede-proj-makefile-insert-rules' in that this This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with function won't create the building rules which are auto created with
automake." automake."
(mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules))) (mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
"Insert user specified rules needed by THIS target." "Insert user specified rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules))) (mapc 'ede-proj-makefile-insert-rules (oref this rules)))
(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile)) (cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
"Return a string representing the dependencies for THIS. "Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care. have a list of intermediates (object files), and others don't care.
@ -667,7 +667,7 @@ This allows customization of how these elements appear."
out)))) out))))
;; Tags ;; Tags
(defmethod ede-proj-makefile-tags ((this ede-proj-project) targets) (cl-defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
"Insert into the current location rules to make recursive TAGS files. "Insert into the current location rules to make recursive TAGS files.
Argument THIS is the project to create tags for. Argument THIS is the project to create tags for.
Argument TARGETS are the targets we should depend on for TAGS." Argument TARGETS are the targets we should depend on for TAGS."

6
lisp/cedet/ede/proj-archive.el
View file

@ -43,7 +43,7 @@
:objectextention "") :objectextention "")
"Linker object for creating an archive.") "Linker object for creating an archive.")
(defmethod ede-proj-makefile-insert-source-variables :BEFORE (cl-defmethod ede-proj-makefile-insert-source-variables :before
((this ede-proj-target-makefile-archive) &optional moresource) ((this ede-proj-target-makefile-archive) &optional moresource)
"Insert bin_PROGRAMS variables needed by target THIS. "Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the We aren't actually inserting SOURCE details, but this is used by the
@ -52,11 +52,11 @@ Makefile.am generator, so use it to add this important bin program."
(concat "lib" (ede-name this) "_a_LIBRARIES") (concat "lib" (ede-name this) "_a_LIBRARIES")
(insert (concat "lib" (ede-name this) ".a")))) (insert (concat "lib" (ede-name this) ".a"))))
(defmethod ede-proj-makefile-garbage-patterns (cl-defmethod ede-proj-makefile-garbage-patterns
((this ede-proj-target-makefile-archive)) ((this ede-proj-target-makefile-archive))
"Add archive name to the garbage patterns. "Add archive name to the garbage patterns.
This makes sure that the archive is removed with 'make clean'." This makes sure that the archive is removed with 'make clean'."
(let ((garb (call-next-method))) (let ((garb (cl-call-next-method)))
(append garb (list (concat "lib" (ede-name this) ".a"))))) (append garb (list (concat "lib" (ede-name this) ".a")))))
(provide 'ede/proj-archive) (provide 'ede/proj-archive)

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

@ -39,7 +39,7 @@
:sourcepattern "^[A-Z]+$\\|\\.txt$") :sourcepattern "^[A-Z]+$\\|\\.txt$")
"Miscellaneous fields definition.") "Miscellaneous fields definition.")
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_AUX")) (concat (ede-pmake-varname this) "_AUX"))

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

@ -173,12 +173,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and This is used when creating a Makefile to prevent duplicate variables and
rules from being created.") rules from being created.")
(defmethod initialize-instance :AFTER ((this ede-compiler) &rest fields) (cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
"Make sure that all ede compiler objects are cached in "Make sure that all ede compiler objects are cached in
`ede-compiler-list'." `ede-compiler-list'."
(add-to-list 'ede-compiler-list this)) (add-to-list 'ede-compiler-list this))
(defmethod initialize-instance :AFTER ((this ede-linker) &rest fields) (cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
"Make sure that all ede compiler objects are cached in "Make sure that all ede compiler objects are cached in
`ede-linker-list'." `ede-linker-list'."
(add-to-list 'ede-linker-list this)) (add-to-list 'ede-linker-list this))
@ -235,7 +235,7 @@ This will prevent rules from creating duplicate variables or rules."
(car-safe linkers)) (car-safe linkers))
;;; Methods: ;;; Methods:
(defmethod ede-proj-tweak-autoconf ((this ede-compilation-program)) (cl-defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
"Tweak the configure file (current buffer) to accommodate THIS." "Tweak the configure file (current buffer) to accommodate THIS."
(mapcar (mapcar
(lambda (obj) (lambda (obj)
@ -247,7 +247,7 @@ This will prevent rules from creating duplicate variables or rules."
) )
(oref this autoconf))) (oref this autoconf)))
(defmethod ede-proj-flush-autoconf ((this ede-compilation-program)) (cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS." "Flush the configure file (current buffer) to accommodate THIS."
nil) nil)
@ -263,7 +263,7 @@ Execute BODY in a location where a value can be placed."
)) ))
(put 'proj-comp-insert-variable-once 'lisp-indent-function 1) (put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
(defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program)) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS." "Insert variables needed by the compiler THIS."
(if (eieio-instance-inheritor-slot-boundp this 'variables) (if (eieio-instance-inheritor-slot-boundp this 'variables)
(with-slots (variables) this (with-slots (variables) this
@ -276,19 +276,19 @@ Execute BODY in a location where a value can be placed."
(insert cd))))) (insert cd)))))
variables)))) variables))))
(defmethod ede-compiler-intermediate-objects-p ((this ede-compiler)) (cl-defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
"Return non-nil if THIS has intermediate object files. "Return non-nil if THIS has intermediate object files.
If this compiler creates code that can be linked together, If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate." then the object files created by the compiler are considered intermediate."
(oref this uselinker)) (oref this uselinker))
(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler) (cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname) targetname)
"Return a string based on THIS representing a make object variable. "Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to." TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ")) (concat targetname "_OBJ"))
(defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler) (cl-defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
targetname sourcefiles) targetname sourcefiles)
"Insert an OBJ variable to specify object code to be generated for THIS. "Insert an OBJ variable to specify object code to be generated for THIS.
The name of the target is TARGETNAME as a string. SOURCEFILES is the list of The name of the target is TARGETNAME as a string. SOURCEFILES is the list of
@ -312,19 +312,19 @@ Not all compilers do this."
sourcefiles) sourcefiles)
(insert "\n"))))) (insert "\n")))))
(defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
"Insert rules needed for THIS compiler object." "Insert rules needed for THIS compiler object."
(ede-compiler-only-once this (ede-compiler-only-once this
(mapc 'ede-proj-makefile-insert-rules (oref this rules)))) (mapc 'ede-proj-makefile-insert-rules (oref this rules))))
(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object." "Insert rules needed for THIS rule object."
(if (oref this phony) (insert ".PHONY: " (oref this target) "\n")) (if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t" (insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t") (mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\n\n")) "\n\n"))
(defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program)) (cl-defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
"Insert the commands needed to use compiler THIS. "Insert the commands needed to use compiler THIS.
The object creating makefile rules must call this method for the The object creating makefile rules must call this method for the
compiler it decides to use after inserting in the rule." compiler it decides to use after inserting in the rule."

50
lisp/cedet/ede/proj-elisp.el
View file

@ -57,7 +57,7 @@ Each package's directory should also appear in :aux-packages via a package name.
"This target consists of a group of lisp files. "This target consists of a group of lisp files.
A lisp target may be one general program with many separate lisp files in it.") A lisp target may be one general program with many separate lisp files in it.")
(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
"Insert rules needed by THIS target. "Insert rules needed by THIS target.
This inserts the PRELOADS target-local variable." This inserts the PRELOADS target-local variable."
(let ((preloads (oref this pre-load-packages))) (let ((preloads (oref this pre-load-packages)))
@ -67,7 +67,7 @@ This inserts the PRELOADS target-local variable."
(mapconcat 'identity preloads " "))))) (mapconcat 'identity preloads " ")))))
(insert "\n")) (insert "\n"))
(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
"Return a string representing the dependencies for THIS. "Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care. have a list of intermediates (object files), and others don't care.
@ -109,7 +109,7 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs with XEmacs.") "Compile Emacs Lisp programs with XEmacs.")
;;; Claiming files ;;; Claiming files
(defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer) (cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER. "Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target." Lays claim to all .elc files that match .el files in this target."
(if (string-match "\\.elc$" (buffer-file-name buffer)) (if (string-match "\\.elc$" (buffer-file-name buffer))
@ -121,7 +121,7 @@ Lays claim to all .elc files that match .el files in this target."
;; Is this in our list. ;; Is this in our list.
(member fname (oref this auxsource)) (member fname (oref this auxsource))
) )
(call-next-method) ; The usual thing. (cl-call-next-method) ; The usual thing.
)) ))
;;; Emacs Lisp Compiler ;;; Emacs Lisp Compiler
@ -145,7 +145,7 @@ Lays claim to all .elc files that match .el files in this target."
packages (cdr packages)))) packages (cdr packages))))
paths)) paths))
(defmethod project-compile-target ((obj ede-proj-target-elisp)) (cl-defmethod project-compile-target ((obj ede-proj-target-elisp))
"Compile all sources in a Lisp target OBJ. "Compile all sources in a Lisp target OBJ.
Bonus: Return a cons cell: (COMPILED . UPTODATE)." Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((proj (ede-target-parent obj)) (let* ((proj (ede-target-parent obj))
@ -173,7 +173,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj)) (message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
(cons comp utd))) (cons comp utd)))
(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version) (cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
"In a Lisp file, updated a version string for THIS to VERSION. "In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header." is found, such as a `-version' variable, or the standard header."
@ -195,12 +195,12 @@ is found, such as a `-version' variable, or the standard header."
(insert version))))) (insert version)))))
(setq vs (cdr vs))) (setq vs (cdr vs)))
;; The next method will include comments such as "Version:" ;; The next method will include comments such as "Version:"
(call-next-method)))) (cl-call-next-method))))
;;; Makefile generation functions ;;; Makefile generation functions
;; ;;
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p) '("lisp_LISP" . share)) (cond ((ede-proj-automake-p) '("lisp_LISP" . share))
(t (concat (ede-pmake-varname this) "_LISP")))) (t (concat (ede-pmake-varname this) "_LISP"))))
@ -219,7 +219,7 @@ is found, such as a `-version' variable, or the standard header."
(setq items (cdr items))))) (setq items (cdr items)))))
)) ))
(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp))
"Insert variables needed by target THIS." "Insert variables needed by target THIS."
(let ((newitems (if (oref this aux-packages) (let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath (ede-proj-elisp-packages-to-loadpath
@ -244,9 +244,9 @@ is found, such as a `-version' variable, or the standard header."
) )
(error "Don't know how to update load path")))) (error "Don't know how to update load path"))))
(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
"Tweak the configure file (current buffer) to accommodate THIS." "Tweak the configure file (current buffer) to accommodate THIS."
(call-next-method) (cl-call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program. ;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
(enable-local-variables nil)) (enable-local-variables nil))
@ -270,7 +270,7 @@ is found, such as a `-version' variable, or the standard header."
(save-buffer) (save-buffer)
(kill-buffer))))) (kill-buffer)))))
(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp)) (cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
"Flush the configure file (current buffer) to accommodate THIS." "Flush the configure file (current buffer) to accommodate THIS."
;; Remove crufty old paths from elisp-compile ;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile)) (let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
@ -311,14 +311,14 @@ Files do not need to be added to this target.")
;;; Claiming files ;;; Claiming files
(defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer) (cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
"Return t if object THIS lays claim to the file in BUFFER. "Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target." Lays claim to all .elc files that match .el files in this target."
(if (string-match (if (string-match
(concat (regexp-quote (oref this autoload-file)) "$") (concat (regexp-quote (oref this autoload-file)) "$")
(buffer-file-name buffer)) (buffer-file-name buffer))
t t
(call-next-method) ; The usual thing. (cl-call-next-method) ; The usual thing.
)) ))
;; Compilers ;; Compilers
@ -338,7 +338,7 @@ Lays claim to all .elc files that match .el files in this target."
) )
"Build an autoloads file.") "Build an autoloads file.")
(defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
"List of compilers being used by OBJ. "List of compilers being used by OBJ.
If the `compiler' slot is empty, get the car of the compilers list." If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler))) (let ((comp (oref obj compiler)))
@ -351,7 +351,7 @@ If the `compiler' slot is empty, get the car of the compilers list."
(setq comp (list (car avail))))) (setq comp (list (car avail)))))
comp)) comp))
(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads) (cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
&optional &optional
moresource) moresource)
"Insert the source variables needed by THIS. "Insert the source variables needed by THIS.
@ -359,16 +359,16 @@ Optional argument MORESOURCE is a list of additional sources to add to the
sources variable." sources variable."
nil) nil)
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
nil) ; "LOADDEFS") nil) ; "LOADDEFS")
(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
"Return a string representing the dependencies for THIS. "Return a string representing the dependencies for THIS.
Always return an empty string for an autoloads generator." Always return an empty string for an autoloads generator."
"") "")
(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp-autoloads))
"Insert variables needed by target THIS." "Insert variables needed by target THIS."
(ede-pmake-insert-variable-shared "LOADDEFS" (ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file))) (insert (oref this autoload-file)))
@ -378,7 +378,7 @@ Always return an empty string for an autoloads generator."
" "))) " ")))
) )
(defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads)) (cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
"Create or update the autoload target." "Create or update the autoload target."
(require 'cedet-autogen) (require 'cedet-autogen)
(let ((default-directory (ede-expand-filename obj "."))) (let ((default-directory (ede-expand-filename obj ".")))
@ -387,13 +387,13 @@ Always return an empty string for an autoloads generator."
(oref obj autoload-dirs)) (oref obj autoload-dirs))
)) ))
(defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version) (cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
"In a Lisp file, updated a version string for THIS to VERSION. "In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header." is found, such as a `-version' variable, or the standard header."
nil) nil)
(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Emacs Lisp autoload files ship the generated .el files. Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file." Argument THIS is the target which needs to insert an info file."
@ -402,18 +402,18 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this)) (insert " " (ede-proj-makefile-target-name this))
) )
(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should distribute. "Insert any symbols that the DIST rule should distribute.
Emacs Lisp autoload files ship the generated .el files. Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file." Argument THIS is the target which needs to insert an info file."
(insert " " (oref this autoload-file)) (insert " " (oref this autoload-file))
) )
(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
"Tweak the configure file (current buffer) to accommodate THIS." "Tweak the configure file (current buffer) to accommodate THIS."
(error "Autoloads not supported in autoconf yet")) (error "Autoloads not supported in autoconf yet"))
(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads)) (cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
"Flush the configure file (current buffer) to accommodate THIS." "Flush the configure file (current buffer) to accommodate THIS."
nil) nil)

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

@ -72,17 +72,17 @@ All other sources should be included independently."))
;;; Makefile generation ;;; Makefile generation
;; ;;
(defmethod ede-proj-configure-add-missing (cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-info)) ((this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing. "Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake." Results in --add-missing being passed to automake."
(not (ede-expand-filename (ede-toplevel) "texinfo.tex"))) (not (ede-expand-filename (ede-toplevel) "texinfo.tex")))
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_TEXINFOS")) (concat (ede-pmake-varname this) "_TEXINFOS"))
(defmethod ede-proj-makefile-insert-source-variables (cl-defmethod ede-proj-makefile-insert-source-variables
((this ede-proj-target-makefile-info) &optional moresource) ((this ede-proj-target-makefile-info) &optional moresource)
"Insert the source variables needed by THIS info target. "Insert the source variables needed by THIS info target.
Optional argument MORESOURCE is a list of additional sources to add to the Optional argument MORESOURCE is a list of additional sources to add to the
@ -90,7 +90,7 @@ sources variable.
Does the usual for Makefile mode, but splits source into two variables Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode." when working in Automake mode."
(if (not (ede-proj-automake-p)) (if (not (ede-proj-automake-p))
(call-next-method) (cl-call-next-method)
(let* ((sv (ede-proj-makefile-sourcevar this)) (let* ((sv (ede-proj-makefile-sourcevar this))
(src (copy-sequence (oref this source))) (src (copy-sequence (oref this source)))
(menu (or (oref this menu) (car src)))) (menu (or (oref this menu) (car src))))
@ -119,7 +119,7 @@ when working in Automake mode."
(kill-buffer buffer)) (kill-buffer buffer))
info)) info))
(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info)) (cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
"Return the name of the main target for THIS target." "Return the name of the main target for THIS target."
;; The target should be the main-menu file name translated to .info. ;; The target should be the main-menu file name translated to .info.
(let* ((source (if (not (string= (oref this mainmenu) "")) (let* ((source (if (not (string= (oref this mainmenu) ""))
@ -128,7 +128,7 @@ when working in Automake mode."
(info (ede-makeinfo-find-info-filename source))) (info (ede-makeinfo-find-info-filename source)))
(concat (or info (file-name-sans-extension source)) ".info"))) (concat (or info (file-name-sans-extension source)) ".info")))
(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info)) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files. Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file." Argument THIS is the target which needs to insert an info file."
@ -137,7 +137,7 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this)) (insert " " (ede-proj-makefile-target-name this))
) )
(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info)) (cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on. "Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files. Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file." Argument THIS is the target which needs to insert an info file."
@ -151,7 +151,7 @@ Argument THIS is the target which needs to insert an info file."
; n ; n
; (concat n ".info")))) ; (concat n ".info"))))
(defmethod object-write ((this ede-proj-target-makefile-info)) (cl-defmethod object-write ((this ede-proj-target-makefile-info))
"Before committing any change to THIS, make sure the mainmenu is first." "Before committing any change to THIS, make sure the mainmenu is first."
(let ((mm (oref this mainmenu)) (let ((mm (oref this mainmenu))
(s (oref this source)) (s (oref this source))
@ -161,9 +161,9 @@ Argument THIS is the target which needs to insert an info file."
;; Make sure that MM is first in the list of items. ;; Make sure that MM is first in the list of items.
(setq nl (cons mm (delq mm s))) (setq nl (cons mm (delq mm s)))
(oset this source nl))) (oset this source nl)))
(call-next-method)) (cl-call-next-method))
(defmethod ede-documentation ((this ede-proj-target-makefile-info)) (cl-defmethod ede-documentation ((this ede-proj-target-makefile-info))
"Return a list of files that provides documentation. "Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other Documentation is not for object THIS, but is provided by THIS for other
files in the project." files in the project."

6
lisp/cedet/ede/proj-misc.el
View file

@ -65,11 +65,11 @@ All listed sources are included in the distribution.")
) )
"Compile code via a sub-makefile.") "Compile code via a sub-makefile.")
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_MISC")) (concat (ede-pmake-varname this) "_MISC"))
(defmethod ede-proj-makefile-dependency-files (cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-miscelaneous)) ((this ede-proj-target-makefile-miscelaneous))
"Return a list of files which THIS target depends on." "Return a list of files which THIS target depends on."
(with-slots (submakefile) this (with-slots (submakefile) this
@ -79,7 +79,7 @@ All listed sources are included in the distribution.")
nil) nil)
(t (list submakefile))))) (t (list submakefile)))))
(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous)) (cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
"Create the make rule needed to create an archive for THIS." "Create the make rule needed to create an archive for THIS."
;; DO NOT call the next method. We will never have any compilers, ;; DO NOT call the next method. We will never have any compilers,
;; or any dependencies, or stuff like this. This rule will let us ;; or any dependencies, or stuff like this. This rule will let us

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

@ -275,9 +275,9 @@ No garbage pattern since it creates C or C++ code.")
;;; The EDE object compiler ;;; The EDE object compiler
;; ;;
(defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler)) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
"Insert variables needed by the compiler THIS." "Insert variables needed by the compiler THIS."
(call-next-method) (cl-call-next-method)
(if (eieio-instance-inheritor-slot-boundp this 'dependencyvar) (if (eieio-instance-inheritor-slot-boundp this 'dependencyvar)
(with-slots (dependencyvar) this (with-slots (dependencyvar) this
(insert (car dependencyvar) "=") (insert (car dependencyvar) "=")
@ -289,30 +289,30 @@ No garbage pattern since it creates C or C++ code.")
;;; EDE Object target type methods ;;; EDE Object target type methods
;; ;;
(defmethod ede-proj-makefile-sourcevar (cl-defmethod ede-proj-makefile-sourcevar
((this ede-proj-target-makefile-objectcode)) ((this ede-proj-target-makefile-objectcode))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(require 'ede/pmake) (require 'ede/pmake)
(concat (ede-pmake-varname this) "_SOURCES")) (concat (ede-pmake-varname this) "_SOURCES"))
(defmethod ede-proj-makefile-dependency-files (cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-objectcode)) ((this ede-proj-target-makefile-objectcode))
"Return a list of source files to convert to dependencies. "Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from." Argument THIS is the target to get sources from."
(append (oref this source) (oref this auxsource))) (append (oref this source) (oref this auxsource)))
(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
&optional moresource) &optional moresource)
"Insert variables needed by target THIS. "Insert variables needed by target THIS.
Optional argument MORESOURCE is not used." Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies (let ((ede-proj-objectcode-dodependencies
(oref (ede-target-parent this) automatic-dependencies))) (oref (ede-target-parent this) automatic-dependencies)))
(call-next-method))) (cl-call-next-method)))
(defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode) (cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
buffer) buffer)
"There are no default header files." "There are no default header files."
(or (call-next-method) (or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves. ;; Ok, nothing obvious. Try looking in ourselves.
(let ((h (oref this auxsource))) (let ((h (oref this auxsource)))
;; Add more logic here when the problem is better understood. ;; Add more logic here when the problem is better understood.

16
lisp/cedet/ede/proj-prog.el
View file

@ -69,14 +69,14 @@ Note: Currently only used for Automake projects."
) )
"This target is an executable program.") "This target is an executable program.")
(defmethod ede-proj-makefile-insert-automake-pre-variables (cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-program)) ((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS." "Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared "bin_PROGRAMS" (ede-pmake-insert-variable-shared "bin_PROGRAMS"
(insert (ede-name this))) (insert (ede-name this)))
(call-next-method)) (cl-call-next-method))
(defmethod ede-proj-makefile-insert-automake-post-variables (cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-program)) ((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS." "Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared (ede-pmake-insert-variable-shared
@ -86,11 +86,11 @@ Note: Currently only used for Automake projects."
(when (oref this ldlibs) (when (oref this ldlibs)
(mapc (lambda (d) (insert " -l" d)) (oref this ldlibs))) (mapc (lambda (d) (insert " -l" d)) (oref this ldlibs)))
) )
(call-next-method)) (cl-call-next-method))
(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program)) (cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
"Insert variables needed by the compiler THIS." "Insert variables needed by the compiler THIS."
(call-next-method) (cl-call-next-method)
(let ((lf (mapconcat 'identity (oref this ldflags) " "))) (let ((lf (mapconcat 'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this (with-slots (ldlibs) this
(if ldlibs (if ldlibs
@ -100,7 +100,7 @@ Note: Currently only used for Automake projects."
(when (and lf (not (string= "" lf))) (when (and lf (not (string= "" lf)))
(ede-pmake-insert-variable-once "LDDEPS" (insert lf))))) (ede-pmake-insert-variable-once "LDDEPS" (insert lf)))))
(defmethod project-debug-target ((obj ede-proj-target-makefile-program)) (cl-defmethod project-debug-target ((obj ede-proj-target-makefile-program))
"Debug a program target OBJ." "Debug a program target OBJ."
(let ((tb (get-buffer-create " *padt*")) (let ((tb (get-buffer-create " *padt*"))
(dd (if (not (string= (oref obj path) "")) (dd (if (not (string= (oref obj path) ""))
@ -118,7 +118,7 @@ Note: Currently only used for Automake projects."
(funcall ede-debug-program-function cmd)) (funcall ede-debug-program-function cmd))
(kill-buffer tb)))) (kill-buffer tb))))
(defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command) (cl-defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
"Run a program target OBJ. "Run a program target OBJ.
Optional COMMAND is the command to run in place of asking the user." Optional COMMAND is the command to run in place of asking the user."
(require 'ede/shell) (require 'ede/shell)

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

@ -40,7 +40,7 @@
) )
"This target consists of scheme files.") "This target consists of scheme files.")
(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme)) (cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS." "Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE")) (autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))

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

@ -171,14 +171,14 @@ Use ldlibs to add addition libraries.")
"\t@-rm -f .deps/$(*F).p\n\n")) "\t@-rm -f .deps/$(*F).p\n\n"))
) )
(defmethod ede-proj-configure-add-missing (cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-shared-object)) ((this ede-proj-target-makefile-shared-object))
"Query if any files needed by THIS provided by automake are missing. "Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake." Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig") (not (and (ede-expand-filename (ede-toplevel) "ltconfig")
(ede-expand-filename (ede-toplevel) "ltmain.sh")))) (ede-expand-filename (ede-toplevel) "ltmain.sh"))))
(defmethod ede-proj-makefile-insert-automake-pre-variables (cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-shared-object)) ((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS. "Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the We aren't actually inserting SOURCE details, but this is used by the
@ -186,23 +186,23 @@ Makefile.am generator, so use it to add this important bin program."
(ede-pmake-insert-variable-shared "lib_LTLIBRARIES" (ede-pmake-insert-variable-shared "lib_LTLIBRARIES"
(insert (concat "lib" (ede-name this) ".la")))) (insert (concat "lib" (ede-name this) ".la"))))
(defmethod ede-proj-makefile-insert-automake-post-variables (cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-shared-object)) ((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS. "Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element." We need to override -program which has an LDADD element."
nil) nil)
(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object)) (cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
"Return the name of the main target for THIS target." "Return the name of the main target for THIS target."
;; We need some platform gunk to make the .so change to .sl, or .a, ;; We need some platform gunk to make the .so change to .sl, or .a,
;; depending on the platform we are going to compile against. ;; depending on the platform we are going to compile against.
(concat "lib" (ede-name this) ".la")) (concat "lib" (ede-name this) ".la"))
(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object)) (cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am) (if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am)
(concat "lib" (oref this name) "_la_SOURCES") (concat "lib" (oref this name) "_la_SOURCES")
(call-next-method))) (cl-call-next-method)))
(provide 'ede/proj-shared) (provide 'ede/proj-shared)

60
lisp/cedet/ede/proj.el
View file

@ -329,27 +329,27 @@ the PROJECT being read in is the root project."
;; Restore the directory slot ;; Restore the directory slot
(oset project directory cdir))) )) (oset project directory cdir))) ))
(defmethod ede-commit-local-variables ((proj ede-proj-project)) (cl-defmethod ede-commit-local-variables ((proj ede-proj-project))
"Commit change to local variables in PROJ." "Commit change to local variables in PROJ."
(ede-proj-save proj)) (ede-proj-save proj))
(defmethod eieio-done-customizing ((proj ede-proj-project)) (cl-defmethod eieio-done-customizing ((proj ede-proj-project))
"Call this when a user finishes customizing this object. "Call this when a user finishes customizing this object.
Argument PROJ is the project to save." Argument PROJ is the project to save."
(call-next-method) (cl-call-next-method)
(ede-proj-save proj)) (ede-proj-save proj))
(defmethod eieio-done-customizing ((target ede-proj-target)) (cl-defmethod eieio-done-customizing ((target ede-proj-target))
"Call this when a user finishes customizing this object. "Call this when a user finishes customizing this object.
Argument TARGET is the project we are completing customization on." Argument TARGET is the project we are completing customization on."
(call-next-method) (cl-call-next-method)
(ede-proj-save (ede-current-project))) (ede-proj-save (ede-current-project)))
(defmethod ede-commit-project ((proj ede-proj-project)) (cl-defmethod ede-commit-project ((proj ede-proj-project))
"Commit any change to PROJ to its file." "Commit any change to PROJ to its file."
(ede-proj-save proj)) (ede-proj-save proj))
(defmethod ede-buffer-mine ((this ede-proj-project) buffer) (cl-defmethod ede-buffer-mine ((this ede-proj-project) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(let ((f (ede-convert-path this (buffer-file-name buffer)))) (let ((f (ede-convert-path this (buffer-file-name buffer))))
(or (string= (file-name-nondirectory (oref this file)) f) (or (string= (file-name-nondirectory (oref this file)) f)
@ -360,9 +360,9 @@ Argument TARGET is the project we are completing customization on."
(member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README")) (member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README"))
))) )))
(defmethod ede-buffer-mine ((this ede-proj-target) buffer) (cl-defmethod ede-buffer-mine ((this ede-proj-target) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(or (call-next-method) (or (cl-call-next-method)
(ede-target-buffer-in-sourcelist this buffer (oref this auxsource)))) (ede-target-buffer-in-sourcelist this buffer (oref this auxsource))))
@ -371,7 +371,7 @@ Argument TARGET is the project we are completing customization on."
(defvar ede-proj-target-history nil (defvar ede-proj-target-history nil
"History when querying for a target type.") "History when querying for a target type.")
(defmethod project-new-target ((this ede-proj-project) (cl-defmethod project-new-target ((this ede-proj-project)
&optional name type autoadd) &optional name type autoadd)
"Create a new target in THIS based on the current buffer." "Create a new target in THIS based on the current buffer."
(let* ((name (or name (read-string "Name: " ""))) (let* ((name (or name (read-string "Name: " "")))
@ -409,7 +409,7 @@ Argument TARGET is the project we are completing customization on."
;; And save ;; And save
(ede-proj-save this))) (ede-proj-save this)))
(defmethod project-new-target-custom ((this ede-proj-project)) (cl-defmethod project-new-target-custom ((this ede-proj-project))
"Create a new target in THIS for custom." "Create a new target in THIS for custom."
(let* ((name (read-string "Name: " "")) (let* ((name (read-string "Name: " ""))
(type (completing-read "Type: " ede-proj-target-alist (type (completing-read "Type: " ede-proj-target-alist
@ -418,7 +418,7 @@ Argument TARGET is the project we are completing customization on."
:path (ede-convert-path this default-directory) :path (ede-convert-path this default-directory)
:source nil))) :source nil)))
(defmethod project-delete-target ((this ede-proj-target)) (cl-defmethod project-delete-target ((this ede-proj-target))
"Delete the current target THIS from its parent project." "Delete the current target THIS from its parent project."
(let ((p (ede-current-project)) (let ((p (ede-current-project))
(ts (oref this source))) (ts (oref this source)))
@ -439,7 +439,7 @@ Argument TARGET is the project we are completing customization on."
(oset p targets (delq this (oref p targets))) (oset p targets (delq this (oref p targets)))
(ede-proj-save (ede-current-project)))) (ede-proj-save (ede-current-project))))
(defmethod project-add-file ((this ede-proj-target) file) (cl-defmethod project-add-file ((this ede-proj-target) file)
"Add to target THIS the current buffer represented as FILE." "Add to target THIS the current buffer represented as FILE."
(let ((file (ede-convert-path this file)) (let ((file (ede-convert-path this file))
(src (ede-target-sourcecode this))) (src (ede-target-sourcecode this)))
@ -454,7 +454,7 @@ Argument TARGET is the project we are completing customization on."
(t (error "`project-add-file(ede-target)' source mismatch error"))) (t (error "`project-add-file(ede-target)' source mismatch error")))
(ede-proj-save)))) (ede-proj-save))))
(defmethod project-remove-file ((target ede-proj-target) file) (cl-defmethod project-remove-file ((target ede-proj-target) file)
"For TARGET, remove FILE. "For TARGET, remove FILE.
FILE must be massaged by `ede-convert-path'." FILE must be massaged by `ede-convert-path'."
;; Speedy delete should be safe. ;; Speedy delete should be safe.
@ -462,11 +462,11 @@ FILE must be massaged by `ede-convert-path'."
(object-remove-from-list target 'auxsource (ede-convert-path target file)) (object-remove-from-list target 'auxsource (ede-convert-path target file))
(ede-proj-save)) (ede-proj-save))
(defmethod project-update-version ((this ede-proj-project)) (cl-defmethod project-update-version ((this ede-proj-project))
"The :version of project THIS has changed." "The :version of project THIS has changed."
(ede-proj-save)) (ede-proj-save))
(defmethod project-make-dist ((this ede-proj-project)) (cl-defmethod project-make-dist ((this ede-proj-project))
"Build a distribution for the project based on THIS target." "Build a distribution for the project based on THIS target."
(let ((pm (ede-proj-dist-makefile this)) (let ((pm (ede-proj-dist-makefile this))
(df (project-dist-files this))) (df (project-dist-files this)))
@ -479,14 +479,14 @@ FILE must be massaged by `ede-convert-path'."
(file-name-directory pm)))) (file-name-directory pm))))
(compile (concat ede-make-command " -f " pm " dist")))) (compile (concat ede-make-command " -f " pm " dist"))))
(defmethod project-dist-files ((this ede-proj-project)) (cl-defmethod project-dist-files ((this ede-proj-project))
"Return a list of files that constitutes a distribution of THIS project." "Return a list of files that constitutes a distribution of THIS project."
(list (list
;; Note to self, keep this first for the above fn to check against. ;; Note to self, keep this first for the above fn to check against.
(concat (oref this name) "-" (oref this version) ".tar.gz") (concat (oref this name) "-" (oref this version) ".tar.gz")
)) ))
(defmethod project-compile-project ((proj ede-proj-project) &optional command) (cl-defmethod project-compile-project ((proj ede-proj-project) &optional command)
"Compile the entire current project PROJ. "Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj)) (let ((pm (ede-proj-dist-makefile proj))
@ -499,12 +499,12 @@ Argument COMMAND is the command to use when compiling."
;;; Target type specific compilations/debug ;;; Target type specific compilations/debug
;; ;;
(defmethod project-compile-target ((obj ede-proj-target) &optional command) (cl-defmethod project-compile-target ((obj ede-proj-target) &optional command)
"Compile the current target OBJ. "Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command)) (project-compile-project (ede-current-project) command))
(defmethod project-compile-target ((obj ede-proj-target-makefile) (cl-defmethod project-compile-target ((obj ede-proj-target-makefile)
&optional command) &optional command)
"Compile the current target program OBJ. "Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use." Optional argument COMMAND is the s the alternate command to use."
@ -512,21 +512,21 @@ Optional argument COMMAND is the s the alternate command to use."
(compile (concat ede-make-command " -f " (oref obj makefile) " " (compile (concat ede-make-command " -f " (oref obj makefile) " "
(ede-proj-makefile-target-name obj)))) (ede-proj-makefile-target-name obj))))
(defmethod project-debug-target ((obj ede-proj-target)) (cl-defmethod project-debug-target ((obj ede-proj-target))
"Run the current project target OBJ in a debugger." "Run the current project target OBJ in a debugger."
(error "Debug-target not supported by %s" (eieio-object-name obj))) (error "Debug-target not supported by %s" (eieio-object-name obj)))
(defmethod project-run-target ((obj ede-proj-target)) (cl-defmethod project-run-target ((obj ede-proj-target))
"Run the current project target OBJ." "Run the current project target OBJ."
(error "Run-target not supported by %s" (eieio-object-name obj))) (error "Run-target not supported by %s" (eieio-object-name obj)))
(defmethod ede-proj-makefile-target-name ((this ede-proj-target)) (cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target))
"Return the name of the main target for THIS target." "Return the name of the main target for THIS target."
(ede-name this)) (ede-name this))
;;; Compiler and source code generators ;;; Compiler and source code generators
;; ;;
(defmethod ede-want-file-auxiliary-p ((this ede-target) file) (cl-defmethod ede-want-file-auxiliary-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE." "Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide. ;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this))) (let ((src (ede-target-sourcecode this)))
@ -534,7 +534,7 @@ Optional argument COMMAND is the s the alternate command to use."
(setq src (cdr src))) (setq src (cdr src)))
src)) src))
(defmethod ede-proj-compilers ((obj ede-proj-target)) (cl-defmethod ede-proj-compilers ((obj ede-proj-target))
"List of compilers being used by OBJ. "List of compilers being used by OBJ.
If the `compiler' slot is empty, concoct one on a first match found If the `compiler' slot is empty, concoct one on a first match found
basis for any given type from the `availablecompilers' slot. basis for any given type from the `availablecompilers' slot.
@ -570,7 +570,7 @@ You may need to add support for this type of file."
;; Return the discovered compilers. ;; Return the discovered compilers.
comp))) comp)))
(defmethod ede-proj-linkers ((obj ede-proj-target)) (cl-defmethod ede-proj-linkers ((obj ede-proj-target))
"List of linkers being used by OBJ. "List of linkers being used by OBJ.
If the `linker' slot is empty, concoct one on a first match found If the `linker' slot is empty, concoct one on a first match found
basis for any given type from the `availablelinkers' slot. basis for any given type from the `availablelinkers' slot.
@ -624,7 +624,7 @@ Converts all symbols into the objects to be used."
"Return non-nil if the current project PROJ is automake mode." "Return non-nil if the current project PROJ is automake mode."
(eq (ede-proj-makefile-type proj) 'Makefile)) (eq (ede-proj-makefile-type proj) 'Makefile))
(defmethod ede-proj-dist-makefile ((this ede-proj-project)) (cl-defmethod ede-proj-dist-makefile ((this ede-proj-project))
"Return the name of the Makefile with the DIST target in it for THIS." "Return the name of the Makefile with the DIST target in it for THIS."
(cond ((eq (oref this makefile-type) 'Makefile.am) (cond ((eq (oref this makefile-type) 'Makefile.am)
(concat (file-name-directory (oref this file)) (concat (file-name-directory (oref this file))
@ -651,7 +651,7 @@ Converts all symbols into the objects to be used."
(interactive) (interactive)
(ede-proj-setup-buildenvironment (ede-current-project) t)) (ede-proj-setup-buildenvironment (ede-current-project) t))
(defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename) (cl-defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS if needed. "Create a Makefile for all Makefile targets in THIS if needed.
MFILENAME is the makefile to generate." MFILENAME is the makefile to generate."
;; For now, pass through until dirty is implemented. ;; For now, pass through until dirty is implemented.
@ -660,7 +660,7 @@ MFILENAME is the makefile to generate."
(file-newer-than-file-p (oref this file) mfilename)) (file-newer-than-file-p (oref this file) mfilename))
(ede-proj-makefile-create this mfilename))) (ede-proj-makefile-create this mfilename)))
(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project) (cl-defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
&optional force) &optional force)
"Setup the build environment for project THIS. "Setup the build environment for project THIS.
Handles the Makefile, or a Makefile.am configure.ac combination. Handles the Makefile, or a Makefile.am configure.ac combination.
@ -686,7 +686,7 @@ Optional argument FORCE will force items to be regenerated."
;;; Lower level overloads ;;; Lower level overloads
;; ;;
(defmethod project-rescan ((this ede-proj-project)) (cl-defmethod project-rescan ((this ede-proj-project))
"Rescan the EDE proj project THIS." "Rescan the EDE proj project THIS."
(let ((root (or (ede-project-root this) this)) (let ((root (or (ede-project-root this) this))
) )

84
lisp/cedet/ede/project-am.el
View file

@ -194,7 +194,7 @@ other meta-variable based on this name.")
"Encode one makefile.") "Encode one makefile.")
;;; Code: ;;; Code:
(defmethod project-add-file ((ot project-am-target)) (cl-defmethod project-add-file ((ot project-am-target))
"Add the current buffer into a project. "Add the current buffer into a project.
OT is the object target. DIR is the directory to start in." OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target") (let* ((target (if ede-object (error "Already associated w/ a target")
@ -221,7 +221,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer)) (save-buffer))
(setq ede-object ot))) (setq ede-object ot)))
(defmethod project-remove-file ((ot project-am-target) fnnd) (cl-defmethod project-remove-file ((ot project-am-target) fnnd)
"Remove the current buffer from any project targets." "Remove the current buffer from any project targets."
(ede-with-projectfile ot (ede-with-projectfile ot
(makefile-move-to-macro (project-am-macro ot)) (makefile-move-to-macro (project-am-macro ot))
@ -232,7 +232,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer)) (save-buffer))
(setq ede-object nil)) (setq ede-object nil))
(defmethod project-edit-file-target ((obj project-am-target)) (cl-defmethod project-edit-file-target ((obj project-am-target))
"Edit the target associated w/ this file." "Edit the target associated w/ this file."
(find-file (concat (oref obj path) "Makefile.am")) (find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min)) (goto-char (point-min))
@ -240,7 +240,7 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point)) (if (= (point-min) (point))
(re-search-forward (ede-target-name obj)))) (re-search-forward (ede-target-name obj))))
(defmethod project-new-target ((proj project-am-makefile) (cl-defmethod project-new-target ((proj project-am-makefile)
&optional name type) &optional name type)
"Create a new target named NAME. "Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string Argument TYPE is the type of target to insert. This is a string
@ -300,7 +300,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 ;; This should be handled at the EDE level, calling a method of the
;; top most project. ;; top most project.
;; ;;
(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. "Compile the entire current project.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
(require 'compile) (require 'compile)
@ -324,7 +324,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory))) (let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command))) (compile command)))
(defmethod project-compile-project ((obj project-am-makefile) (cl-defmethod project-compile-project ((obj project-am-makefile)
&optional command) &optional command)
"Compile the entire current project. "Compile the entire current project.
Argument COMMAND is the command to use when compiling." Argument COMMAND is the command to use when compiling."
@ -349,7 +349,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory))) (let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command))) (compile command)))
(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. "Compile the current target.
Argument COMMAND is the command to use for compiling the target." Argument COMMAND is the command to use for compiling the target."
(require 'compile) (require 'compile)
@ -378,7 +378,7 @@ Argument COMMAND is the command to use for compiling the target."
;; We better be in the right place when compiling a specific target. ;; We better be in the right place when compiling a specific target.
(compile command)) (compile command))
(defmethod project-debug-target ((obj project-am-objectcode)) (cl-defmethod project-debug-target ((obj project-am-objectcode))
"Run the current project target in a debugger." "Run the current project target in a debugger."
(let ((tb (get-buffer-create " *padt*")) (let ((tb (get-buffer-create " *padt*"))
(dd (oref obj path)) (dd (oref obj path))
@ -397,7 +397,7 @@ Argument COMMAND is the command to use for compiling the target."
(declare-function ede-shell-run-something "ede/shell") (declare-function ede-shell-run-something "ede/shell")
(defmethod project-run-target ((obj project-am-objectcode)) (cl-defmethod project-run-target ((obj project-am-objectcode))
"Run the current project target in comint buffer." "Run the current project target in comint buffer."
(require 'ede/shell) (require 'ede/shell)
(let ((tb (get-buffer-create " *padt*")) (let ((tb (get-buffer-create " *padt*"))
@ -413,7 +413,7 @@ Argument COMMAND is the command to use for compiling the target."
(ede-shell-run-something obj cmd)) (ede-shell-run-something obj cmd))
(kill-buffer tb)))) (kill-buffer tb))))
(defmethod project-make-dist ((this project-am-target)) (cl-defmethod project-make-dist ((this project-am-target))
"Run the current project in the debugger." "Run the current project in the debugger."
(require 'compile) (require 'compile)
(if (not project-am-compile-project-command) (if (not project-am-compile-project-command)
@ -500,7 +500,7 @@ This is used when subprojects are made in named subdirectories."
ampf)))) ampf))))
;;; Methods: ;;; Methods:
(defmethod project-targets-for-file ((proj project-am-makefile)) (cl-defmethod project-targets-for-file ((proj project-am-makefile))
"Return a list of targets the project PROJ." "Return a list of targets the project PROJ."
(oref proj targets)) (oref proj targets))
@ -612,7 +612,7 @@ Strip out duplicates, and recurse on variables."
subdirs) subdirs)
) )
(defmethod project-rescan ((this project-am-makefile) &optional suggestedname) (cl-defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
"Rescan the makefile for all targets and sub targets." "Rescan the makefile for all targets and sub targets."
(project-am-with-makefile-current (file-name-directory (oref this file)) (project-am-with-makefile-current (file-name-directory (oref this file))
;;(message "Scanning %s..." (oref this file)) ;;(message "Scanning %s..." (oref this file))
@ -692,7 +692,7 @@ Strip out duplicates, and recurse on variables."
))) )))
(defmethod project-rescan ((this project-am-program)) (cl-defmethod project-rescan ((this project-am-program))
"Rescan object THIS." "Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))) (oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source) (unless (oref this :source)
@ -700,65 +700,65 @@ Strip out duplicates, and recurse on variables."
(oset this :ldadd (makefile-macro-file-list (oset this :ldadd (makefile-macro-file-list
(concat (oref this :name) "_LDADD")))) (concat (oref this :name) "_LDADD"))))
(defmethod project-rescan ((this project-am-lib)) (cl-defmethod project-rescan ((this project-am-lib))
"Rescan object THIS." "Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))) (oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source) (unless (oref this :source)
(oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c"))))) (oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c")))))
(defmethod project-rescan ((this project-am-texinfo)) (cl-defmethod project-rescan ((this project-am-texinfo))
"Rescan object THIS." "Rescan object THIS."
(oset this :include (makefile-macro-file-list (project-am-macro this)))) (oset this :include (makefile-macro-file-list (project-am-macro this))))
(defmethod project-rescan ((this project-am-man)) (cl-defmethod project-rescan ((this project-am-man))
"Rescan object THIS." "Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))) (oset this :source (makefile-macro-file-list (project-am-macro this))))
(defmethod project-rescan ((this project-am-lisp)) (cl-defmethod project-rescan ((this project-am-lisp))
"Rescan the lisp sources." "Rescan the lisp sources."
(oset this :source (makefile-macro-file-list (project-am-macro this)))) (oset this :source (makefile-macro-file-list (project-am-macro this))))
(defmethod project-rescan ((this project-am-header)) (cl-defmethod project-rescan ((this project-am-header))
"Rescan the Header sources for object THIS." "Rescan the Header sources for object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))) (oset this :source (makefile-macro-file-list (project-am-macro this))))
(defmethod project-rescan ((this project-am-built-src)) (cl-defmethod project-rescan ((this project-am-built-src))
"Rescan built sources for object THIS." "Rescan built sources for object THIS."
(oset this :source (makefile-macro-file-list "BUILT_SOURCES"))) (oset this :source (makefile-macro-file-list "BUILT_SOURCES")))
(defmethod project-rescan ((this project-am-extra-dist)) (cl-defmethod project-rescan ((this project-am-extra-dist))
"Rescan object THIS." "Rescan object THIS."
(oset this :source (makefile-macro-file-list "EXTRA_DIST"))) (oset this :source (makefile-macro-file-list "EXTRA_DIST")))
(defmethod project-am-macro ((this project-am-objectcode)) (cl-defmethod project-am-macro ((this project-am-objectcode))
"Return the default macro to 'edit' for this object type." "Return the default macro to 'edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES")) (concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES"))
(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." "Return the default macro to 'edit' for this object."
"noinst_HEADERS") "noinst_HEADERS")
(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." "Return the default macro to 'edit' for this object."
"include_HEADERS") "include_HEADERS")
(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." "Return the default macro to 'edit' for this object."
"pkginclude_HEADERS") "pkginclude_HEADERS")
(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." "Return the default macro to 'edit' for this object."
"check_HEADERS") "check_HEADERS")
(defmethod project-am-macro ((this project-am-texinfo)) (cl-defmethod project-am-macro ((this project-am-texinfo))
"Return the default macro to 'edit' for this object type." "Return the default macro to 'edit' for this object type."
(concat (file-name-sans-extension (oref this :name)) "_TEXINFOS")) (concat (file-name-sans-extension (oref this :name)) "_TEXINFOS"))
(defmethod project-am-macro ((this project-am-man)) (cl-defmethod project-am-macro ((this project-am-man))
"Return the default macro to 'edit' for this object type." "Return the default macro to 'edit' for this object type."
(oref this :name)) (oref this :name))
(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." "Return the default macro to 'edit' for this object."
"lisp_LISP") "lisp_LISP")
@ -781,7 +781,7 @@ nil means that this buffer belongs to no-one."
sobj (cdr sobj))) sobj (cdr sobj)))
obj)))) obj))))
(defmethod ede-buffer-mine ((this project-am-makefile) buffer) (cl-defmethod ede-buffer-mine ((this project-am-makefile) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer)))) (let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this :file) efn) (or (string= (oref this :file) efn)
@ -796,42 +796,42 @@ nil means that this buffer belongs to no-one."
ans) ans)
))) )))
(defmethod ede-buffer-mine ((this project-am-objectcode) buffer) (cl-defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path)) (member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source))) (oref this :source)))
(defmethod ede-buffer-mine ((this project-am-texinfo) buffer) (cl-defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(let ((bfn (file-relative-name (buffer-file-name buffer) (let ((bfn (file-relative-name (buffer-file-name buffer)
(oref this :path)))) (oref this :path))))
(or (string= (oref this :name) bfn) (or (string= (oref this :name) bfn)
(member bfn (oref this :include))))) (member bfn (oref this :include)))))
(defmethod ede-buffer-mine ((this project-am-man) buffer) (cl-defmethod ede-buffer-mine ((this project-am-man) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(string= (oref this :name) (string= (oref this :name)
(file-relative-name (buffer-file-name buffer) (oref this :path)))) (file-relative-name (buffer-file-name buffer) (oref this :path))))
(defmethod ede-buffer-mine ((this project-am-lisp) buffer) (cl-defmethod ede-buffer-mine ((this project-am-lisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER." "Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path)) (member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source))) (oref this :source)))
(defmethod project-am-subtree ((ampf project-am-makefile) subdir) (cl-defmethod project-am-subtree ((ampf project-am-makefile) subdir)
"Return the sub project in AMPF specified by SUBDIR." "Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj))) (object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
(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." "Default target to use when compiling a given target."
;; This is a pretty good default for most. ;; This is a pretty good default for most.
"") "")
(defmethod project-compile-target-command ((this project-am-objectcode)) (cl-defmethod project-compile-target-command ((this project-am-objectcode))
"Default target to use when compiling an object code target." "Default target to use when compiling an object code target."
(oref this :name)) (oref this :name))
(defmethod project-compile-target-command ((this project-am-texinfo)) (cl-defmethod project-compile-target-command ((this project-am-texinfo))
"Default target t- use when compiling a texinfo file." "Default target t- use when compiling a texinfo file."
(let ((n (oref this :name))) (let ((n (oref this :name)))
(if (string-match "\\.texi?\\(nfo\\)?" n) (if (string-match "\\.texi?\\(nfo\\)?" n)
@ -861,9 +861,9 @@ Argument FILE is the file to extract the end directory name from."
(t (t
'project-am-program))) 'project-am-program)))
(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." "There are no default header files."
(or (call-next-method) (or (cl-call-next-method)
(let ((s (oref this source)) (let ((s (oref this source))
(found nil)) (found nil))
(while (and s (not found)) (while (and s (not found))
@ -873,7 +873,7 @@ Argument FILE is the file to extract the end directory name from."
(setq s (cdr s))) (setq s (cdr s)))
found))) found)))
(defmethod ede-documentation ((this project-am-texinfo)) (cl-defmethod ede-documentation ((this project-am-texinfo))
"Return a list of files that provides documentation. "Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other Documentation is not for object THIS, but is provided by THIS for other
files in the project." files in the project."
@ -997,12 +997,12 @@ Calculates the info with `project-am-extract-package-info'."
(project-am-extract-package-info dir))) (project-am-extract-package-info dir)))
;; for simple per project include path extension ;; for simple per project include path extension
(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 "Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar." per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path)) (bound-and-true-p project-am-localvars-include-path))
(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 "Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar." per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path)) (bound-and-true-p project-am-localvars-include-path))

4
lisp/cedet/ede/shell.el
View file

@ -33,7 +33,7 @@
(declare-function comint-send-input "comint") (declare-function comint-send-input "comint")
(defmethod ede-shell-run-something ((target ede-target) command) (cl-defmethod ede-shell-run-something ((target ede-target) command)
"Create a shell to run stuff for TARGET. "Create a shell to run stuff for TARGET.
COMMAND is a text string representing the thing to be run." COMMAND is a text string representing the thing to be run."
(let* ((buff (ede-shell-buffer target)) (let* ((buff (ede-shell-buffer target))
@ -72,7 +72,7 @@ COMMAND is a text string representing the thing to be run."
(comint-send-input) (comint-send-input)
) )
(defmethod ede-shell-buffer ((target ede-target)) (cl-defmethod ede-shell-buffer ((target ede-target))
"Get the buffer for running shell commands for TARGET." "Get the buffer for running shell commands for TARGET."
(let ((name (ede-name target))) (let ((name (ede-name target)))
(get-buffer-create (format "*EDE Shell %s*" name)))) (get-buffer-create (format "*EDE Shell %s*" name))))

4
lisp/cedet/ede/simple.el
View file

@ -102,7 +102,7 @@ All directories need at least one target.")
"EDE Simple project class. "EDE Simple project class.
Each directory needs a project file to control it.") Each directory needs a project file to control it.")
(defmethod ede-commit-project ((proj ede-simple-project)) (cl-defmethod ede-commit-project ((proj ede-simple-project))
"Commit any change to PROJ to its file." "Commit any change to PROJ to its file."
(when (not (file-exists-p ede-simple-save-directory)) (when (not (file-exists-p ede-simple-save-directory))
(if (y-or-n-p (concat ede-simple-save-directory (if (y-or-n-p (concat ede-simple-save-directory
@ -111,7 +111,7 @@ Each directory needs a project file to control it.")
(error "No save directory for new project"))) (error "No save directory for new project")))
(eieio-persistent-save proj)) (eieio-persistent-save proj))
(defmethod ede-find-subproject-for-directory ((proj ede-simple-project) (cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
dir) dir)
"Return PROJ, for handling all subdirs below DIR." "Return PROJ, for handling all subdirs below DIR."
proj) proj)

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

@ -72,7 +72,7 @@ that they are willing to use.")
;;; Methods ;;; Methods
;; ;;
(defmethod initialize-instance :AFTER ((this ede-sourcecode) &rest fields) (cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields)
"Make sure that all ede compiler objects are cached in "Make sure that all ede compiler objects are cached in
`ede-compiler-list'." `ede-compiler-list'."
(let ((lst ede-sourcecode-list)) (let ((lst ede-sourcecode-list))
@ -85,45 +85,45 @@ that they are willing to use.")
;; Add to the beginning of the list. ;; Add to the beginning of the list.
(setq ede-sourcecode-list (cons this ede-sourcecode-list))))) (setq ede-sourcecode-list (cons this ede-sourcecode-list)))))
(defmethod ede-want-file-p ((this ede-sourcecode) filename) (cl-defmethod ede-want-file-p ((this ede-sourcecode) filename)
"Return non-nil if sourcecode definition THIS will take FILENAME." "Return non-nil if sourcecode definition THIS will take FILENAME."
(or (ede-want-file-source-p this filename) (or (ede-want-file-source-p this filename)
(ede-want-file-auxiliary-p this filename))) (ede-want-file-auxiliary-p this filename)))
(defmethod ede-want-file-source-p ((this ede-sourcecode) filename) (cl-defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ." "Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(string-match (oref this sourcepattern) filename))) (string-match (oref this sourcepattern) filename)))
(defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename) (cl-defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ." "Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(and (slot-boundp this 'auxsourcepattern) (and (slot-boundp this 'auxsourcepattern)
(oref this auxsourcepattern) (oref this auxsourcepattern)
(string-match (oref this auxsourcepattern) filename)))) (string-match (oref this auxsourcepattern) filename))))
(defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames) (cl-defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any source files in FILENAMES." "Return non-nil if THIS will accept any source files in FILENAMES."
(let (found) (let (found)
(while (and (not found) filenames) (while (and (not found) filenames)
(setq found (ede-want-file-source-p this (pop filenames)))) (setq found (ede-want-file-source-p this (pop filenames))))
found)) found))
(defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames) (cl-defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any aux files in FILENAMES." "Return non-nil if THIS will accept any aux files in FILENAMES."
(let (found) (let (found)
(while (and (not found) filenames) (while (and (not found) filenames)
(setq found (ede-want-file-auxiliary-p this (pop filenames)))) (setq found (ede-want-file-auxiliary-p this (pop filenames))))
found)) found))
(defmethod ede-want-any-files-p ((this ede-sourcecode) filenames) (cl-defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any files in FILENAMES." "Return non-nil if THIS will accept any files in FILENAMES."
(let (found) (let (found)
(while (and (not found) filenames) (while (and (not found) filenames)
(setq found (ede-want-file-p this (pop filenames)))) (setq found (ede-want-file-p this (pop filenames))))
found)) found))
(defmethod ede-buffer-header-file ((this ede-sourcecode) filename) (cl-defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
"Return a list of file names of header files for THIS with FILENAME. "Return a list of file names of header files for THIS with FILENAME.
Used to guess header files, but uses the auxsource regular expression." Used to guess header files, but uses the auxsource regular expression."
(let ((dn (file-name-directory filename)) (let ((dn (file-name-directory filename))

20
lisp/cedet/ede/speedbar.el
View file

@ -181,13 +181,13 @@ Argument DIR is the directory from which to derive the list of objects."
(setq depth (1- depth))) (setq depth (1- depth)))
(speedbar-line-token)))) (speedbar-line-token))))
(defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth) (cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
"Return the path to OBJ. "Return the path to OBJ.
Optional DEPTH is the depth we start at." Optional DEPTH is the depth we start at."
(file-name-directory (oref obj file)) (file-name-directory (oref obj file))
) )
(defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth) (cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
"Return the path to OBJ. "Return the path to OBJ.
Optional DEPTH is the depth we start at." Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj))) (let ((proj (ede-target-parent obj)))
@ -201,42 +201,42 @@ Optional DEPTH is the depth we start at."
(concat (eieio-speedbar-derive-line-path proj) (concat (eieio-speedbar-derive-line-path proj)
(ede-find-nearest-file-line))))))) (ede-find-nearest-file-line)))))))
(defmethod eieio-speedbar-description ((obj ede-project)) (cl-defmethod eieio-speedbar-description ((obj ede-project))
"Provide a speedbar description for OBJ." "Provide a speedbar description for OBJ."
(ede-description obj)) (ede-description obj))
(defmethod eieio-speedbar-description ((obj ede-target)) (cl-defmethod eieio-speedbar-description ((obj ede-target))
"Provide a speedbar description for OBJ." "Provide a speedbar description for OBJ."
(ede-description obj)) (ede-description obj))
(defmethod eieio-speedbar-child-description ((obj ede-target)) (cl-defmethod eieio-speedbar-child-description ((obj ede-target))
"Provide a speedbar description for a plain-child of OBJ. "Provide a speedbar description for a plain-child of OBJ.
A plain child is a child element which is not an EIEIO object." A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-helper) (or (speedbar-item-info-file-helper)
(speedbar-item-info-tag-helper))) (speedbar-item-info-tag-helper)))
(defmethod eieio-speedbar-object-buttonname ((object ede-project)) (cl-defmethod eieio-speedbar-object-buttonname ((object ede-project))
"Return a string to use as a speedbar button for OBJECT." "Return a string to use as a speedbar button for OBJECT."
(if (ede-parent-project object) (if (ede-parent-project object)
(ede-name object) (ede-name object)
(concat (ede-name object) " " (oref object version)))) (concat (ede-name object) " " (oref object version))))
(defmethod eieio-speedbar-object-buttonname ((object ede-target)) (cl-defmethod eieio-speedbar-object-buttonname ((object ede-target))
"Return a string to use as a speedbar button for OBJECT." "Return a string to use as a speedbar button for OBJECT."
(ede-name object)) (ede-name object))
(defmethod eieio-speedbar-object-children ((this ede-project)) (cl-defmethod eieio-speedbar-object-children ((this ede-project))
"Return the list of speedbar display children for THIS." "Return the list of speedbar display children for THIS."
(condition-case nil (condition-case nil
(with-slots (subproj targets) this (with-slots (subproj targets) this
(append subproj targets)) (append subproj targets))
(error nil))) (error nil)))
(defmethod eieio-speedbar-object-children ((this ede-target)) (cl-defmethod eieio-speedbar-object-children ((this ede-target))
"Return the list of speedbar display children for THIS." "Return the list of speedbar display children for THIS."
(oref this source)) (oref this source))
(defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth) (cl-defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
"Create a speedbar tag line for a child of THIS. "Create a speedbar tag line for a child of THIS.
It has depth DEPTH." It has depth DEPTH."
(with-slots (source) this (with-slots (source) this

6
lisp/cedet/ede/util.el
View file

@ -46,19 +46,19 @@ Argument NEWVERSION is the version number to use in the current project."
(project-update-version ede-object) (project-update-version ede-object)
(ede-update-version-in-source ede-object newversion)))) (ede-update-version-in-source ede-object newversion))))
(defmethod project-update-version ((ot ede-project)) (cl-defmethod project-update-version ((ot ede-project))
"The :version of the project OT has been updated. "The :version of the project OT has been updated.
Handle saving, or other detail." Handle saving, or other detail."
(error "project-update-version not supported by %s" (eieio-object-name ot))) (error "project-update-version not supported by %s" (eieio-object-name ot)))
(defmethod ede-update-version-in-source ((this ede-project) version) (cl-defmethod ede-update-version-in-source ((this ede-project) version)
"Change occurrences of a version string in sources. "Change occurrences of a version string in sources.
In project THIS, cycle over all targets to give them a chance to set In project THIS, cycle over all targets to give them a chance to set
their sources to VERSION." their sources to VERSION."
(ede-map-targets this (lambda (targ) (ede-map-targets this (lambda (targ)
(ede-update-version-in-source targ version)))) (ede-update-version-in-source targ version))))
(defmethod ede-update-version-in-source ((this ede-target) version) (cl-defmethod ede-update-version-in-source ((this ede-target) version)
"In sources for THIS, change version numbers to VERSION." "In sources for THIS, change version numbers to VERSION."
(if (and (slot-boundp this 'versionsource) (if (and (slot-boundp this 'versionsource)
(oref this versionsource)) (oref this versionsource))

32
lisp/cedet/semantic/analyze.el
View file

@ -168,7 +168,7 @@ of the parent function.")
;; ;;
;; Simple methods against the context classes. ;; Simple methods against the context classes.
;; ;;
(defmethod semantic-analyze-type-constraint (cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context) &optional desired-type) ((context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT. "Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze." Optional argument DESIRED-TYPE may be a non-type tag to analyze."
@ -189,17 +189,17 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
) )
desired-type)) desired-type))
(defmethod semantic-analyze-type-constraint (cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-functionarg)) ((context semantic-analyze-context-functionarg))
"Return a type constraint for completing :prefix in CONTEXT." "Return a type constraint for completing :prefix in CONTEXT."
(call-next-method context (car (oref context argument)))) (cl-call-next-method context (car (oref context argument))))
(defmethod semantic-analyze-type-constraint (cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-assignment)) ((context semantic-analyze-context-assignment))
"Return a type constraint for completing :prefix in CONTEXT." "Return a type constraint for completing :prefix in CONTEXT."
(call-next-method context (car (reverse (oref context assignee))))) (cl-call-next-method context (car (reverse (oref context assignee)))))
(defmethod semantic-analyze-interesting-tag (cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context)) ((context semantic-analyze-context))
"Return a tag from CONTEXT that would be most interesting to a user." "Return a tag from CONTEXT that would be most interesting to a user."
(let ((prefix (reverse (oref context :prefix)))) (let ((prefix (reverse (oref context :prefix))))
@ -209,15 +209,15 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; Return the found tag, or nil. ;; Return the found tag, or nil.
(car prefix))) (car prefix)))
(defmethod semantic-analyze-interesting-tag (cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-functionarg)) ((context semantic-analyze-context-functionarg))
"Try the base, and if that fails, return what we are assigning into." "Try the base, and if that fails, return what we are assigning into."
(or (call-next-method) (car-safe (oref context :function)))) (or (cl-call-next-method) (car-safe (oref context :function))))
(defmethod semantic-analyze-interesting-tag (cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-assignment)) ((context semantic-analyze-context-assignment))
"Try the base, and if that fails, return what we are assigning into." "Try the base, and if that fails, return what we are assigning into."
(or (call-next-method) (car-safe (oref context :assignee)))) (or (cl-call-next-method) (car-safe (oref context :assignee))))
;;; ANALYSIS ;;; ANALYSIS
;; ;;
@ -743,7 +743,7 @@ Optional argument CTXT is the context to show."
;; ;;
(declare-function pulse-momentary-highlight-region "pulse") (declare-function pulse-momentary-highlight-region "pulse")
(defmethod semantic-analyze-pulse ((context semantic-analyze-context)) (cl-defmethod semantic-analyze-pulse ((context semantic-analyze-context))
"Pulse the region that CONTEXT affects." "Pulse the region that CONTEXT affects."
(require 'pulse) (require 'pulse)
(with-current-buffer (oref context :buffer) (with-current-buffer (oref context :buffer)
@ -782,7 +782,7 @@ Use BUFF as a source of override methods."
(setq prefix (make-string (length prefix) ? )) (setq prefix (make-string (length prefix) ? ))
)) ))
(defmethod semantic-analyze-show ((context semantic-analyze-context)) (cl-defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way." "Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context prefix) "Prefix: " ) (semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
(semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ") (semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
@ -796,19 +796,19 @@ Use BUFF as a source of override methods."
(semantic-analyze-show (oref context scope))) (semantic-analyze-show (oref context scope)))
) )
(defmethod semantic-analyze-show ((context semantic-analyze-context-assignment)) (cl-defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
"Insert CONTEXT into the current buffer in a nice way." "Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context assignee) "Assignee: ") (semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
(call-next-method)) (cl-call-next-method))
(defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg)) (cl-defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
"Insert CONTEXT into the current buffer in a nice way." "Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context function) "Function: ") (semantic-analyze-princ-sequence (oref context function) "Function: ")
(princ "Argument Index: ") (princ "Argument Index: ")
(princ (oref context index)) (princ (oref context index))
(princ "\n") (princ "\n")
(semantic-analyze-princ-sequence (oref context argument) "Argument: ") (semantic-analyze-princ-sequence (oref context argument) "Argument: ")
(call-next-method)) (cl-call-next-method))
(defun semantic-analyze-pop-to-context (context) (defun semantic-analyze-pop-to-context (context)
"Display CONTEXT in a temporary buffer. "Display CONTEXT in a temporary buffer.

4
lisp/cedet/semantic/analyze/refs.el
View file

@ -100,7 +100,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
;; ;;
;; These accessor methods will calculate the useful bits from the context, and cache values ;; These accessor methods will calculate the useful bits from the context, and cache values
;; into the context. ;; into the context.
(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer) (cl-defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
"Return the implementations derived in the reference analyzer REFS. "Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata)) (let ((allhits (oref refs rawsearchdata))
@ -125,7 +125,7 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
allhits) allhits)
impl)) impl))
(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer) (cl-defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
"Return the prototypes derived in the reference analyzer REFS. "Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata)) (let ((allhits (oref refs rawsearchdata))

8
lisp/cedet/semantic/bovine/debug.el
View file

@ -83,7 +83,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
frame) frame)
frame)) frame))
(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame)) (cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame." "Highlight one parser frame."
(let* ((nonterm (oref frame nonterm)) (let* ((nonterm (oref frame nonterm))
(pb (oref semantic-debug-current-interface parser-buffer)) (pb (oref semantic-debug-current-interface parser-buffer))
@ -102,7 +102,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
(oref frame lextoken)) (oref frame lextoken))
)) ))
(defmethod semantic-debug-frame-info ((frame semantic-debug-frame)) (cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame." "Display info about this one parser frame."
(message "%S" (oref frame collection)) (message "%S" (oref frame collection))
) )
@ -125,12 +125,12 @@ Argument CONDITION is the thrown error condition."
frame) frame)
frame)) frame))
(defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame)) (cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
"Highlight a frame from an action." "Highlight a frame from an action."
;; How do I get the location of the action in the source buffer? ;; How do I get the location of the action in the source buffer?
) )
(defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame)) (cl-defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
"Display info about the error thrown." "Display info about the error thrown."
(message "Error: %S" (oref frame condition))) (message "Error: %S" (oref frame condition)))

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

@ -930,7 +930,7 @@ derive from this list.")
The only options available for completion are those which can be logically The only options available for completion are those which can be logically
inserted into the current context.") inserted into the current context.")
(defmethod semantic-collector-calculate-completions-raw (cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist) ((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist." "calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them. ;; if there are no completions yet, calculate them.
@ -945,11 +945,11 @@ inserted into the current context.")
prefix prefix
(oref obj first-pass-completions))))) (oref obj first-pass-completions)))))
(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract)) (cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have." "Clean up any mess this collector may have."
nil) nil)
(defmethod semantic-collector-next-action (cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial) ((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action. "What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion." PARTIAL indicates if we are doing a partial completion."
@ -974,19 +974,19 @@ PARTIAL indicates if we are doing a partial completion."
'complete-whitespace))) 'complete-whitespace)))
'complete)) 'complete))
(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract) (cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix) last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX." "Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj 'last-prefix) (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) last-prefix))) (string= (oref obj last-prefix) last-prefix)))
(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract)) (cl-defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
"Get the raw cache of tags for completion. "Get the raw cache of tags for completion.
Calculate the cache if there isn't one." Calculate the cache if there isn't one."
(or (oref obj cache) (or (oref obj cache)
(semantic-collector-calculate-cache obj))) (semantic-collector-calculate-cache obj)))
(defmethod semantic-collector-calculate-completions-raw (cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist) ((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist. "Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format." Output must be in semanticdb Find result format."
@ -1005,7 +1005,7 @@ Output must be in semanticdb Find result format."
(if result (if result
(list (cons table result))))) (list (cons table result)))))
(defmethod semantic-collector-calculate-completions (cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial) ((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries." "Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold) (let* ((case-fold-search semantic-case-fold)
@ -1082,7 +1082,7 @@ Output must be in semanticdb Find result format."
))) )))
)) ))
(defmethod semantic-collector-try-completion-whitespace (cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix) ((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX. "For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching This implies that if there are two completions, one matching
@ -1114,7 +1114,7 @@ has been run first."
))) )))
(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract)) (cl-defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector. "Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded matches. For semanticdb based results, make sure the file is loaded
@ -1122,12 +1122,12 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match) (when (slot-boundp obj 'current-exact-match)
(oref obj current-exact-match))) (oref obj current-exact-match)))
(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract)) (cl-defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
"Return the active whitespace completion value." "Return the active whitespace completion value."
(when (slot-boundp obj 'last-whitespace-completion) (when (slot-boundp obj 'last-whitespace-completion)
(oref obj last-whitespace-completion))) (oref obj last-whitespace-completion)))
(defmethod semantic-collector-get-match ((obj semantic-collector-abstract)) (cl-defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector. "Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded matches. For semanticdb based results, make sure the file is loaded
@ -1135,7 +1135,7 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match) (when (slot-boundp obj 'current-exact-match)
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0))) (semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
(defmethod semantic-collector-all-completions (cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix) ((obj semantic-collector-abstract) prefix)
"For OBJ, retrieve all completions matching PREFIX. "For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently The returned list consists of all the tags currently
@ -1143,7 +1143,7 @@ matching PREFIX."
(when (slot-boundp obj 'last-all-completions) (when (slot-boundp obj 'last-all-completions)
(oref obj last-all-completions))) (oref obj last-all-completions)))
(defmethod semantic-collector-try-completion (cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix) ((obj semantic-collector-abstract) prefix)
"For OBJ, attempt to match PREFIX. "For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works. See `try-completion' for details on how this works.
@ -1154,13 +1154,13 @@ with that name."
(if (slot-boundp obj 'last-completion) (if (slot-boundp obj 'last-completion)
(oref obj last-completion))) (oref obj last-completion)))
(defmethod semantic-collector-calculate-cache (cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract)) ((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ." "Calculate the completion cache for OBJ."
nil nil
) )
(defmethod semantic-collector-flush ((this semantic-collector-abstract)) (cl-defmethod semantic-collector-flush ((this semantic-collector-abstract))
"Flush THIS collector object, clearing any caches and prefix." "Flush THIS collector object, clearing any caches and prefix."
(oset this cache nil) (oset this cache nil)
(slot-makeunbound this 'last-prefix) (slot-makeunbound this 'last-prefix)
@ -1177,7 +1177,7 @@ with that name."
These collectors track themselves on a per-buffer basis." These collectors track themselves on a per-buffer basis."
:abstract t) :abstract t)
(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract) (cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields) newname &rest fields)
"Reuse previously created objects of this type in buffer." "Reuse previously created objects of this type in buffer."
(let ((old nil) (let ((old nil)
@ -1186,7 +1186,7 @@ These collectors track themselves on a per-buffer basis."
(if (eq (eieio-object-class (car bl)) this) (if (eq (eieio-object-class (car bl)) this)
(setq old (car bl)))) (setq old (car bl))))
(unless old (unless old
(let ((new (call-next-method))) (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new) (add-to-list 'semantic-collector-per-buffer-list new)
(setq old new))) (setq old new)))
(slot-makeunbound old 'last-completion) (slot-makeunbound old 'last-completion)
@ -1217,7 +1217,7 @@ NEWCACHE is the new tag table, but we ignore it."
When searching for a tag, uses semantic deep search functions. When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.") Basics search only in the current buffer.")
(defmethod semantic-collector-calculate-cache (cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep)) ((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ. "Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'" Uses `semantic-flatten-tags-table'"
@ -1247,7 +1247,7 @@ Uses semanticdb for searching all tags in the current project."
"Completion engine for tags in a project.") "Completion engine for tags in a project.")
(defmethod semantic-collector-calculate-completions-raw (cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist) ((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist." "Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path))) (semanticdb-find-tags-for-completion prefix (oref obj path)))
@ -1260,7 +1260,7 @@ Uses semanticdb for searching all tags in the current project."
(declare-function semanticdb-brute-deep-find-tags-for-completion (declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find") "semantic/db-find")
(defmethod semantic-collector-calculate-completions-raw (cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist) ((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist." "Calculate the completions for prefix from completionlist."
(require 'semantic/db-find) (require 'semantic/db-find)
@ -1274,7 +1274,7 @@ Uses semanticdb for searching all tags in the current project."
"The scope the local members are being completed from.")) "The scope the local members are being completed from."))
"Completion engine for tags in a project.") "Completion engine for tags in a project.")
(defmethod semantic-collector-calculate-completions-raw (cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist) ((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist." "Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope) (let* ((scope (or (oref obj scope)
@ -1323,11 +1323,11 @@ Provides the basics for a displayor, including interacting with
a collector, and tracking tables of completion to display." a collector, and tracking tables of completion to display."
:abstract t) :abstract t)
(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
"Clean up any mess this displayor may have." "Clean up any mess this displayor may have."
nil) nil)
(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display." "The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix) (if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB) (or (eq this-command 'semantic-complete-inline-TAB)
@ -1336,33 +1336,33 @@ a collector, and tracking tables of completion to display."
'scroll 'scroll
'display)) 'display))
(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract) (cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix) table prefix)
"Set the list of tags to be completed over to TABLE." "Set the list of tags to be completed over to TABLE."
(oset obj table table) (oset obj table table)
(oset obj last-prefix prefix)) (oset obj last-prefix prefix))
(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
"A request to show the current tags table." "A request to show the current tags table."
(ding)) (ding))
(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
"A request to for the displayor to focus on some tag option." "A request to for the displayor to focus on some tag option."
(ding)) (ding))
(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
"A request to for the displayor to scroll the completion list (if needed)." "A request to for the displayor to scroll the completion list (if needed)."
(scroll-other-window)) (scroll-other-window))
(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
"Set the current focus to the previous item." "Set the current focus to the previous item."
nil) nil)
(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
"Set the current focus to the next item." "Set the current focus to the next item."
nil) nil)
(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract)) (cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
"Return a single tag currently in focus. "Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object." This object type doesn't do focus, so will never have a focus object."
nil) nil)
@ -1381,7 +1381,7 @@ Traditional display mechanism for a list of possible completions.
Completions are showin in a new buffer and listed with the ability Completions are showin in a new buffer and listed with the ability
to click on the items to aid in completion.") to click on the items to aid in completion.")
(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional)) (cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
"A request to show the current tags table." "A request to show the current tags table."
;; NOTE TO SELF. Find the character to type next, and emphasize it. ;; NOTE TO SELF. Find the character to type next, and emphasize it.
@ -1412,7 +1412,7 @@ Focusing is a way of differentiating among multiple tags
which have the same name." which have the same name."
:abstract t) :abstract t)
(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract)) (cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
"The next action to take on the minibuffer related to display." "The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix) (if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text)) (string= (oref obj last-prefix) (semantic-completion-text))
@ -1428,13 +1428,13 @@ which have the same name."
'focus) 'focus)
'display)) 'display))
(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract) (cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix) table prefix)
"Set the list of tags to be completed over to TABLE." "Set the list of tags to be completed over to TABLE."
(call-next-method) (cl-call-next-method)
(slot-makeunbound obj 'focus)) (slot-makeunbound obj 'focus))
(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract)) (cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
"Set the current focus to the previous item. "Set the current focus to the previous item.
Not meaningful return value." Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table)) (when (and (slot-boundp obj 'table) (oref obj table))
@ -1446,7 +1446,7 @@ Not meaningful return value."
) )
))) )))
(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract)) (cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
"Set the current focus to the next item. "Set the current focus to the next item.
Not meaningful return value." Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table)) (when (and (slot-boundp obj 'table) (oref obj table))
@ -1459,13 +1459,13 @@ Not meaningful return value."
(oset obj focus 0)) (oset obj focus 0))
))) )))
(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract)) (cl-defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
"Return the next tag OBJ should focus on." "Return the next tag OBJ should focus on."
(when (and (slot-boundp obj 'table) (oref obj table)) (when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj (with-slots (table) obj
(semanticdb-find-result-nth table (oref obj focus))))) (semanticdb-find-result-nth table (oref obj focus)))))
(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract)) (cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
"Return the tag currently in focus, or call parent method." "Return the tag currently in focus, or call parent method."
(if (and (slot-boundp obj 'focus) (if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table) (slot-boundp obj 'table)
@ -1481,7 +1481,7 @@ Not meaningful return value."
;; database. ;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus)))) (car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever ;; Do whatever
(call-next-method))) (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion, ;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting. ;; and also focuses with highlighting.
@ -1494,7 +1494,7 @@ Same as `semantic-displayor-traditional', but with selection between
multiple tags with the same name done by 'focusing' on the source multiple tags with the same name done by 'focusing' on the source
location of the different tags to differentiate them.") location of the different tags to differentiate them.")
(defmethod semantic-displayor-focus-request (cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-traditional-with-focus-highlight)) ((obj semantic-displayor-traditional-with-focus-highlight))
"Focus in on possible tag completions. "Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting Focus is performed by cycling through the tags and highlighting
@ -1630,7 +1630,7 @@ This will not happen if you directly set this variable via `setq'."
"Display completions options in a tooltip. "Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.") Display mechanism using tooltip for a list of possible completions.")
(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args) (cl-defmethod initialize-instance :after ((obj semantic-displayor-tooltip) &rest args)
"Make sure we have tooltips required." "Make sure we have tooltips required."
(condition-case nil (condition-case nil
(require 'tooltip) (require 'tooltip)
@ -1639,12 +1639,12 @@ Display mechanism using tooltip for a list of possible completions.")
(defvar tooltip-mode) (defvar tooltip-mode)
(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip)) (cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
"A request to show the current tags table." "A request to show the current tags table."
(if (or (not (featurep 'tooltip)) (not tooltip-mode)) (if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with ;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer. ;; a traditional completion buffer.
(call-next-method) (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table))) (let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong)) (table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table)) (completions (mapcar semantic-completion-displayor-format-tag-function table))
@ -1752,7 +1752,7 @@ Return a cons cell (X . Y)"
tooltip-frame-parameters) tooltip-frame-parameters)
(tooltip-show text))) (tooltip-show text)))
(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip)) (cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)." "A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip. ;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30) (oset obj max-tags-initial 30)
@ -1778,9 +1778,9 @@ Completion displayor using ghost chars after point for focus options.
Whichever completion is currently in focus will be displayed as ghost Whichever completion is currently in focus will be displayed as ghost
text using overlay options.") text using overlay options.")
(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost)) (cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
"The next action to take on the inline completion related to display." "The next action to take on the inline completion related to display."
(let ((ans (call-next-method)) (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table) (table (when (slot-boundp obj 'table)
(oref obj table)))) (oref obj table))))
(if (and (eq ans 'displayend) (if (and (eq ans 'displayend)
@ -1790,22 +1790,22 @@ text using overlay options.")
nil nil
ans))) ans)))
(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost)) (cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
"Clean up any mess this displayor may have." "Clean up any mess this displayor may have."
(when (slot-boundp obj 'ghostoverlay) (when (slot-boundp obj 'ghostoverlay)
(semantic-overlay-delete (oref obj ghostoverlay))) (semantic-overlay-delete (oref obj ghostoverlay)))
) )
(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost) (cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
table prefix) table prefix)
"Set the list of tags to be completed over to TABLE." "Set the list of tags to be completed over to TABLE."
(call-next-method) (cl-call-next-method)
(semantic-displayor-cleanup obj) (semantic-displayor-cleanup obj)
) )
(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost)) (cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
"A request to show the current tags table." "A request to show the current tags table."
; (if (oref obj first-show) ; (if (oref obj first-show)
; (progn ; (progn
@ -1816,11 +1816,11 @@ text using overlay options.")
;; Only do the traditional thing if the first show request ;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost ;; has been seen. Use the first one to start doing the ghost
;; text display. ;; text display.
; (call-next-method) ; (cl-call-next-method)
; ) ; )
) )
(defmethod semantic-displayor-focus-request (cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost)) ((obj semantic-displayor-ghost))
"Focus in on possible tag completions. "Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible Focus is performed by cycling through the tags and showing a possible

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

@ -224,7 +224,7 @@ warn instead."
() ()
"Search Ebrowse for symbols.") "Search Ebrowse for symbols.")
(defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse)) (cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed. "EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files JAVE: stub for needs-refresh, because, how do we know if BROWSE files
@ -282,7 +282,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
;;; Methods for creating a database or tables ;;; Methods for creating a database or tables
;; ;;
(defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse) (cl-defmethod semanticdb-create-database ((dbeC (subclass semanticdb-project-database-ebrowse))
directory) directory)
"Create a new semantic database for DIRECTORY based on ebrowse. "Create a new semantic database for DIRECTORY based on ebrowse.
If there is no database for DIRECTORY available, then If there is no database for DIRECTORY available, then
@ -325,7 +325,7 @@ If there is no database for DIRECTORY available, then
db))) db)))
(defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse) (cl-defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
data) data)
"For the ebrowse database DBE, strip all tables from DATA." "For the ebrowse database DBE, strip all tables from DATA."
;JAVE what it actually seems to do is split the original tree in "tables" associated with files ;JAVE what it actually seems to do is split the original tree in "tables" associated with files
@ -479,7 +479,7 @@ Optional argument BASECLASSES specifies a baseclass to the tree being provided."
;;; ;;;
;; Overload for converting the simple faux tag into something better. ;; Overload for converting the simple faux tag into something better.
;; ;;
(defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags) (cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
"Convert in Ebrowse database OBJ a list of TAGS into a complete tag. "Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
The default tag provided by searches exclude many features of a The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAGS semantic parsed tag. Look up the file for OBJ, and match TAGS
@ -521,7 +521,7 @@ return that."
(setq tags (cdr tags)))) (setq tags (cdr tags))))
tagret)) tagret))
(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag) (cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
"Convert in Ebrowse database OBJ one TAG into a complete tag. "Convert in Ebrowse database OBJ one TAG into a complete tag.
The default tag provided by searches exclude many features of a The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAG semantic parsed tag. Look up the file for OBJ, and match TAG
@ -569,48 +569,48 @@ return that."
;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining ;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
;; how your new search routines are implemented. ;; how your new search routines are implemented.
;; ;;
(defmethod semanticdb-find-tags-by-name-method (cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags) ((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags named NAME in TABLE. "Find all tags named NAME in TABLE.
Return a list of tags." Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name) ;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
(if tags (if tags
;; If TAGS are passed in, then we don't need to do work here. ;; If TAGS are passed in, then we don't need to do work here.
(call-next-method) (cl-call-next-method)
;; If we ever need to do something special, add here. ;; If we ever need to do something special, add here.
;; Since ebrowse tags are converted into semantic tags, we can ;; Since ebrowse tags are converted into semantic tags, we can
;; get away with this sort of thing. ;; get away with this sort of thing.
(call-next-method) (cl-call-next-method)
) )
) )
(defmethod semanticdb-find-tags-by-name-regexp-method (cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags) ((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
(call-next-method) (cl-call-next-method)
)) ))
(defmethod semanticdb-find-tags-for-completion-method (cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags) ((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
(call-next-method) (cl-call-next-method)
)) ))
(defmethod semanticdb-find-tags-by-class-method (cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-ebrowse) class &optional tags) ((table semanticdb-table-ebrowse) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS. "In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
(call-next-method))) (cl-call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -621,38 +621,38 @@ Returns a table of all matching tags."
;; above. ;; above.
;; ;;
(defmethod semanticdb-deep-find-tags-by-name-method (cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags) ((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags name NAME in TABLE. "Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse." Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-method table name tags) ;;(semanticdb-find-tags-by-name-method table name tags)
(call-next-method)) (cl-call-next-method))
(defmethod semanticdb-deep-find-tags-by-name-regexp-method (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags) ((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse." Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-regexp-method table regex tags) ;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
(call-next-method)) (cl-call-next-method))
(defmethod semanticdb-deep-find-tags-for-completion-method (cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags) ((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse." Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;(semanticdb-find-tags-for-completion-method table prefix tags) ;;(semanticdb-find-tags-for-completion-method table prefix tags)
(call-next-method)) (cl-call-next-method))
;;; Advanced Searches ;;; Advanced Searches
;; ;;
(defmethod semanticdb-find-tags-external-children-of-type-method (cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-ebrowse) type &optional tags) ((table semanticdb-table-ebrowse) type &optional tags)
"Find all nonterminals which are child elements of TYPE "Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; Ebrowse collects all this type of stuff together for us. ;; Ebrowse collects all this type of stuff together for us.
;; but we can't use it.... yet. ;; but we can't use it.... yet.
nil nil

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

@ -44,16 +44,16 @@
) )
"A table for returning search results from Emacs.") "A table for returning search results from Emacs.")
(defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force) (cl-defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
"Do not refresh Emacs Lisp table. "Do not refresh Emacs Lisp table.
It does not need refreshing." It does not need refreshing."
nil) nil)
(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp)) (cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
"Return nil, we never need a refresh." "Return nil, we never need a refresh."
nil) nil)
(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings) (cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'. "Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings))) (apply 'call-next-method obj (cons " (proxy)" strings)))
@ -67,7 +67,7 @@ Adds the number of tags in this file to the object print name."
) )
"Database representing Emacs core.") "Database representing Emacs core.")
(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings) (cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'. "Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(let ((count 0)) (let ((count 0))
@ -90,7 +90,7 @@ the omniscience database.")
;;; Filename based methods ;;; Filename based methods
;; ;;
(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp)) (cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
"For an Emacs Lisp database, there are no explicit tables. "For an Emacs Lisp database, there are no explicit tables.
Create one of our special tables that can act as an intermediary." Create one of our special tables that can act as an intermediary."
;; We need to return something since there is always the "master table" ;; We need to return something since there is always the "master table"
@ -101,34 +101,34 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj) (oset newtable parent-db obj)
(oset newtable tags nil) (oset newtable tags nil)
)) ))
(call-next-method)) (cl-call-next-method))
(defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename) (cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
"From OBJ, return FILENAME's associated table object. "From OBJ, return FILENAME's associated table object.
For Emacs Lisp, creates a specialized table." For Emacs Lisp, creates a specialized table."
(car (semanticdb-get-database-tables obj)) (car (semanticdb-get-database-tables obj))
) )
(defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp )) (cl-defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
"Return the list of tags belonging to TABLE." "Return the list of tags belonging to TABLE."
;; specialty table ? Probably derive tags at request time. ;; specialty table ? Probably derive tags at request time.
nil) nil)
(defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER. "Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes' Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable." local variable."
(with-current-buffer buffer (with-current-buffer buffer
(eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode))) (eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
(defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp)) (cl-defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
"Fetch the full filename that OBJ refers to. "Fetch the full filename that OBJ refers to.
For Emacs Lisp system DB, there isn't one." For Emacs Lisp system DB, there isn't one."
nil) nil)
;;; Conversion ;;; Conversion
;; ;;
(defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags) (cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
"Convert tags, originating from Emacs OBJ, into standardized form." "Convert tags, originating from Emacs OBJ, into standardized form."
(let ((newtags nil)) (let ((newtags nil))
(dolist (T tags) (dolist (T tags)
@ -138,7 +138,7 @@ For Emacs Lisp system DB, there isn't one."
;; There is no promise to have files associated. ;; There is no promise to have files associated.
(nreverse newtags))) (nreverse newtags)))
(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag) (cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
"Convert one TAG, originating from Emacs OBJ, into standardized form. "Convert one TAG, originating from Emacs OBJ, into standardized form.
If Emacs cannot resolve this symbol to a particular file, then return nil." If Emacs cannot resolve this symbol to a particular file, then return nil."
;; Here's the idea. For each tag, get the name, then use ;; Here's the idea. For each tag, get the name, then use
@ -245,12 +245,12 @@ TOKTYPE is a hint to the type of tag desired."
(defvar semanticdb-elisp-mapatom-collector nil (defvar semanticdb-elisp-mapatom-collector nil
"Variable used to collect `mapatoms' output.") "Variable used to collect `mapatoms' output.")
(defmethod semanticdb-find-tags-by-name-method (cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags) ((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags named NAME in TABLE. "Find all tags named NAME in TABLE.
Uses `intern-soft' to match NAME to Emacs symbols. Uses `intern-soft' to match NAME to Emacs symbols.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; No need to search. Use `intern-soft' which does the same thing for us. ;; No need to search. Use `intern-soft' which does the same thing for us.
(let* ((sym (intern-soft name)) (let* ((sym (intern-soft name))
(fun (semanticdb-elisp-sym->tag sym 'function)) (fun (semanticdb-elisp-sym->tag sym 'function))
@ -266,52 +266,52 @@ Return a list of tags."
taglst taglst
)))) ))))
(defmethod semanticdb-find-tags-by-name-regexp-method (cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags) ((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Uses `apropos-internal' to find matches. Uses `apropos-internal' to find matches.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag (delq nil (mapcar 'semanticdb-elisp-sym->tag
(apropos-internal regex))))) (apropos-internal regex)))))
(defmethod semanticdb-find-tags-for-completion-method (cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags) ((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag (delq nil (mapcar 'semanticdb-elisp-sym->tag
(all-completions prefix obarray))))) (all-completions prefix obarray)))))
(defmethod semanticdb-find-tags-by-class-method (cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-emacs-lisp) class &optional tags) ((table semanticdb-table-emacs-lisp) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS. "In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; We could implement this, but it could be messy. ;; We could implement this, but it could be messy.
nil)) nil))
;;; Deep Searches ;;; Deep Searches
;; ;;
;; For Emacs Lisp deep searches are like top level searches. ;; For Emacs Lisp deep searches are like top level searches.
(defmethod semanticdb-deep-find-tags-by-name-method (cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags) ((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags name NAME in TABLE. "Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp." Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-method table name tags)) (semanticdb-find-tags-by-name-method table name tags))
(defmethod semanticdb-deep-find-tags-by-name-regexp-method (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags) ((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp." Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-regexp-method table regex tags)) (semanticdb-find-tags-by-name-regexp-method table regex tags))
(defmethod semanticdb-deep-find-tags-for-completion-method (cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags) ((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
@ -320,12 +320,12 @@ Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp."
;;; Advanced Searches ;;; Advanced Searches
;; ;;
(defmethod semanticdb-find-tags-external-children-of-type-method (cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-emacs-lisp) type &optional tags) ((table semanticdb-table-emacs-lisp) type &optional tags)
"Find all nonterminals which are child elements of TYPE "Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; EIEIO is the only time this matters ;; EIEIO is the only time this matters
(when (featurep 'eieio) (when (featurep 'eieio)
(let* ((class (intern-soft type)) (let* ((class (intern-soft type))

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

@ -123,7 +123,7 @@ To save the version number, we must hand-set this version string.")
;;; Code: ;;; Code:
;; ;;
(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file) (cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database-file))
directory) directory)
"Create a new semantic database for DIRECTORY and return it. "Create a new semantic database for DIRECTORY and return it.
If a database for DIRECTORY has already been loaded, return it. If a database for DIRECTORY has already been loaded, return it.
@ -197,7 +197,7 @@ If DIRECTORY doesn't exist, create a new one."
"Return the project belonging to FILENAME if it was already loaded." "Return the project belonging to FILENAME if it was already loaded."
(eieio-instance-tracker-find filename 'file 'semanticdb-database-list)) (eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
(defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file) (cl-defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
&optional suppress-questions) &optional suppress-questions)
"Does the directory the database DB needs to write to exist? "Does the directory the database DB needs to write to exist?
If SUPPRESS-QUESTIONS, then do not ask to create the directory." If SUPPRESS-QUESTIONS, then do not ask to create the directory."
@ -219,7 +219,7 @@ If SUPPRESS-QUESTIONS, then do not ask to create the directory."
(setq semanticdb--inhibit-make-directory t)) (setq semanticdb--inhibit-make-directory t))
nil)))) nil))))
(defmethod semanticdb-save-db ((DB semanticdb-project-database-file) (cl-defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
&optional &optional
suppress-questions) suppress-questions)
"Write out the database DB to its file. "Write out the database DB to its file.
@ -259,13 +259,13 @@ If DB is not specified, then use the current database."
) )
)) ))
(defmethod semanticdb-live-p ((obj semanticdb-project-database)) (cl-defmethod semanticdb-live-p ((obj semanticdb-project-database))
"Return non-nil if the file associated with OBJ is live. "Return non-nil if the file associated with OBJ is live.
Live databases are objects associated with existing directories." Live databases are objects associated with existing directories."
(and (slot-boundp obj 'reference-directory) (and (slot-boundp obj 'reference-directory)
(file-exists-p (oref obj reference-directory)))) (file-exists-p (oref obj reference-directory))))
(defmethod semanticdb-live-p ((obj semanticdb-table)) (cl-defmethod semanticdb-live-p ((obj semanticdb-table))
"Return non-nil if the file associated with OBJ is live. "Return non-nil if the file associated with OBJ is live.
Live files are either buffers in Emacs, or files existing on the filesystem." Live files are either buffers in Emacs, or files existing on the filesystem."
(let ((full-filename (semanticdb-full-filename obj))) (let ((full-filename (semanticdb-full-filename obj)))
@ -279,7 +279,7 @@ to prevent overload.")
(declare-function data-debug-insert-thing "data-debug") (declare-function data-debug-insert-thing "data-debug")
(defmethod object-write ((obj semanticdb-table)) (cl-defmethod object-write ((obj semanticdb-table))
"When writing a table, we have to make sure we deoverlay it first. "When writing a table, we have to make sure we deoverlay it first.
Restore the overlays after writing. Restore the overlays after writing.
Argument OBJ is the object to write." Argument OBJ is the object to write."
@ -312,7 +312,7 @@ Argument OBJ is the object to write."
;; Do it! ;; Do it!
(condition-case tableerror (condition-case tableerror
(call-next-method) (cl-call-next-method)
(error (error
(when semanticdb-data-debug-on-write-error (when semanticdb-data-debug-on-write-error
(require 'data-debug) (require 'data-debug)
@ -328,7 +328,7 @@ Argument OBJ is the object to write."
;;; State queries ;;; State queries
;; ;;
(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file)) (cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
"Return non-nil if OBJ should be written to disk. "Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value." Uses `semanticdb-persistent-path' to determine the return value."
(let ((path semanticdb-persistent-path)) (let ((path semanticdb-persistent-path))
@ -360,25 +360,25 @@ Uses `semanticdb-persistent-path' to determine the return value."
(throw 'found t)) (throw 'found t))
(t (error "Invalid path %S" (car path)))) (t (error "Invalid path %S" (car path))))
(setq path (cdr path))) (setq path (cdr path)))
(call-next-method)) (cl-call-next-method))
)) ))
;;; Filename manipulation ;;; Filename manipulation
;; ;;
(defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename) (cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
"From OBJ, return FILENAME's associated table object." "From OBJ, return FILENAME's associated table object."
;; Cheater option. In this case, we always have files directly ;; Cheater option. In this case, we always have files directly
;; under ourselves. The main project type may not. ;; under ourselves. The main project type may not.
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables))) (object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
(defmethod semanticdb-file-name-non-directory :STATIC (cl-defmethod semanticdb-file-name-non-directory
((dbclass semanticdb-project-database-file)) ((dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use. "Return the file name DBCLASS will use.
File name excludes any directory part." File name excludes any directory part."
semanticdb-default-file-name) semanticdb-default-file-name)
(defmethod semanticdb-file-name-directory :STATIC (cl-defmethod semanticdb-file-name-directory
((dbclass semanticdb-project-database-file) directory) ((dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file. "Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY." The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory (if semanticdb-default-save-directory
@ -389,8 +389,8 @@ The returned path is related to DIRECTORY."
file (file-name-as-directory semanticdb-default-save-directory))) file (file-name-as-directory semanticdb-default-save-directory)))
directory)) directory))
(defmethod semanticdb-cache-filename :STATIC (cl-defmethod semanticdb-cache-filename
((dbclass semanticdb-project-database-file) path) ((dbclass (subclass semanticdb-project-database-file)) path)
"For DBCLASS, return a file to a cache file belonging to PATH. "For DBCLASS, return a file to a cache file belonging to PATH.
This could be a cache file in the current directory, or an encoded file This could be a cache file in the current directory, or an encoded file
name in a secondary directory." name in a secondary directory."
@ -399,7 +399,7 @@ name in a secondary directory."
(concat (semanticdb-file-name-directory dbclass path) (concat (semanticdb-file-name-directory dbclass path)
(semanticdb-file-name-non-directory dbclass))) (semanticdb-file-name-non-directory dbclass)))
(defmethod semanticdb-full-filename ((obj semanticdb-project-database-file)) (cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
"Fetch the full filename that OBJ refers to." "Fetch the full filename that OBJ refers to."
(oref obj file)) (oref obj file))

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

@ -196,7 +196,7 @@ expunge duplicates.")
"Concrete search index for `semanticdb-find'. "Concrete search index for `semanticdb-find'.
This class will cache data derived during various searches.") This class will cache data derived during various searches.")
(defmethod semantic-reset ((idx semanticdb-find-search-index)) (cl-defmethod semantic-reset ((idx semanticdb-find-search-index))
"Reset the object IDX." "Reset the object IDX."
(require 'semantic/scope) (require 'semantic/scope)
;; Clear the include path. ;; Clear the include path.
@ -208,7 +208,7 @@ This class will cache data derived during various searches.")
(semantic-scope-reset-cache) (semantic-scope-reset-cache)
) )
(defmethod semanticdb-synchronize ((idx semanticdb-find-search-index) (cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags) new-tags)
"Synchronize the search index IDX with some NEW-TAGS." "Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts. ;; Reset our parts.
@ -220,7 +220,7 @@ This class will cache data derived during various searches.")
(semantic-reset (semanticdb-get-table-index tab)))) (semantic-reset (semanticdb-get-table-index tab))))
) )
(defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index) (cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
new-tags) new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS." "Synchronize the search index IDX with some changed NEW-TAGS."
;; Only reset if include statements changed. ;; Only reset if include statements changed.
@ -1304,25 +1304,25 @@ associated with that tag should be loaded into a buffer."
;; Override these with system databases to as new types of back ends. ;; Override these with system databases to as new types of back ends.
;;; Top level Searches ;;; Top level Searches
(defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags) (cl-defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME. "In TABLE, find all occurrences of tags with NAME.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(semantic-find-tags-by-name name (or tags (semanticdb-get-tags table)))) (semantic-find-tags-by-name name (or tags (semanticdb-get-tags table))))
(defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags) (cl-defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP. "In TABLE, find all occurrences of tags matching REGEXP.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table)))) (semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table))))
(defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags) (cl-defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table)))) (semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table))))
(defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags) (cl-defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS. "In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
@ -1333,14 +1333,14 @@ Returns a table of all matching tags."
(semantic-find-tags-included (or tags (semanticdb-get-tags table))) (semantic-find-tags-included (or tags (semanticdb-get-tags table)))
(semantic-find-tags-by-class class (or tags (semanticdb-get-tags table))))) (semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))))
(defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags) (cl-defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type. "In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(require 'semantic/find) (require 'semantic/find)
(semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table)))) (semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table))))
(defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags) (cl-defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type. "In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
@ -1348,7 +1348,7 @@ Returns a table of all matching tags."
(semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table)))) (semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table))))
;;; Deep Searches ;;; Deep Searches
(defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags) (cl-defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME. "In TABLE, find all occurrences of tags with NAME.
Search in all tags in TABLE, and all components of top level tags in Search in all tags in TABLE, and all components of top level tags in
TABLE. TABLE.
@ -1356,7 +1356,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags." Return a table of all matching tags."
(semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table))))) (semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
(defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags) (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP. "In TABLE, find all occurrences of tags matching REGEXP.
Search in all tags in TABLE, and all components of top level tags in Search in all tags in TABLE, and all components of top level tags in
TABLE. TABLE.
@ -1364,7 +1364,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags." Return a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table))))) (semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
(defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags) (cl-defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Search in all tags in TABLE, and all components of top level tags in Search in all tags in TABLE, and all components of top level tags in
TABLE. TABLE.

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

@ -112,12 +112,12 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
) )
"A table for returning search results from GNU Global.") "A table for returning search results from GNU Global.")
(defmethod object-print ((obj semanticdb-table-global) &rest strings) (cl-defmethod object-print ((obj semanticdb-table-global) &rest strings)
"Pretty printer extension for `semanticdb-table-global'. "Pretty printer extension for `semanticdb-table-global'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings))) (apply 'call-next-method obj (cons " (proxy)" strings)))
(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER. "Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes' Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable." local variable."
@ -126,7 +126,7 @@ local variable."
;;; Filename based methods ;;; Filename based methods
;; ;;
(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global)) (cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
"For a global database, there are no explicit tables. "For a global database, there are no explicit tables.
For each file hit, get the traditional semantic table from that file." For each file hit, get the traditional semantic table from that file."
;; We need to return something since there is always the "master table" ;; We need to return something since there is always the "master table"
@ -138,9 +138,9 @@ For each file hit, get the traditional semantic table from that file."
(oset newtable tags nil) (oset newtable tags nil)
)) ))
(call-next-method)) (cl-call-next-method))
(defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename) (cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
"From OBJ, return FILENAME's associated table object." "From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not? ;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj)) (car (semanticdb-get-database-tables obj))
@ -150,13 +150,13 @@ For each file hit, get the traditional semantic table from that file."
;; ;;
;; Only NAME based searches work with GLOBAL as that is all it tracks. ;; Only NAME based searches work with GLOBAL as that is all it tracks.
;; ;;
(defmethod semanticdb-find-tags-by-name-method (cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags) ((table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE. "Find all tags named NAME in TABLE.
Return a list of tags." Return a list of tags."
(if tags (if tags
;; If TAGS are passed in, then we don't need to do work here. ;; If TAGS are passed in, then we don't need to do work here.
(call-next-method) (cl-call-next-method)
;; Call out to GNU Global for some results. ;; Call out to GNU Global for some results.
(let* ((semantic-symref-tool 'global) (let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-name name 'project)) (result (semantic-symref-find-tags-by-name name 'project))
@ -167,12 +167,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result)) (semantic-symref-result-get-tags result))
))) )))
(defmethod semanticdb-find-tags-by-name-regexp-method (cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags) ((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global) (let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project)) (result (semantic-symref-find-tags-by-regexp regex 'project))
) )
@ -180,12 +180,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result)) (semantic-symref-result-get-tags result))
))) )))
(defmethod semanticdb-find-tags-for-completion-method (cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags) ((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global) (let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-completion prefix 'project)) (result (semantic-symref-find-tags-by-completion prefix 'project))
(faketags nil) (faketags nil)
@ -206,21 +206,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those ;; alone, otherwise replace with implementations similar to those
;; above. ;; above.
;; ;;
(defmethod semanticdb-deep-find-tags-by-name-method (cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags) ((table semanticdb-table-global) name &optional tags)
"Find all tags name NAME in TABLE. "Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global." Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-method table name tags)) (semanticdb-find-tags-by-name-method table name tags))
(defmethod semanticdb-deep-find-tags-by-name-regexp-method (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags) ((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global." Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-regexp-method table regex tags)) (semanticdb-find-tags-by-name-regexp-method table regex tags))
(defmethod semanticdb-deep-find-tags-for-completion-method (cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags) ((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.

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

@ -111,7 +111,7 @@ the omniscience database.")
;;; Filename based methods ;;; Filename based methods
;; ;;
(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript)) (cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
"For a javascript database, there are no explicit tables. "For a javascript database, there are no explicit tables.
Create one of our special tables that can act as an intermediary." Create one of our special tables that can act as an intermediary."
;; NOTE: This method overrides an accessor for the `tables' slot in ;; NOTE: This method overrides an accessor for the `tables' slot in
@ -126,23 +126,23 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj) (oset newtable parent-db obj)
(oset newtable tags nil) (oset newtable tags nil)
)) ))
(call-next-method) (cl-call-next-method)
) )
(defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename) (cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
"From OBJ, return FILENAME's associated table object." "From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'. ;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj)) (car (semanticdb-get-database-tables obj))
) )
(defmethod semanticdb-get-tags ((table semanticdb-table-javascript )) (cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE." "Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables ;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and ;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something. ;; refer to alternate databases when you need something.
semanticdb-javascript-tags) semanticdb-javascript-tags)
(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER. "Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes' Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable." local variable."
@ -192,43 +192,43 @@ database (if available.)"
(setq tags (cdr tags))) (setq tags (cdr tags)))
result)) result))
(defmethod semanticdb-find-tags-by-name-method (cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags) ((table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE. "Find all tags named NAME in TABLE.
Return a list of tags." Return a list of tags."
(if tags (if tags
;; If TAGS are passed in, then we don't need to do work here. ;; If TAGS are passed in, then we don't need to do work here.
(call-next-method) (cl-call-next-method)
(assoc-string name semanticdb-javascript-tags) (assoc-string name semanticdb-javascript-tags)
)) ))
(defmethod semanticdb-find-tags-by-name-regexp-method (cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags) ((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search regex) (semanticdb-javascript-regexp-search regex)
)) ))
(defmethod semanticdb-find-tags-for-completion-method (cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags) ((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search (concat "^" prefix ".*")) (semanticdb-javascript-regexp-search (concat "^" prefix ".*"))
)) ))
(defmethod semanticdb-find-tags-by-class-method (cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-javascript) class &optional tags) ((table semanticdb-table-javascript) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS. "In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags." Returns a table of all matching tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
;; ;;
;; Note: This search method could be considered optional in an ;; Note: This search method could be considered optional in an
@ -244,21 +244,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those ;; alone, otherwise replace with implementations similar to those
;; above. ;; above.
;; ;;
(defmethod semanticdb-deep-find-tags-by-name-method (cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags) ((table semanticdb-table-javascript) name &optional tags)
"Find all tags name NAME in TABLE. "Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript." Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-method table name tags)) (semanticdb-find-tags-by-name-method table name tags))
(defmethod semanticdb-deep-find-tags-by-name-regexp-method (cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags) ((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE. "Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript." Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-regexp-method table regex tags)) (semanticdb-find-tags-by-name-regexp-method table regex tags))
(defmethod semanticdb-deep-find-tags-for-completion-method (cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags) ((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX. "In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
@ -267,12 +267,12 @@ Like `semanticdb-find-tags-for-completion-method' for javascript."
;;; Advanced Searches ;;; Advanced Searches
;; ;;
(defmethod semanticdb-find-tags-external-children-of-type-method (cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-javascript) type &optional tags) ((table semanticdb-table-javascript) type &optional tags)
"Find all nonterminals which are child elements of TYPE. "Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search. Optional argument TAGS is a list of tags to search.
Return a list of tags." Return a list of tags."
(if tags (call-next-method) (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE ;; YOUR IMPLEMENTATION HERE
;; ;;
;; OPTIONAL: This could be considered an optional function. It is ;; OPTIONAL: This could be considered an optional function. It is

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

@ -37,6 +37,7 @@
;;; Code: ;;; Code:
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'semantic) (require 'semantic)
(require 'semantic/db) (require 'semantic/db)
(require 'semantic/tag) (require 'semantic/tag)
@ -44,7 +45,7 @@
;; For the semantic-find-tags-by-name-regexp macro. ;; For the semantic-find-tags-by-name-regexp macro.
(eval-when-compile (require 'semantic/find)) (eval-when-compile (require 'semantic/find))
(defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table) (cl-defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
include-tag) include-tag)
"Add a reference for the database table DBT based on INCLUDE-TAG. "Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG. The reference DBT is the database table that owns the INCLUDE-TAG. The reference
@ -66,18 +67,18 @@ will be added to the database that INCLUDE-TAG refers to."
(object-add-to-list refdbt 'db-refs dbt) (object-add-to-list refdbt 'db-refs dbt)
t))) t)))
(defmethod semanticdb-check-references ((dbt semanticdb-abstract-table)) (cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT. "Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference." Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references. ;; Not sure how an abstract table can have references.
nil) nil)
(defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table)) (cl-defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
"Return a list of direct includes in table DBT." "Return a list of direct includes in table DBT."
(semantic-find-tags-by-class 'include (semanticdb-get-tags dbt))) (semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))
(defmethod semanticdb-check-references ((dbt semanticdb-table)) (cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
"Check and cleanup references in the database DBT. "Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whos file no longer Any reference to a file that cannot be found, or whos file no longer
refers to DBT will be removed." refers to DBT will be removed."
@ -108,13 +109,13 @@ refers to DBT will be removed."
)) ))
(setq refs (cdr refs))))) (setq refs (cdr refs)))))
(defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table)) (cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
"Refresh references to DBT in other files." "Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed. ;; alternate tables can't be edited, so can't be changed.
nil nil
) )
(defmethod semanticdb-refresh-references ((dbt semanticdb-table)) (cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
"Refresh references to DBT in other files." "Refresh references to DBT in other files."
(let ((refs (semanticdb-includes-in-table dbt)) (let ((refs (semanticdb-includes-in-table dbt))
) )
@ -127,7 +128,7 @@ refers to DBT will be removed."
(setq refs (cdr refs))) (setq refs (cdr refs)))
)) ))
(defmethod semanticdb-notify-references ((dbt semanticdb-table) (cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
method) method)
"Notify all references of the table DBT using method. "Notify all references of the table DBT using method.
METHOD takes two arguments. METHOD takes two arguments.

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

@ -67,7 +67,7 @@ Said object must support `semantic-reset' methods.")
) )
"Structure for maintaining a typecache.") "Structure for maintaining a typecache.")
(defmethod semantic-reset ((tc semanticdb-typecache)) (cl-defmethod semantic-reset ((tc semanticdb-typecache))
"Reset the object IDX." "Reset the object IDX."
(oset tc filestream nil) (oset tc filestream nil)
(oset tc includestream nil) (oset tc includestream nil)
@ -78,14 +78,14 @@ Said object must support `semantic-reset' methods.")
(oset tc dependants nil) (oset tc dependants nil)
) )
(defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache)) (cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on." "Do a reset from a notify from a table we depend on."
(oset tc includestream nil) (oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants)) (mapc 'semantic-reset (oref tc dependants))
(oset tc dependants nil) (oset tc dependants nil)
) )
(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache) (cl-defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
new-tags) new-tags)
"Reset the typecache based on a partial reparse." "Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags) (when (semantic-find-tags-by-class 'include new-tags)
@ -125,7 +125,7 @@ Debugging function."
(t -1) )) (t -1) ))
(defmethod semanticdb-get-typecache ((table semanticdb-abstract-table)) (cl-defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
"Retrieve the typecache from the semanticdb TABLE. "Retrieve the typecache from the semanticdb TABLE.
If there is no table, create one, and fill it in." If there is no table, create one, and fill it in."
(semanticdb-refresh-table table) (semanticdb-refresh-table table)
@ -141,7 +141,7 @@ If there is no table, create one, and fill it in."
cache)) cache))
(defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table)) (cl-defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
"Return non-nil (the typecache) if TABLE has a pre-calculated typecache." "Return non-nil (the typecache) if TABLE has a pre-calculated typecache."
(let* ((idx (semanticdb-get-table-index table))) (let* ((idx (semanticdb-get-table-index table)))
(oref idx type-cache))) (oref idx type-cache)))
@ -162,22 +162,22 @@ If there is no table, create one, and fill it in."
) )
"Structure for maintaining a typecache.") "Structure for maintaining a typecache.")
(defmethod semantic-reset ((tc semanticdb-database-typecache)) (cl-defmethod semantic-reset ((tc semanticdb-database-typecache))
"Reset the object IDX." "Reset the object IDX."
(oset tc stream nil) (oset tc stream nil)
) )
(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache) (cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
new-tags) new-tags)
"Synchronize a CACHE with some NEW-TAGS." "Synchronize a CACHE with some NEW-TAGS."
) )
(defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache) (cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
new-tags) new-tags)
"Synchronize a CACHE with some changed NEW-TAGS." "Synchronize a CACHE with some changed NEW-TAGS."
) )
(defmethod semanticdb-get-typecache ((db semanticdb-project-database)) (cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB. "Retrieve the typecache from the semantic database DB.
If there is no table, create one, and fill it in." If there is no table, create one, and fill it in."
(semanticdb-cache-get db 'semanticdb-database-typecache) (semanticdb-cache-get db 'semanticdb-database-typecache)
@ -312,11 +312,11 @@ If TAG has fully qualified names, expand it to a series of nested
namespaces instead." namespaces instead."
tag) tag)
(defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table)) (cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables." "No tags available from non-file based tables."
nil) nil)
(defmethod semanticdb-typecache-file-tags ((table semanticdb-table)) (cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the file-tags. "Update the typecache for TABLE, and return the file-tags.
File-tags are those that belong to this file only, and excludes File-tags are those that belong to this file only, and excludes
all included files." all included files."
@ -338,11 +338,11 @@ all included files."
(oref cache filestream) (oref cache filestream)
)) ))
(defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table)) (cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables." "No tags available from non-file based tables."
nil) nil)
(defmethod semanticdb-typecache-include-tags ((table semanticdb-table)) (cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the merged types from the include tags. "Update the typecache for TABLE, and return the merged types from the include tags.
Include-tags are the tags brought in via includes, all merged together into Include-tags are the tags brought in via includes, all merged together into
a master list." a master list."
@ -418,7 +418,7 @@ is of class 'type."
(types (semantic-find-tags-by-class 'type nmerge))) (types (semantic-find-tags-by-class 'type nmerge)))
(or (car-safe types) (car-safe nmerge)))) (or (car-safe types) (car-safe nmerge))))
(defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table) (cl-defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
type find-file-match) type find-file-match)
"Search the typecache in TABLE for the datatype TYPE. "Search the typecache in TABLE for the datatype TYPE.
If type is a string, split the string, and search for the parts. If type is a string, split the string, and search for the parts.
@ -544,7 +544,7 @@ found tag to be loaded."
;; ;;
;; Routines for a typecache that crosses all tables in a given database ;; Routines for a typecache that crosses all tables in a given database
;; for a matching major-mode. ;; for a matching major-mode.
(defmethod semanticdb-typecache-for-database ((db semanticdb-project-database) (cl-defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
&optional mode) &optional mode)
"Return the typecache for the project database DB. "Return the typecache for the project database DB.
If there isn't one, create it. If there isn't one, create it.

90
lisp/cedet/semantic/db.el
View file

@ -115,11 +115,11 @@ This table is the root of tables, and contains the minimum needed
for a new table not associated with a buffer." for a new table not associated with a buffer."
:abstract t) :abstract t)
(defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
"Return a nil, meaning abstract table OBJ is not in a buffer." "Return a nil, meaning abstract table OBJ is not in a buffer."
nil) nil)
(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
"Return a buffer associated with OBJ. "Return a buffer associated with OBJ.
If the buffer is not in memory, load it with `find-file-noselect'." If the buffer is not in memory, load it with `find-file-noselect'."
nil) nil)
@ -127,7 +127,7 @@ If the buffer is not in memory, load it with `find-file-noselect'."
;; This generic method allows for sloppier coding. Many ;; This generic method allows for sloppier coding. Many
;; functions treat "table" as something that could be a buffer, ;; functions treat "table" as something that could be a buffer,
;; file name, or other. This makes use of table more robust. ;; file name, or other. This makes use of table more robust.
(defmethod semanticdb-full-filename (buffer-or-string) (cl-defmethod semanticdb-full-filename (buffer-or-string)
"Fetch the full filename that BUFFER-OR-STRING refers to. "Fetch the full filename that BUFFER-OR-STRING refers to.
This uses semanticdb to get a better file name." This uses semanticdb to get a better file name."
(cond ((bufferp buffer-or-string) (cond ((bufferp buffer-or-string)
@ -136,23 +136,23 @@ This uses semanticdb to get a better file name."
((and (stringp buffer-or-string) (file-exists-p buffer-or-string)) ((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
(expand-file-name buffer-or-string)))) (expand-file-name buffer-or-string))))
(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
"Fetch the full filename that OBJ refers to. "Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them." Abstract tables do not have file names associated with them."
nil) nil)
(defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
"Return non-nil if OBJ is 'dirty'." "Return non-nil if OBJ is 'dirty'."
nil) nil)
(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
"Mark the abstract table OBJ dirty. "Mark the abstract table OBJ dirty.
Abstract tables can not be marked dirty, as there is nothing Abstract tables can not be marked dirty, as there is nothing
for them to synchronize against." for them to synchronize against."
;; The abstract table can not be dirty. ;; The abstract table can not be dirty.
nil) nil)
(defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags) (cl-defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
"For the table OBJ, convert a list of TAGS, into standardized form. "For the table OBJ, convert a list of TAGS, into standardized form.
The default is to return TAGS. The default is to return TAGS.
Some databases may default to searching and providing simplified tags Some databases may default to searching and providing simplified tags
@ -160,7 +160,7 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form." them to convert TAG into a more complete form."
tags) tags)
(defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag) (cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
"For the table OBJ, convert a TAG, into standardized form. "For the table OBJ, convert a TAG, into standardized form.
This method returns a list of the form (DATABASE . NEWTAG). This method returns a list of the form (DATABASE . NEWTAG).
@ -171,14 +171,14 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form." them to convert TAG into a more complete form."
(cons obj tag)) (cons obj tag))
(defmethod object-print ((obj semanticdb-abstract-table) &rest strings) (cl-defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
"Pretty printer extension for `semanticdb-abstract-table'. "Pretty printer extension for `semanticdb-abstract-table'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(if (or (not strings) (if (or (not strings)
(and (= (length strings) 1) (stringp (car strings)) (and (= (length strings) 1) (stringp (car strings))
(string= (car strings) ""))) (string= (car strings) "")))
;; Else, add a tags quantifier. ;; Else, add a tags quantifier.
(call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj)))) (cl-call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
;; Pass through. ;; Pass through.
(apply 'call-next-method obj strings) (apply 'call-next-method obj strings)
)) ))
@ -195,7 +195,7 @@ The search index will store data about which other tables might be
needed, or perhaps create hash or index tables for the current buffer." needed, or perhaps create hash or index tables for the current buffer."
:abstract t) :abstract t)
(defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table)) (cl-defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
"Return the search index for the table OBJ. "Return the search index for the table OBJ.
If one doesn't exist, create it." If one doesn't exist, create it."
(if (slot-boundp obj 'index) (if (slot-boundp obj 'index)
@ -209,13 +209,13 @@ If one doesn't exist, create it."
(oset obj index idx) (oset obj index idx)
idx))) idx)))
(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index) (cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
new-tags) new-tags)
"Synchronize the search index IDX with some NEW-TAGS." "Synchronize the search index IDX with some NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
) )
(defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index) (cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
new-tags) new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS." "Synchronize the search index IDX with some changed NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
@ -233,7 +233,7 @@ If one doesn't exist, create it."
Examples include search results from external sources such as from Examples include search results from external sources such as from
Emacs's own symbol table, or from external libraries.") Emacs's own symbol table, or from external libraries.")
(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force) (cl-defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it. "If the tag list associated with OBJ is loaded, refresh it.
This will call `semantic-fetch-tags' if that file is in memory." This will call `semantic-fetch-tags' if that file is in memory."
nil) nil)
@ -285,7 +285,7 @@ For C/C++, the C preprocessor macros can be saved here.")
) )
"A single table of tags derived from file.") "A single table of tags derived from file.")
(defmethod semanticdb-in-buffer-p ((obj semanticdb-table)) (cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
"Return a buffer associated with OBJ. "Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer." If the buffer is in memory, return that buffer."
(let ((buff (oref obj buffer))) (let ((buff (oref obj buffer)))
@ -293,7 +293,7 @@ If the buffer is in memory, return that buffer."
buff buff
(oset obj buffer nil)))) (oset obj buffer nil))))
(defmethod semanticdb-get-buffer ((obj semanticdb-table)) (cl-defmethod semanticdb-get-buffer ((obj semanticdb-table))
"Return a buffer associated with OBJ. "Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer. If the buffer is in memory, return that buffer.
If the buffer is not in memory, load it with `find-file-noselect'." If the buffer is not in memory, load it with `find-file-noselect'."
@ -302,26 +302,26 @@ If the buffer is not in memory, load it with `find-file-noselect'."
(save-match-data (save-match-data
(find-file-noselect (semanticdb-full-filename obj) t)))) (find-file-noselect (semanticdb-full-filename obj) t))))
(defmethod semanticdb-set-buffer ((obj semanticdb-table)) (cl-defmethod semanticdb-set-buffer ((obj semanticdb-table))
"Set the current buffer to be a buffer owned by OBJ. "Set the current buffer to be a buffer owned by OBJ.
If OBJ's file is not loaded, read it in first." If OBJ's file is not loaded, read it in first."
(set-buffer (semanticdb-get-buffer obj))) (set-buffer (semanticdb-get-buffer obj)))
(defmethod semanticdb-full-filename ((obj semanticdb-table)) (cl-defmethod semanticdb-full-filename ((obj semanticdb-table))
"Fetch the full filename that OBJ refers to." "Fetch the full filename that OBJ refers to."
(expand-file-name (oref obj file) (expand-file-name (oref obj file)
(oref (oref obj parent-db) reference-directory))) (oref (oref obj parent-db) reference-directory)))
(defmethod semanticdb-dirty-p ((obj semanticdb-table)) (cl-defmethod semanticdb-dirty-p ((obj semanticdb-table))
"Return non-nil if OBJ is 'dirty'." "Return non-nil if OBJ is 'dirty'."
(oref obj dirty)) (oref obj dirty))
(defmethod semanticdb-set-dirty ((obj semanticdb-table)) (cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
"Mark the abstract table OBJ dirty." "Mark the abstract table OBJ dirty."
(oset obj dirty t) (oset obj dirty t)
) )
(defmethod object-print ((obj semanticdb-table) &rest strings) (cl-defmethod object-print ((obj semanticdb-table) &rest strings)
"Pretty printer extension for `semanticdb-table'. "Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (apply 'call-next-method obj
@ -363,12 +363,12 @@ Note: This index will not be saved in a persistent file.")
:documentation "List of `semantic-db-table' objects.")) :documentation "List of `semantic-db-table' objects."))
"Database of file tables.") "Database of file tables.")
(defmethod semanticdb-full-filename ((obj semanticdb-project-database)) (cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database))
"Fetch the full filename that OBJ refers to. "Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them." Abstract tables do not have file names associated with them."
nil) nil)
(defmethod semanticdb-dirty-p ((DB semanticdb-project-database)) (cl-defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
"Return non-nil if DB is 'dirty'. "Return non-nil if DB is 'dirty'.
A database is dirty if the state of the database changed in a way A database is dirty if the state of the database changed in a way
where it may need to resynchronize with some persistent storage." where it may need to resynchronize with some persistent storage."
@ -379,7 +379,7 @@ where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs))) (setq tabs (cdr tabs)))
dirty)) dirty))
(defmethod object-print ((obj semanticdb-project-database) &rest strings) (cl-defmethod object-print ((obj semanticdb-project-database) &rest strings)
"Pretty printer extension for `semanticdb-project-database'. "Pretty printer extension for `semanticdb-project-database'.
Adds the number of tables in this file to the object print name." Adds the number of tables in this file to the object print name."
(apply 'call-next-method obj (apply 'call-next-method obj
@ -390,7 +390,7 @@ Adds the number of tables in this file to the object print name."
) )
strings))) strings)))
(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory) (cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
"Create a new semantic database of class DBC for DIRECTORY and return it. "Create a new semantic database of class DBC for DIRECTORY and return it.
If a database for DIRECTORY has already been created, return it. If a database for DIRECTORY has already been created, return it.
If DIRECTORY doesn't exist, create a new one." If DIRECTORY doesn't exist, create a new one."
@ -404,11 +404,11 @@ If DIRECTORY doesn't exist, create a new one."
(oset db reference-directory (file-truename directory))) (oset db reference-directory (file-truename directory)))
db)) db))
(defmethod semanticdb-flush-database-tables ((db semanticdb-project-database)) (cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
"Reset the tables in DB to be empty." "Reset the tables in DB to be empty."
(oset db tables nil)) (oset db tables nil))
(defmethod semanticdb-create-table ((db semanticdb-project-database) file) (cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file)
"Create a new table in DB for FILE and return it. "Create a new table in DB for FILE and return it.
The class of DB contains the class name for the type of table to create. The class of DB contains the class name for the type of table to create.
If the table for FILE exists, return it. If the table for FILE exists, return it.
@ -425,7 +425,7 @@ If the table for FILE does not exist, create one."
(object-add-to-list db 'tables newtab t)) (object-add-to-list db 'tables newtab t))
newtab)) newtab))
(defmethod semanticdb-file-table ((obj semanticdb-project-database) filename) (cl-defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
"From OBJ, return FILENAME's associated table object." "From OBJ, return FILENAME's associated table object."
(object-assoc (file-relative-name (file-truename filename) (object-assoc (file-relative-name (file-truename filename)
(oref obj reference-directory)) (oref obj reference-directory))
@ -475,7 +475,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example." See the file semantic/scope.el for an example."
:abstract t) :abstract t)
(defmethod semanticdb-cache-get ((table semanticdb-abstract-table) (cl-defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
desired-class) desired-class)
"Get a cache object on TABLE of class DESIRED-CLASS. "Get a cache object on TABLE of class DESIRED-CLASS.
This method will create one if none exists with no init arguments This method will create one if none exists with no init arguments
@ -495,18 +495,18 @@ other than :table."
(object-add-to-list table 'cache obj) (object-add-to-list table 'cache obj)
obj))) obj)))
(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table) (cl-defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
cache) cache)
"Remove from TABLE the cache object CACHE." "Remove from TABLE the cache object CACHE."
(object-remove-from-list table 'cache cache)) (object-remove-from-list table 'cache cache))
(defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache) (cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
new-tags) new-tags)
"Synchronize a CACHE with some NEW-TAGS." "Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
) )
(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache) (cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
new-tags) new-tags)
"Synchronize a CACHE with some changed NEW-TAGS." "Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
@ -526,7 +526,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example." See the file semantic/scope.el for an example."
:abstract t) :abstract t)
(defmethod semanticdb-cache-get ((db semanticdb-project-database) (cl-defmethod semanticdb-cache-get ((db semanticdb-project-database)
desired-class) desired-class)
"Get a cache object on DB of class DESIRED-CLASS. "Get a cache object on DB of class DESIRED-CLASS.
This method will create one if none exists with no init arguments This method will create one if none exists with no init arguments
@ -546,19 +546,19 @@ other than :table."
(object-add-to-list db 'cache obj) (object-add-to-list db 'cache obj)
obj))) obj)))
(defmethod semanticdb-cache-remove ((db semanticdb-project-database) (cl-defmethod semanticdb-cache-remove ((db semanticdb-project-database)
cache) cache)
"Remove from TABLE the cache object CACHE." "Remove from TABLE the cache object CACHE."
(object-remove-from-list db 'cache cache)) (object-remove-from-list db 'cache cache))
(defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache) (cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
new-tags) new-tags)
"Synchronize a CACHE with some NEW-TAGS." "Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
) )
(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache) (cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
new-tags) new-tags)
"Synchronize a CACHE with some changed NEW-TAGS." "Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING! ;; The abstract class will do... NOTHING!
@ -566,7 +566,7 @@ other than :table."
;;; REFRESH ;;; REFRESH
(defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force) (cl-defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it. "If the tag list associated with OBJ is loaded, refresh it.
Optional argument FORCE will force a refresh even if the file in question Optional argument FORCE will force a refresh even if the file in question
is not in a buffer. Avoid using FORCE for most uses, as an old cache is not in a buffer. Avoid using FORCE for most uses, as an old cache
@ -593,7 +593,7 @@ This will call `semantic-fetch-tags' if that file is in memory."
;; Kill off the buffer if it didn't exist when we were called. ;; Kill off the buffer if it didn't exist when we were called.
(kill-buffer buff)))))) (kill-buffer buff))))))
(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table)) (cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
"Return non-nil of OBJ's tag list is out of date. "Return non-nil of OBJ's tag list is out of date.
The file associated with OBJ does not need to be in a buffer." The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj)) (let* ((ff (semanticdb-full-filename obj))
@ -624,7 +624,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; Synchronization ;;; Synchronization
;; ;;
(defmethod semanticdb-synchronize ((table semanticdb-abstract-table) (cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
new-tags) new-tags)
"Synchronize the table TABLE with some NEW-TAGS." "Synchronize the table TABLE with some NEW-TAGS."
(oset table tags new-tags) (oset table tags new-tags)
@ -655,7 +655,7 @@ The file associated with OBJ does not need to be in a buffer."
(semanticdb-refresh-references table) (semanticdb-refresh-references table)
) )
(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table) (cl-defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
new-tags) new-tags)
"Synchronize the table TABLE where some NEW-TAGS changed." "Synchronize the table TABLE where some NEW-TAGS changed."
;; You might think we need to reset the tags, but since the partial ;; You might think we need to reset the tags, but since the partial
@ -688,7 +688,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; SAVE/LOAD ;;; SAVE/LOAD
;; ;;
(defmethod semanticdb-save-db ((DB semanticdb-project-database) (cl-defmethod semanticdb-save-db ((DB semanticdb-project-database)
&optional suppress-questions) &optional suppress-questions)
"Cause a database to save itself. "Cause a database to save itself.
The database base class does not save itself persistently. The database base class does not save itself persistently.
@ -741,7 +741,7 @@ Project Management software (such as EDE and JDE) should add their own
predicates with `add-hook' to this variable, and semanticdb will save tag predicates with `add-hook' to this variable, and semanticdb will save tag
caches in directories controlled by them.") caches in directories controlled by them.")
(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database)) (cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
"Return non-nil if OBJ should be written to disk. "Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value." Uses `semanticdb-persistent-path' to determine the return value."
nil) nil)
@ -772,7 +772,7 @@ This temporarily sets `semanticdb-match-any-mode' while executing BODY."
,@body)) ,@body))
(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0) (put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
(defmethod semanticdb-equivalent-mode-for-search (table &optional buffer) (cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER. "Return non-nil if TABLE's mode is equivalent to BUFFER.
See `semanticdb-equivalent-mode' for details. See `semanticdb-equivalent-mode' for details.
This version is used during searches. Major-modes that opt This version is used during searches. Major-modes that opt
@ -783,13 +783,13 @@ all files of any type."
(semanticdb-equivalent-mode table buffer)) (semanticdb-equivalent-mode table buffer))
) )
(defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER. "Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes' Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable." local variable."
nil) nil)
(defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER. "Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes' Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable." local variable."

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

@ -39,6 +39,7 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(require 'semantic) (require 'semantic)
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(eval-when-compile (require 'semantic/find)) (eval-when-compile (require 'semantic/find))
;;; Code: ;;; Code:
@ -117,13 +118,13 @@ These buffers are brought into view when layout occurs.")
"Controls action when in `semantic-debug-mode'") "Controls action when in `semantic-debug-mode'")
;; Methods ;; Methods
(defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame) (cl-defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
"Set the current frame on IFACE to FRAME." "Set the current frame on IFACE to FRAME."
(if frame (if frame
(oset iface current-frame frame) (oset iface current-frame frame)
(slot-makeunbound iface 'current-frame))) (slot-makeunbound iface 'current-frame)))
(defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point) (cl-defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
"Set the parser location in IFACE to POINT." "Set the parser location in IFACE to POINT."
(with-current-buffer (oref iface parser-buffer) (with-current-buffer (oref iface parser-buffer)
(if (not (slot-boundp iface 'parser-location)) (if (not (slot-boundp iface 'parser-location))
@ -131,7 +132,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface parser-location) point)) (move-marker (oref iface parser-location) point))
) )
(defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point) (cl-defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
"Set the source location in IFACE to POINT." "Set the source location in IFACE to POINT."
(with-current-buffer (oref iface source-buffer) (with-current-buffer (oref iface source-buffer)
(if (not (slot-boundp iface 'source-location)) (if (not (slot-boundp iface 'source-location))
@ -139,7 +140,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface source-location) point)) (move-marker (oref iface source-location) point))
) )
(defmethod semantic-debug-interface-layout ((iface semantic-debug-interface)) (cl-defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
"Layout windows in the current frame to facilitate debugging." "Layout windows in the current frame to facilitate debugging."
(delete-other-windows) (delete-other-windows)
;; Deal with the data buffer ;; Deal with the data buffer
@ -167,7 +168,7 @@ These buffers are brought into view when layout occurs.")
(goto-char (oref iface source-location))) (goto-char (oref iface source-location)))
) )
(defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token) (cl-defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
"For IFACE, highlight TOKEN in the source buffer . "For IFACE, highlight TOKEN in the source buffer .
TOKEN is a lexical token." TOKEN is a lexical token."
(set-buffer (oref iface :source-buffer)) (set-buffer (oref iface :source-buffer))
@ -178,7 +179,7 @@ TOKEN is a lexical token."
(semantic-debug-set-source-location iface (semantic-lex-token-start token)) (semantic-debug-set-source-location iface (semantic-lex-token-start token))
) )
(defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match) (cl-defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
"For IFACE, highlight NONTERM in the parser buffer. "For IFACE, highlight NONTERM in the parser buffer.
NONTERM is the name of the rule currently being processed that shows up NONTERM is the name of the rule currently being processed that shows up
as a nonterminal (or tag) in the source buffer. as a nonterminal (or tag) in the source buffer.
@ -226,7 +227,7 @@ If RULE and MATCH indices are specified, highlight those also."
)))) ))))
(defmethod semantic-debug-unhighlight ((iface semantic-debug-interface)) (cl-defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
"Remove all debugging overlays." "Remove all debugging overlays."
(mapc 'semantic-overlay-delete (oref iface overlays)) (mapc 'semantic-overlay-delete (oref iface overlays))
(oset iface overlays nil)) (oset iface overlays nil))
@ -271,12 +272,12 @@ on different types of return values."
) )
"One frame representation.") "One frame representation.")
(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame)) (cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame." "Highlight one parser frame."
) )
(defmethod semantic-debug-frame-info ((frame semantic-debug-frame)) (cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame." "Display info about this one parser frame."
) )
@ -521,49 +522,49 @@ by overriding one of the command methods. Be sure to use
down to your parser later." down to your parser later."
:abstract t) :abstract t)
(defmethod semantic-debug-parser-next ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
"Execute next for this PARSER." "Execute next for this PARSER."
(setq semantic-debug-user-command 'next) (setq semantic-debug-user-command 'next)
) )
(defmethod semantic-debug-parser-step ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
"Execute a step for this PARSER." "Execute a step for this PARSER."
(setq semantic-debug-user-command 'step) (setq semantic-debug-user-command 'step)
) )
(defmethod semantic-debug-parser-go ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint." "Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go) (setq semantic-debug-user-command 'go)
) )
(defmethod semantic-debug-parser-fail ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint." "Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail) (setq semantic-debug-user-command 'fail)
) )
(defmethod semantic-debug-parser-quit ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint." "Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit) (setq semantic-debug-user-command 'quit)
) )
(defmethod semantic-debug-parser-abort ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint." "Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort) (setq semantic-debug-user-command 'abort)
) )
(defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint." "Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface (with-slots (current-frame) semantic-debug-current-interface
(when current-frame (when current-frame
(semantic-debug-frame-info current-frame) (semantic-debug-frame-info current-frame)
))) )))
(defmethod semantic-debug-parser-break ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
"Set a breakpoint for this PARSER." "Set a breakpoint for this PARSER."
) )
;; Stack stuff ;; Stack stuff
(defmethod semantic-debug-parser-frames ((parser semantic-debug-parser)) (cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
"Return a list of frames for the current parser. "Return a list of frames for the current parser.
A frame is of the form: A frame is of the form:
( .. .what ? .. ) ( .. .what ? .. )

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

@ -831,7 +831,7 @@ When an include's referring file is parsed, we need to undecorate
any decorated referring includes.") any decorated referring includes.")
(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache)) (cl-defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
"Reset OBJ back to it's empty settings." "Reset OBJ back to it's empty settings."
(let ((table (oref obj table))) (let ((table (oref obj table)))
;; This is a hack. Add in something better? ;; This is a hack. Add in something better?
@ -841,13 +841,13 @@ any decorated referring includes.")
)) ))
)) ))
(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache) (cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags) new-tags)
"Synchronize CACHE with some NEW-TAGS." "Synchronize CACHE with some NEW-TAGS."
(if (semantic-find-tags-by-class 'include new-tags) (if (semantic-find-tags-by-class 'include new-tags)
(semantic-reset cache))) (semantic-reset cache)))
(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache) (cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags) new-tags)
"Synchronize a CACHE with some NEW-TAGS." "Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache)) (semantic-reset cache))

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

@ -51,7 +51,7 @@
A grammar target consists of grammar files that build Emacs Lisp programs for A grammar target consists of grammar files that build Emacs Lisp programs for
parsing different languages.") parsing different languages.")
(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar)) (cl-defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
"Return a string representing the dependencies for THIS. "Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care. have a list of intermediates (object files), and others don't care.
@ -124,17 +124,17 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs.") "Compile Emacs Lisp programs.")
;;; Target options. ;;; Target options.
(defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer) (cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER. "Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files." Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it ;; We need to be a little more careful than this, but at the moment it
;; is common to have only one target of this class per directory. ;; is common to have only one target of this class per directory.
(if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer)) (if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
t t
(call-next-method) ; The usual thing. (cl-call-next-method) ; The usual thing.
)) ))
(defmethod project-compile-target ((obj semantic-ede-proj-target-grammar)) (cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ." "Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer)) (let* ((cb (current-buffer))
(proj (ede-target-parent obj)) (proj (ede-target-parent obj))
@ -167,13 +167,13 @@ Lays claim to all -by.el, and -wy.el files."
;;; Makefile generation functions ;;; Makefile generation functions
;; ;;
(defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar)) (cl-defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
"Return the variable name for THIS's sources." "Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p) (cond ((ede-proj-automake-p)
(error "No Automake support for Semantic Grammars")) (error "No Automake support for Semantic Grammars"))
(t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR")))) (t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR"))))
(defmethod ede-proj-makefile-insert-variables :AFTER ((this semantic-ede-proj-target-grammar)) (cl-defmethod ede-proj-makefile-insert-variables :after ((this semantic-ede-proj-target-grammar))
"Insert variables needed by target THIS." "Insert variables needed by target THIS."
(ede-proj-makefile-insert-loadpath-items (ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath (ede-proj-elisp-packages-to-loadpath
@ -192,7 +192,7 @@ Lays claim to all -by.el, and -wy.el files."
" "))) " ")))
) )
(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) (cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target. "Insert rules needed by THIS target.
This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
needed for the compilation of the resulting parsers." needed for the compilation of the resulting parsers."
@ -200,12 +200,12 @@ needed for the compilation of the resulting parsers."
max-lisp-eval-depth 700)'\n" max-lisp-eval-depth 700)'\n"
(oref this name)))) (oref this name))))
(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar)) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
"Insert dist dependencies, or intermediate targets. "Insert dist dependencies, or intermediate targets.
This makes sure that all grammar lisp files are created before the dist This makes sure that all grammar lisp files are created before the dist
runs, so they are always up to date. runs, so they are always up to date.
Argument THIS is the target that should insert stuff." Argument THIS is the target that should insert stuff."
(call-next-method) (cl-call-next-method)
(insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)") (insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
) )

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

@ -138,7 +138,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
))) )))
(defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context)) (cl-defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
"Show documentation about CONTEXT if CONTEXT points at a complete symbol." "Show documentation about CONTEXT if CONTEXT points at a complete symbol."
(let ((sym (car (reverse (oref context prefix)))) (let ((sym (car (reverse (oref context prefix))))
(doc nil)) (doc nil))
@ -163,7 +163,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
;; This is from semantic-sb ;; This is from semantic-sb
'semantic-sb-token-jump)))) 'semantic-sb-token-jump))))
(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context)) (cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
"Show a set of speedbar buttons specific to CONTEXT." "Show a set of speedbar buttons specific to CONTEXT."
(let ((prefix (oref context prefix))) (let ((prefix (oref context prefix)))
(when prefix (when prefix
@ -173,9 +173,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'semantic-sb-token-jump)) 'semantic-sb-token-jump))
)) ))
(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment)) (cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
"Show a set of speedbar buttons specific to CONTEXT." "Show a set of speedbar buttons specific to CONTEXT."
(call-next-method) (cl-call-next-method)
(let ((assignee (oref context assignee))) (let ((assignee (oref context assignee)))
(when assignee (when assignee
(speedbar-insert-separator "Assignee") (speedbar-insert-separator "Assignee")
@ -183,9 +183,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'speedbar-tag-face 'speedbar-tag-face
'semantic-sb-token-jump)))) 'semantic-sb-token-jump))))
(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg)) (cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
"Show a set of speedbar buttons specific to CONTEXT." "Show a set of speedbar buttons specific to CONTEXT."
(call-next-method) (cl-call-next-method)
(let ((func (oref context function))) (let ((func (oref context function)))
(when func (when func
(speedbar-insert-separator "Function") (speedbar-insert-separator "Function")

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

@ -86,7 +86,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
) )
"A single bookmark.") "A single bookmark.")
(defmethod initialize-instance :AFTER ((sbm semantic-bookmark) &rest fields) (cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
"Initialize the bookmark SBM with details about :tag." "Initialize the bookmark SBM with details about :tag."
(condition-case nil (condition-case nil
(save-excursion (save-excursion
@ -96,7 +96,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
(error (message "Error bookmarking tag."))) (error (message "Error bookmarking tag.")))
) )
(defmethod semantic-mrub-visit ((sbm semantic-bookmark)) (cl-defmethod semantic-mrub-visit ((sbm semantic-bookmark))
"Visit the semantic tag bookmark SBM. "Visit the semantic tag bookmark SBM.
Uses `semantic-go-to-tag' and highlighting." Uses `semantic-go-to-tag' and highlighting."
(require 'semantic/decorate) (require 'semantic/decorate)
@ -117,7 +117,7 @@ Uses `semantic-go-to-tag' and highlighting."
(semantic-momentary-highlight-tag tag) (semantic-momentary-highlight-tag tag)
)) ))
(defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason) (cl-defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
"Update the existing bookmark SBM. "Update the existing bookmark SBM.
POINT is some important location. POINT is some important location.
REASON is a symbol. See slot `reason' on `semantic-bookmark'." REASON is a symbol. See slot `reason' on `semantic-bookmark'."
@ -132,7 +132,7 @@ REASON is a symbol. See slot `reason' on `semantic-bookmark'."
(error nil)) (error nil))
) )
(defmethod semantic-mrub-preflush ((sbm semantic-bookmark)) (cl-defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
"Method called on a tag before the current buffer list of tags is flushed. "Method called on a tag before the current buffer list of tags is flushed.
If there is a buffer match, unlink the tag." If there is a buffer match, unlink the tag."
(let ((tag (oref sbm tag)) (let ((tag (oref sbm tag))
@ -183,7 +183,7 @@ Argument POINT is where to find the tag near."
(when nearby (setq tag nearby)))) (when nearby (setq tag nearby))))
tag)) tag))
(defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point (cl-defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
&optional reason) &optional reason)
"Add a bookmark to the ring SBR from POINT. "Add a bookmark to the ring SBR from POINT.
REASON is why it is being pushed. See doc for `semantic-bookmark' REASON is why it is being pushed. See doc for `semantic-bookmark'

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

@ -101,7 +101,7 @@ Saves scoping information between runs of the analyzer.")
;; ;;
;; Methods for basic management of the structure in semanticdb. ;; Methods for basic management of the structure in semanticdb.
;; ;;
(defmethod semantic-reset ((obj semantic-scope-cache)) (cl-defmethod semantic-reset ((obj semantic-scope-cache))
"Reset OBJ back to it's empty settings." "Reset OBJ back to it's empty settings."
(oset obj tag nil) (oset obj tag nil)
(oset obj scopetypes nil) (oset obj scopetypes nil)
@ -114,13 +114,13 @@ Saves scoping information between runs of the analyzer.")
(oset obj typescope nil) (oset obj typescope nil)
) )
(defmethod semanticdb-synchronize ((cache semantic-scope-cache) (cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags) new-tags)
"Synchronize a CACHE with some NEW-TAGS." "Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache)) (semantic-reset cache))
(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache) (cl-defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
new-tags) new-tags)
"Synchronize a CACHE with some changed NEW-TAGS." "Synchronize a CACHE with some changed NEW-TAGS."
;; If there are any includes or datatypes changed, then clear. ;; If there are any includes or datatypes changed, then clear.
@ -137,7 +137,7 @@ Saves scoping information between runs of the analyzer.")
'semantic-scope-cache))) 'semantic-scope-cache)))
(semantic-reset co)))) (semantic-reset co))))
(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) (cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
types-in-scope) types-in-scope)
"Set the :typescope property on CACHE to some types. "Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are TYPES-IN-SCOPE is a list of type tags whos members are
@ -829,7 +829,7 @@ hits in order, with the first tag being in the closest scope."
;;; DUMP ;;; DUMP
;; ;;
(defmethod semantic-analyze-show ((context semantic-scope-cache)) (cl-defmethod semantic-analyze-show ((context semantic-scope-cache))
"Insert CONTEXT into the current buffer in a nice way." "Insert CONTEXT into the current buffer in a nice way."
(require 'semantic/analyze) (require 'semantic/analyze)
(semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " ) (semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )

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

@ -314,7 +314,7 @@ Use the `semantic-symref-hit-tags' method to get this list.")
) )
"The results from a symbol reference search.") "The results from a symbol reference search.")
(defmethod semantic-symref-result-get-files ((result semantic-symref-result)) (cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT." "Get the list of files from the symref result RESULT."
(if (slot-boundp result :hit-files) (if (slot-boundp result :hit-files)
(oref result hit-files) (oref result hit-files)
@ -352,7 +352,7 @@ until the next command is executed."
(remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn) (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
) )
(defmethod semantic-symref-result-get-tags ((result semantic-symref-result) (cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers) &optional open-buffers)
"Get the list of tags from the symref result RESULT. "Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are Optional OPEN-BUFFERS indicates that the buffers that the hits are
@ -531,7 +531,7 @@ NAME is the name of the tool used in the configuration variable
`semantic-symref-tool'" `semantic-symref-tool'"
:abstract t) :abstract t)
(defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass)) (cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL. "Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria." The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool)) (let ((answer (semantic-symref-perform-search tool))
@ -549,11 +549,11 @@ The symref TOOL should already contain the search criteria."
) )
)) ))
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass)) (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error." "Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'")) (error "Symref tool objects must implement `semantic-symref-perform-search'"))
(defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass) (cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer) outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool. "Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and Calls the method `semantic-symref-parse-tool-output-one-line' over and
@ -567,7 +567,7 @@ over until it returns nil."
(nreverse result))) (nreverse result)))
) )
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass)) (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented." "Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'")) (error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))

4
lisp/cedet/semantic/symref/cscope.el
View file

@ -42,7 +42,7 @@ the hit list.
See the function `cedet-cscope-search' for more details.") See the function `cedet-cscope-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope)) (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
"Perform a search with GNU Global." "Perform a search with GNU Global."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode) (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel))) (ede-toplevel)))
@ -60,7 +60,7 @@ See the function `cedet-cscope-search' for more details.")
(semantic-symref-parse-tool-output tool b) (semantic-symref-parse-tool-output tool b)
)) ))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope)) (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
"Parse one line of grep output, and return it as a match list. "Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match." Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file) (cond ((eq (oref tool :resulttype) 'file)

4
lisp/cedet/semantic/symref/global.el
View file

@ -38,7 +38,7 @@ the hit list.
See the function `cedet-gnu-global-search' for more details.") See the function `cedet-gnu-global-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global)) (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
"Perform a search with GNU Global." "Perform a search with GNU Global."
(let ((b (cedet-gnu-global-search (oref tool :searchfor) (let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype) (oref tool :searchtype)
@ -49,7 +49,7 @@ See the function `cedet-gnu-global-search' for more details.")
(semantic-symref-parse-tool-output tool b) (semantic-symref-parse-tool-output tool b)
)) ))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global)) (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
"Parse one line of grep output, and return it as a match list. "Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match." Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file) (cond ((or (eq (oref tool :resulttype) 'file)

4
lisp/cedet/semantic/symref/grep.el
View file

@ -121,7 +121,7 @@ This shell should support pipe redirect syntax."
:group 'semantic :group 'semantic
:type 'string) :type 'string)
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep)) (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep." "Perform a search with Grep."
;; Grep doesn't support some types of searches. ;; Grep doesn't support some types of searches.
(let ((st (oref tool :searchtype))) (let ((st (oref tool :searchtype)))
@ -167,7 +167,7 @@ This shell should support pipe redirect syntax."
;; Return the answer ;; Return the answer
ans)) ans))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep)) (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list. "Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match." Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file) (cond ((eq (oref tool :resulttype) 'file)

4
lisp/cedet/semantic/symref/idutils.el
View file

@ -38,7 +38,7 @@ the hit list.
See the function `cedet-idutils-search' for more details.") See the function `cedet-idutils-search' for more details.")
(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils)) (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
"Perform a search with IDUtils." "Perform a search with IDUtils."
(let ((b (cedet-idutils-search (oref tool :searchfor) (let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype) (oref tool :searchtype)
@ -49,7 +49,7 @@ See the function `cedet-idutils-search' for more details.")
(semantic-symref-parse-tool-output tool b) (semantic-symref-parse-tool-output tool b)
)) ))
(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils)) (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
"Parse one line of grep output, and return it as a match list. "Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match." Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file) (cond ((eq (oref tool :resulttype) 'file)

15
lisp/cedet/srecode/compile.el
View file

@ -34,6 +34,7 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(require 'semantic) (require 'semantic)
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'eieio-base) (require 'eieio-base)
(require 'srecode/table) (require 'srecode/table)
(require 'srecode/dictionary) (require 'srecode/dictionary)
@ -115,7 +116,7 @@ additional static argument data."))
Plain text strings are not handled via this baseclass." Plain text strings are not handled via this baseclass."
:abstract t) :abstract t)
(defmethod srecode-parse-input ((ins srecode-template-inserter) (cl-defmethod srecode-parse-input ((ins srecode-template-inserter)
tag input STATE) tag input STATE)
"For the template inserter INS, parse INPUT. "For the template inserter INS, parse INPUT.
Shorten input only by the amount needed. Shorten input only by the amount needed.
@ -123,15 +124,15 @@ Return the remains of INPUT.
STATE is the current compilation state." STATE is the current compilation state."
input) input)
(defmethod srecode-match-end ((ins srecode-template-inserter) name) (cl-defmethod srecode-match-end ((ins srecode-template-inserter) name)
"For the template inserter INS, do I end a section called NAME?" "For the template inserter INS, do I end a section called NAME?"
nil) nil)
(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE) (cl-defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE)
"For the template inserter INS, apply information from STATE." "For the template inserter INS, apply information from STATE."
nil) nil)
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -158,7 +159,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
) )
"Current state of the compile.") "Current state of the compile.")
(defmethod srecode-compile-add-prompt ((state srecode-compile-state) (cl-defmethod srecode-compile-add-prompt ((state srecode-compile-state)
prompttag) prompttag)
"Add PROMPTTAG to the current list of prompts." "Add PROMPTTAG to the current list of prompts."
(with-slots (prompts) state (with-slots (prompts) state
@ -595,7 +596,7 @@ A list of defined variables VARS provides a variable table."
;; Dump out information about the current srecoder compiled templates. ;; Dump out information about the current srecoder compiled templates.
;; ;;
(defmethod srecode-dump ((tmp srecode-template)) (cl-defmethod srecode-dump ((tmp srecode-template))
"Dump the contents of the SRecode template tmp." "Dump the contents of the SRecode template tmp."
(princ "== Template \"") (princ "== Template \"")
(princ (eieio-object-name-string tmp)) (princ (eieio-object-name-string tmp))
@ -641,7 +642,7 @@ Argument INDENT specifies the indentation level for the list."
(princ "\n")))) (princ "\n"))))
) )
(defmethod srecode-dump ((ins srecode-template-inserter) indent) (cl-defmethod srecode-dump ((ins srecode-template-inserter) indent)
"Dump the state of the SRecode template inserter INS." "Dump the state of the SRecode template inserter INS."
(princ "INS: \"") (princ "INS: \"")
(princ (eieio-object-name-string ins)) (princ (eieio-object-name-string ins))

35
lisp/cedet/srecode/dictionary.el
View file

@ -30,6 +30,7 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'srecode) (require 'srecode)
(require 'srecode/table) (require 'srecode/table)
(eval-when-compile (require 'semantic)) (eval-when-compile (require 'semantic))
@ -103,7 +104,7 @@ set NAME \"str\" macro \"OTHERNAME\"
with appending various parts together in a list.") with appending various parts together in a list.")
(defmethod initialize-instance ((this srecode-dictionary-compound-variable) (cl-defmethod initialize-instance ((this srecode-dictionary-compound-variable)
&optional fields) &optional fields)
"Initialize the compound variable THIS. "Initialize the compound variable THIS.
Makes sure that :value is compiled." Makes sure that :value is compiled."
@ -120,7 +121,7 @@ Makes sure that :value is compiled."
;;(when (not state) ;;(when (not state)
;; (error "Cannot create compound variable outside of sectiondictionary")) ;; (error "Cannot create compound variable outside of sectiondictionary"))
(call-next-method this (nreverse newfields)) (cl-call-next-method this (nreverse newfields))
(when (not (slot-boundp this 'compiled)) (when (not (slot-boundp this 'compiled))
(let ((val (oref this :value)) (let ((val (oref this :value))
(comp nil)) (comp nil))
@ -215,7 +216,7 @@ associated with a buffer or parent."
)) ))
dict)))) dict))))
(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary) (cl-defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
tpl) tpl)
"Insert into DICT the variables found in table TPL. "Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file." TPL is an object representing a compiled template file."
@ -235,7 +236,7 @@ TPL is an object representing a compiled template file."
(setq tabs (cdr tabs)))))) (setq tabs (cdr tabs))))))
(defmethod srecode-dictionary-set-value ((dict srecode-dictionary) (cl-defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value) name value)
"In dictionary DICT, set NAME to have VALUE." "In dictionary DICT, set NAME to have VALUE."
;; Validate inputs ;; Validate inputs
@ -247,7 +248,7 @@ TPL is an object representing a compiled template file."
(puthash name value namehash)) (puthash name value namehash))
) )
(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary) (cl-defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
name &optional show-only force) name &optional show-only force)
"In dictionary DICT, add a section dictionary for section macro NAME. "In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary. Return the new dictionary.
@ -299,7 +300,7 @@ inserted dictionaries."
;; Return the new sub-dictionary. ;; Return the new sub-dictionary.
new)) new))
(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name) (cl-defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be exposed." "In dictionary DICT, indicate that the section NAME should be exposed."
;; Validate inputs ;; Validate inputs
(unless (stringp name) (unless (stringp name)
@ -310,7 +311,7 @@ inserted dictionaries."
(srecode-dictionary-add-section-dictionary dict name t) (srecode-dictionary-add-section-dictionary dict name t)
nil) nil)
(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name) (cl-defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be hidden." "In dictionary DICT, indicate that the section NAME should be hidden."
;; We need to find the has value, and then delete it. ;; We need to find the has value, and then delete it.
;; Validate inputs ;; Validate inputs
@ -322,7 +323,7 @@ inserted dictionaries."
(remhash name namehash)) (remhash name namehash))
nil) nil)
(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary) (cl-defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state) entries &optional state)
"Add ENTRIES to DICT. "Add ENTRIES to DICT.
@ -373,7 +374,7 @@ values but STATE is nil."
(setq entries (nthcdr 2 entries))) (setq entries (nthcdr 2 entries)))
dict) dict)
(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict (cl-defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
&optional force) &optional force)
"Merge into DICT the dictionary entries from OTHERDICT. "Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are Unless the optional argument FORCE is non-nil, values in DICT are
@ -405,7 +406,7 @@ OTHERDICT."
(srecode-dictionary-set-value dict key entry))))) (srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash)))) (oref otherdict namehash))))
(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary) (cl-defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name &optional non-recursive) name &optional non-recursive)
"Return information about DICT's value for NAME. "Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the DICT is a dictionary, and NAME is a string that is treated as the
@ -429,7 +430,7 @@ This function derives values for some special NAMEs, such as
(srecode-dictionary-lookup-name parent name))))) (srecode-dictionary-lookup-name parent name)))))
) )
(defmethod srecode-root-dictionary ((dict srecode-dictionary)) (cl-defmethod srecode-root-dictionary ((dict srecode-dictionary))
"For dictionary DICT, return the root dictionary. "For dictionary DICT, return the root dictionary.
The root dictionary is usually for a current or active insertion." The root dictionary is usually for a current or active insertion."
(let ((ans dict)) (let ((ans dict))
@ -442,7 +443,7 @@ The root dictionary is usually for a current or active insertion."
;; Compound values must provide at least the toString method ;; Compound values must provide at least the toString method
;; for use in converting the compound value into something insertable. ;; for use in converting the compound value into something insertable.
(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value) (cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
function function
dictionary) dictionary)
"Convert the compound dictionary value CP to a string. "Convert the compound dictionary value CP to a string.
@ -456,13 +457,13 @@ the value itself using `princ', or by detecting if the current
standard out is a buffer, and using `insert'." standard out is a buffer, and using `insert'."
(eieio-object-name cp)) (eieio-object-name cp))
(defmethod srecode-dump ((cp srecode-dictionary-compound-value) (cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent) &optional indent)
"Display information about this compound value." "Display information about this compound value."
(princ (eieio-object-name cp)) (princ (eieio-object-name cp))
) )
(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) (cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
function function
dictionary) dictionary)
"Convert the compound dictionary variable value CP into a string. "Convert the compound dictionary variable value CP into a string.
@ -471,7 +472,7 @@ FUNCTION and DICTIONARY are as for the baseclass."
(srecode-insert-code-stream (oref cp compiled) dictionary)) (srecode-insert-code-stream (oref cp compiled) dictionary))
(defmethod srecode-dump ((cp srecode-dictionary-compound-variable) (cl-defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
&optional indent) &optional indent)
"Display information about this compound value." "Display information about this compound value."
(require 'srecode/compile) (require 'srecode/compile)
@ -501,7 +502,7 @@ Compound values allow a field to be stored in the dictionary for when
it is referenced a second time. This compound value can then be it is referenced a second time. This compound value can then be
inserted with a new editable field.") inserted with a new editable field.")
(defmethod srecode-compound-toString((cp srecode-field-value) (cl-defmethod srecode-compound-toString((cp srecode-field-value)
function function
dictionary) dictionary)
"Convert this field into an insertable string." "Convert this field into an insertable string."
@ -639,7 +640,7 @@ STATE is the current compiler state."
(srecode-dump dict)) (srecode-dump dict))
)))) ))))
(defmethod srecode-dump ((dict srecode-dictionary) &optional indent) (cl-defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
"Dump a dictionary." "Dump a dictionary."
(if (not indent) (setq indent 0)) (if (not indent) (setq indent 0))
(maphash (lambda (key entry) (maphash (lambda (key entry)

24
lisp/cedet/srecode/extract.el
View file

@ -55,16 +55,16 @@
) )
"The current extraction state.") "The current extraction state.")
(defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict) (cl-defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
"Set onto the extract state ST a new inserter INS and dictionary DICT." "Set onto the extract state ST a new inserter INS and dictionary DICT."
(oset st lastinserter ins) (oset st lastinserter ins)
(oset st lastdict dict)) (oset st lastdict dict))
(defmethod srecode-extract-state-set-anchor ((st srecode-extract-state)) (cl-defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
"Reset the anchor point on extract state ST." "Reset the anchor point on extract state ST."
(oset st anchor (point))) (oset st anchor (point)))
(defmethod srecode-extract-state-extract ((st srecode-extract-state) (cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
endpoint) endpoint)
"Perform an extraction on the extract state ST with ENDPOINT. "Perform an extraction on the extract state ST with ENDPOINT.
If there was no waiting inserter, do nothing." If there was no waiting inserter, do nothing."
@ -94,7 +94,7 @@ the dictionary entries were for that block of text."
(srecode-extract-method template dict state) (srecode-extract-method template dict state)
dict)))) dict))))
(defmethod srecode-extract-method ((st srecode-template) dictionary (cl-defmethod srecode-extract-method ((st srecode-template) dictionary
state) state)
"Extract template ST and store extracted text in DICTIONARY. "Extract template ST and store extracted text in DICTIONARY.
Optional STARTRETURN is a symbol in which the start of the first Optional STARTRETURN is a symbol in which the start of the first
@ -139,11 +139,11 @@ Uses STATE to maintain the current extraction state."
;;; Inserter Base Extractors ;;; Inserter Base Extractors
;; ;;
(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter)) (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
"Return non-nil if this inserter can extract values." "Return non-nil if this inserter can extract values."
nil) nil)
(defmethod srecode-inserter-extract ((ins srecode-template-inserter) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
start end dict state) start end dict state)
"Extract text from START/END and store in DICT. "Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing." Return nil as this inserter will extract nothing."
@ -151,11 +151,11 @@ Return nil as this inserter will extract nothing."
;;; Variable extractor is simple and can extract later. ;;; Variable extractor is simple and can extract later.
;; ;;
(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable)) (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
"Return non-nil if this inserter can extract values." "Return non-nil if this inserter can extract values."
'later) 'later)
(defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
start end vdict state) start end vdict state)
"Extract text from START/END and store in VDICT. "Extract text from START/END and store in VDICT.
Return t if something was extracted. Return t if something was extracted.
@ -169,11 +169,11 @@ Return nil if this inserter doesn't need to extract anything."
;;; Section Inserter ;;; Section Inserter
;; ;;
(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start)) (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
"Return non-nil if this inserter can extract values." "Return non-nil if this inserter can extract values."
'now) 'now)
(defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
start end indict state) start end indict state)
"Extract text from START/END and store in INDICT. "Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match. Return the starting location of the first plain-text match.
@ -203,11 +203,11 @@ Return nil if nothing was extracted."
;;; Include Extractor must extract now. ;;; Include Extractor must extract now.
;; ;;
(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include)) (cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
"Return non-nil if this inserter can extract values." "Return non-nil if this inserter can extract values."
'now) 'now)
(defmethod srecode-inserter-extract ((ins srecode-template-inserter-include) (cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
start end dict state) start end dict state)
"Extract text from START/END and store in DICT. "Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match. Return the starting location of the first plain-text match.

43
lisp/cedet/srecode/fields.el
View file

@ -39,6 +39,7 @@
;; Keep this library independent of SRecode proper. ;; Keep this library independent of SRecode proper.
(require 'eieio) (require 'eieio)
(require 'cl-generic)
;;; Code: ;;; Code:
(defvar srecode-field-archive nil (defvar srecode-field-archive nil
@ -74,7 +75,7 @@ The overlay will crossreference this object.")
"An object that gets automatically bound to an overlay. "An object that gets automatically bound to an overlay.
Has virtual :start and :end initializers.") Has virtual :start and :end initializers.")
(defmethod initialize-instance ((olaid srecode-overlaid) &optional args) (cl-defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
"Initialize OLAID, being sure it archived." "Initialize OLAID, being sure it archived."
;; Extract :start and :end from the olaid list. ;; Extract :start and :end from the olaid list.
(let ((newargs nil) (let ((newargs nil)
@ -107,11 +108,11 @@ Has virtual :start and :end initializers.")
(overlay-put olay 'srecode-init-only t) (overlay-put olay 'srecode-init-only t)
(oset olaid overlay olay) (oset olaid overlay olay)
(call-next-method olaid (nreverse newargs)) (cl-call-next-method olaid (nreverse newargs))
)) ))
(defmethod srecode-overlaid-activate ((olaid srecode-overlaid)) (cl-defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
"Activate the overlaid area." "Activate the overlaid area."
(let* ((ola (oref olaid overlay)) (let* ((ola (oref olaid overlay))
(start (overlay-start ola)) (start (overlay-start ola))
@ -128,23 +129,23 @@ Has virtual :start and :end initializers.")
)) ))
(defmethod srecode-delete ((olaid srecode-overlaid)) (cl-defmethod srecode-delete ((olaid srecode-overlaid))
"Delete the overlay from OLAID." "Delete the overlay from OLAID."
(delete-overlay (oref olaid overlay)) (delete-overlay (oref olaid overlay))
(slot-makeunbound olaid 'overlay) (slot-makeunbound olaid 'overlay)
) )
(defmethod srecode-empty-region-p ((olaid srecode-overlaid)) (cl-defmethod srecode-empty-region-p ((olaid srecode-overlaid))
"Return non-nil if the region covered by OLAID is of length 0." "Return non-nil if the region covered by OLAID is of length 0."
(= 0 (srecode-region-size olaid))) (= 0 (srecode-region-size olaid)))
(defmethod srecode-region-size ((olaid srecode-overlaid)) (cl-defmethod srecode-region-size ((olaid srecode-overlaid))
"Return the length of region covered by OLAID." "Return the length of region covered by OLAID."
(let ((start (overlay-start (oref olaid overlay))) (let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay)))) (end (overlay-end (oref olaid overlay))))
(- end start))) (- end start)))
(defmethod srecode-point-in-region-p ((olaid srecode-overlaid)) (cl-defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
"Return non-nil if point is in the region of OLAID." "Return non-nil if point is in the region of OLAID."
(let ((start (overlay-start (oref olaid overlay))) (let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay)))) (end (overlay-end (oref olaid overlay))))
@ -161,7 +162,7 @@ Has virtual :start and :end initializers.")
(setq ol (cdr ol))) (setq ol (cdr ol)))
(car (nreverse ret)))) (car (nreverse ret))))
(defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to) (cl-defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
"Return the text under OLAID. "Return the text under OLAID.
If SET-TO is a string, then replace the text of OLAID wit SET-TO." If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(let* ((ol (oref olaid overlay)) (let* ((ol (oref olaid overlay))
@ -191,7 +192,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
) )
"Manage a buffer region in which fields exist.") "Manage a buffer region in which fields exist.")
(defmethod initialize-instance ((ir srecode-template-inserted-region) (cl-defmethod initialize-instance ((ir srecode-template-inserted-region)
&rest args) &rest args)
"Initialize IR, capturing the active fields, and creating the overlay." "Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields ;; Fill in the fields
@ -199,10 +200,10 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(setq srecode-field-archive nil) (setq srecode-field-archive nil)
;; Initialize myself first. ;; Initialize myself first.
(call-next-method) (cl-call-next-method)
) )
(defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region)) (cl-defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
"Activate the template area for IR." "Activate the template area for IR."
;; Activate all our fields ;; Activate all our fields
@ -210,7 +211,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(srecode-overlaid-activate F)) (srecode-overlaid-activate F))
;; Activate our overlay. ;; Activate our overlay.
(call-next-method) (cl-call-next-method)
;; Position the cursor at the first field ;; Position the cursor at the first field
(let ((first (car (oref ir fields)))) (let ((first (car (oref ir fields))))
@ -223,14 +224,14 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(add-hook 'post-command-hook 'srecode-field-post-command t t) (add-hook 'post-command-hook 'srecode-field-post-command t t)
) )
(defmethod srecode-delete ((ir srecode-template-inserted-region)) (cl-defmethod srecode-delete ((ir srecode-template-inserted-region))
"Call into our base, but also clear out the fields." "Call into our base, but also clear out the fields."
;; Clear us out of the baseclass. ;; Clear us out of the baseclass.
(oset ir active-region nil) (oset ir active-region nil)
;; Clear our fields. ;; Clear our fields.
(mapc 'srecode-delete (oref ir fields)) (mapc 'srecode-delete (oref ir fields))
;; Call to our base ;; Call to our base
(call-next-method) (cl-call-next-method)
;; Clear our hook. ;; Clear our hook.
(remove-hook 'post-command-hook 'srecode-field-post-command t) (remove-hook 'post-command-hook 'srecode-field-post-command t)
) )
@ -285,15 +286,15 @@ Try to use this to provide useful completion when available.")
km) km)
"Keymap applied to field overlays.") "Keymap applied to field overlays.")
(defmethod initialize-instance ((field srecode-field) &optional args) (cl-defmethod initialize-instance ((field srecode-field) &optional args)
"Initialize FIELD, being sure it archived." "Initialize FIELD, being sure it archived."
(add-to-list 'srecode-field-archive field t) (add-to-list 'srecode-field-archive field t)
(call-next-method) (cl-call-next-method)
) )
(defmethod srecode-overlaid-activate ((field srecode-field)) (cl-defmethod srecode-overlaid-activate ((field srecode-field))
"Activate the FIELD area." "Activate the FIELD area."
(call-next-method) (cl-call-next-method)
(let* ((ol (oref field overlay)) (let* ((ol (oref field overlay))
(end nil) (end nil)
@ -314,13 +315,13 @@ Try to use this to provide useful completion when available.")
) )
) )
(defmethod srecode-delete ((olaid srecode-field)) (cl-defmethod srecode-delete ((olaid srecode-field))
"Delete our secondary overlay." "Delete our secondary overlay."
;; Remove our spare overlay ;; Remove our spare overlay
(delete-overlay (oref olaid tail)) (delete-overlay (oref olaid tail))
(slot-makeunbound olaid 'tail) (slot-makeunbound olaid 'tail)
;; Do our baseclass work. ;; Do our baseclass work.
(call-next-method) (cl-call-next-method)
) )
(defvar srecode-field-replication-max-size 100 (defvar srecode-field-replication-max-size 100
@ -379,7 +380,7 @@ PRE-LEN is used in the after mode for the length of the changed text."
(srecode-field-mod-hook ol after start end pre-len)) (srecode-field-mod-hook ol after start end pre-len))
)) ))
(defmethod srecode-field-goto ((field srecode-field)) (cl-defmethod srecode-field-goto ((field srecode-field))
"Goto the FIELD." "Goto the FIELD."
(goto-char (overlay-start (oref field overlay)))) (goto-char (overlay-start (oref field overlay))))

10
lisp/cedet/srecode/find.el
View file

@ -96,7 +96,7 @@ all template files for that application will be loaded."
;; ;;
;; Find if a template table has a project set, and if so, is the ;; Find if a template table has a project set, and if so, is the
;; current buffer in that project. ;; current buffer in that project.
(defmethod srecode-template-table-in-project-p ((tab srecode-template-table)) (cl-defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
"Return non-nil if the table TAB can be used in the current project. "Return non-nil if the table TAB can be used in the current project.
If TAB has a :project set, check that the directories match. If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t." If TAB is nil, then always return t."
@ -113,7 +113,7 @@ If TAB is nil, then always return t."
;; ;;
;; Find a given template based on name, and features of the current ;; Find a given template based on name, and features of the current
;; buffer. ;; buffer.
(defmethod srecode-template-get-table ((tab srecode-template-table) (cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional template-name &optional
context application) context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME. "Find in the template in table TAB, the template with TEMPLATE-NAME.
@ -129,7 +129,7 @@ The APPLICATION argument is unused."
;; No context, perhaps a merged name? ;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash))))) (gethash template-name (oref tab namehash)))))
(defmethod srecode-template-get-table ((tab srecode-mode-table) (cl-defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional template-name &optional
context application) context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME. "Find in the template in mode table TAB, the template with TEMPLATE-NAME.
@ -157,7 +157,7 @@ tables that do not belong to an application will be searched."
;; ;;
;; Find a given template based on a key binding. ;; Find a given template based on a key binding.
;; ;;
(defmethod srecode-template-get-table-for-binding (cl-defmethod srecode-template-get-table-for-binding
((tab srecode-template-table) binding &optional context) ((tab srecode-template-table) binding &optional context)
"Find in the template name in table TAB, the template with BINDING. "Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part Optional argument CONTEXT specifies that the template should part
@ -190,7 +190,7 @@ of a particular context."
(maphash hashfcn (oref tab namehash))) (maphash hashfcn (oref tab namehash)))
keyout))) keyout)))
(defmethod srecode-template-get-table-for-binding (cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application) ((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING. "Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template Optional argument CONTEXT specifies a context a particular template

82
lisp/cedet/srecode/insert.el
View file

@ -260,20 +260,20 @@ Optional argument TEMP is the template that is getting its arguments resolved."
;; Code managing the top-level insert method and the current ;; Code managing the top-level insert method and the current
;; insertion stack. ;; insertion stack.
;; ;;
(defmethod srecode-push ((st srecode-template)) (cl-defmethod srecode-push ((st srecode-template))
"Push the srecoder template ST onto the active stack." "Push the srecoder template ST onto the active stack."
(oset st active (cons st (oref st active)))) (oset st active (cons st (oref st active))))
(defmethod srecode-pop :STATIC ((st srecode-template)) (cl-defmethod srecode-pop ((st (subclass srecode-template)))
"Pop the srecoder template ST onto the active stack. "Pop the srecoder template ST onto the active stack.
ST can be a class, or an object." ST can be a class, or an object."
(oset st active (cdr (oref st active)))) (oset st active (cdr (oref st active))))
(defmethod srecode-peek :STATIC ((st srecode-template)) (cl-defmethod srecode-peek ((st (subclass srecode-template)))
"Fetch the topmost active template record. ST can be a class." "Fetch the topmost active template record. ST can be a class."
(car (oref st active))) (car (oref st active)))
(defmethod srecode-insert-method ((st srecode-template) dictionary) (cl-defmethod srecode-insert-method ((st srecode-template) dictionary)
"Insert the srecoder template ST." "Insert the srecoder template ST."
;; Merge any template entries into the input dictionary. ;; Merge any template entries into the input dictionary.
;; This may happen twice since some templates arguments need ;; This may happen twice since some templates arguments need
@ -324,7 +324,7 @@ by themselves.")
Specify the :indent argument to enable automatic indentation when newlines Specify the :indent argument to enable automatic indentation when newlines
occur in your template.") occur in your template.")
(defmethod srecode-insert-method ((sti srecode-template-inserter-newline) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary) dictionary)
"Insert the STI inserter." "Insert the STI inserter."
;; To be safe, indent the previous line since the template will ;; To be safe, indent the previous line since the template will
@ -363,9 +363,9 @@ occur in your template.")
((stringp i) ((stringp i)
(princ i)))))) (princ i))))))
(defmethod srecode-dump ((ins srecode-template-inserter-newline) indent) (cl-defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
"Dump the state of the SRecode template inserter INS." "Dump the state of the SRecode template inserter INS."
(call-next-method) (cl-call-next-method)
(when (oref ins hard) (when (oref ins hard)
(princ " : hard") (princ " : hard")
)) ))
@ -388,7 +388,7 @@ When set to 'end it will insert a CR if we are not at 'eol'.")
"Insert a newline before and after a template, and possibly do indenting. "Insert a newline before and after a template, and possibly do indenting.
Specify the :blank argument to enable this inserter.") Specify the :blank argument to enable this inserter.")
(defmethod srecode-insert-method ((sti srecode-template-inserter-blank) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
dictionary) dictionary)
"Make sure there is no text before or after point." "Make sure there is no text before or after point."
(let ((i (srecode-dictionary-lookup-name dictionary "INDENT")) (let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
@ -425,7 +425,7 @@ Specify the :blank argument to enable this inserter.")
) )
"Allow comments within template coding. This inserts nothing.") "Allow comments within template coding. This inserts nothing.")
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-comment))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -436,7 +436,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri) (terpri)
) )
(defmethod srecode-insert-method ((sti srecode-template-inserter-comment) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
dictionary) dictionary)
"Don't insert anything for comment macros in STI." "Don't insert anything for comment macros in STI."
nil) nil)
@ -453,7 +453,7 @@ If there is no entry, insert nothing.")
(defvar srecode-inserter-variable-current-dictionary nil (defvar srecode-inserter-variable-current-dictionary nil
"The active dictionary when calling a variable filter.") "The active dictionary when calling a variable filter.")
(defmethod srecode-insert-variable-secondname-handler (cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-variable) dictionary value secondname) ((sti srecode-template-inserter-variable) dictionary value secondname)
"For VALUE handle SECONDNAME behaviors for this variable inserter. "For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string. Return the result as a string.
@ -471,7 +471,7 @@ If SECONDNAME is nil, return VALUE."
(object-print sti) secondname))) (object-print sti) secondname)))
value)) value))
(defmethod srecode-insert-method ((sti srecode-template-inserter-variable) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
dictionary) dictionary)
"Insert the STI inserter." "Insert the STI inserter."
;; Convert the name into a name/fcn pair ;; Convert the name into a name/fcn pair
@ -541,7 +541,7 @@ If there is no entry, prompt the user for the value to use.
The prompt text used is derived from the previous PROMPT command in the The prompt text used is derived from the previous PROMPT command in the
template file.") template file.")
(defmethod srecode-inserter-apply-state (cl-defmethod srecode-inserter-apply-state
((ins srecode-template-inserter-ask) STATE) ((ins srecode-template-inserter-ask) STATE)
"For the template inserter INS, apply information from STATE. "For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match." Loop over the prompts to see if we have a match."
@ -561,14 +561,14 @@ Loop over the prompts to see if we have a match."
(setq prompts (cdr prompts))) (setq prompts (cdr prompts)))
)) ))
(defmethod srecode-insert-method ((sti srecode-template-inserter-ask) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
dictionary) dictionary)
"Insert the STI inserter." "Insert the STI inserter."
(let ((val (srecode-dictionary-lookup-name (let ((val (srecode-dictionary-lookup-name
dictionary (oref sti :object-name)))) dictionary (oref sti :object-name))))
(if val (if val
;; Does some extra work. Oh well. ;; Does some extra work. Oh well.
(call-next-method) (cl-call-next-method)
;; How is our -ask value determined? ;; How is our -ask value determined?
(if srecode-insert-with-fields-in-progress (if srecode-insert-with-fields-in-progress
@ -585,9 +585,9 @@ Loop over the prompts to see if we have a match."
;; Now that this value is safely stowed in the dictionary, ;; Now that this value is safely stowed in the dictionary,
;; we can do what regular inserters do. ;; we can do what regular inserters do.
(call-next-method)))) (cl-call-next-method))))
(defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask) (cl-defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
dictionary) dictionary)
"Derive the default value for an askable inserter STI. "Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values." DICTIONARY is used to derive some values."
@ -612,7 +612,7 @@ DICTIONARY is used to derive some values."
dictionary dictionary
"Unknown default for prompt: %S" defaultfcn))))) "Unknown default for prompt: %S" defaultfcn)))))
(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask) (cl-defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary) dictionary)
"Do the \"asking\" for the template inserter STI. "Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values." Use DICTIONARY to resolve values."
@ -646,7 +646,7 @@ Use DICTIONARY to resolve values."
val) val)
) )
(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask) (cl-defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
dictionary) dictionary)
"Create an editable field for the template inserter STI. "Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values." Use DICTIONARY to resolve values."
@ -661,9 +661,9 @@ Use DICTIONARY to resolve values."
;; across multiple locations. ;; across multiple locations.
compound-value)) compound-value))
(defmethod srecode-dump ((ins srecode-template-inserter-ask) indent) (cl-defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
"Dump the state of the SRecode template inserter INS." "Dump the state of the SRecode template inserter INS."
(call-next-method) (cl-call-next-method)
(princ " : \"") (princ " : \"")
(princ (oref ins prompt)) (princ (oref ins prompt))
(princ "\"") (princ "\"")
@ -681,7 +681,7 @@ Thus a specification of `10:left' will insert the value of A
to 10 characters, with spaces added to the left. Use `right' for adding to 10 characters, with spaces added to the left. Use `right' for adding
spaces to the right.") spaces to the right.")
(defmethod srecode-insert-variable-secondname-handler (cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-width) dictionary value width) ((sti srecode-template-inserter-width) dictionary value width)
"For VALUE handle WIDTH behaviors for this variable inserter. "For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string. Return the result as a string.
@ -714,7 +714,7 @@ By default, treat as a function name."
(concat padchars value) (concat padchars value)
(concat value padchars)))))) (concat value padchars))))))
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-width))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -750,7 +750,7 @@ The cursor is placed at the ^ macro after insertion.
Some inserter macros, such as `srecode-template-inserter-include-wrap' Some inserter macros, such as `srecode-template-inserter-include-wrap'
will place text at the ^ macro from the included macro.") will place text at the ^ macro from the included macro.")
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-point))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -761,7 +761,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri) (terpri)
) )
(defmethod srecode-insert-method ((sti srecode-template-inserter-point) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-point)
dictionary) dictionary)
"Insert the STI inserter. "Insert the STI inserter.
Save point in the class allocated 'point' slot. Save point in the class allocated 'point' slot.
@ -787,11 +787,11 @@ generalized marker will do something else. See
"Wrap a section of a template under the control of a macro." "Wrap a section of a template under the control of a macro."
:abstract t) :abstract t)
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-subtemplate))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(call-next-method) (cl-call-next-method)
(princ " Template Text to control") (princ " Template Text to control")
(terpri) (terpri)
(princ " ") (princ " ")
@ -801,7 +801,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri) (terpri)
) )
(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate) (cl-defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot) dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT." "Insert a subtemplate for the inserter STI with dictionary DICT."
;; Make sure that only dictionaries are used. ;; Make sure that only dictionaries are used.
@ -814,7 +814,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
;; Output the code from the sub-template. ;; Output the code from the sub-template.
(srecode-insert-method (slot-value sti slot) dict)) (srecode-insert-method (slot-value sti slot) dict))
(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate) (cl-defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot) dictionary slot)
"Do the work for inserting the STI inserter. "Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation. Loops over the embedded CODE which was saved here during compilation.
@ -837,7 +837,7 @@ The template to insert is stored in SLOT."
(srecode-insert-subtemplate sti (car dicts) slot) (srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts))))) (setq dicts (cdr dicts)))))
(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
dictionary) dictionary)
"Insert the STI inserter. "Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class." Calls back to `srecode-insert-method-helper' for this class."
@ -858,7 +858,7 @@ The dictionary saved at the named dictionary entry will be
applied to the text between the section start and the applied to the text between the section start and the
`srecode-template-inserter-section-end' macro.") `srecode-template-inserter-section-end' macro.")
(defmethod srecode-parse-input ((ins srecode-template-inserter-section-start) (cl-defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
tag input STATE) tag input STATE)
"For the section inserter INS, parse INPUT. "For the section inserter INS, parse INPUT.
Shorten input until the END token is found. Shorten input until the END token is found.
@ -872,9 +872,9 @@ Return the remains of INPUT."
:code (cdr out))) :code (cdr out)))
(car out))) (car out)))
(defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent) (cl-defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
"Dump the state of the SRecode template inserter INS." "Dump the state of the SRecode template inserter INS."
(call-next-method) (cl-call-next-method)
(princ "\n") (princ "\n")
(srecode-dump-code-list (oref (oref ins template) code) (srecode-dump-code-list (oref (oref ins template) code)
(concat indent " ")) (concat indent " "))
@ -889,12 +889,12 @@ Return the remains of INPUT."
"All template segments between the section-start and section-end "All template segments between the section-start and section-end
are treated specially.") are treated specially.")
(defmethod srecode-insert-method ((sti srecode-template-inserter-section-end) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
dictionary) dictionary)
"Insert the STI inserter." "Insert the STI inserter."
) )
(defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name) (cl-defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
"For the template inserter INS, do I end a section called NAME?" "For the template inserter INS, do I end a section called NAME?"
(string= name (oref ins :object-name))) (string= name (oref ins :object-name)))
@ -912,7 +912,7 @@ are treated specially.")
The included template will have additional dictionary entries from the subdictionary The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.") stored specified by this macro.")
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-include))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -923,7 +923,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri) (terpri)
) )
(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include) (cl-defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
dictionary) dictionary)
"For the template inserter STI, lookup the template to include. "For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in Finds the template with this macro function part and stores it in
@ -981,7 +981,7 @@ this template instance."
"No template \"%s\" found for include macro `%s'" "No template \"%s\" found for include macro `%s'"
templatenamepart (oref sti :object-name))))) templatenamepart (oref sti :object-name)))))
(defmethod srecode-insert-method ((sti srecode-template-inserter-include) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary) dictionary)
"Insert the STI inserter. "Insert the STI inserter.
Finds the template with this macro function part, and inserts it Finds the template with this macro function part, and inserts it
@ -1017,7 +1017,7 @@ stored specified by this macro. If the included macro includes a ^ macro,
then the text between this macro and the end macro will be inserted at then the text between this macro and the end macro will be inserted at
the ^ macro.") the ^ macro.")
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap) (cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-include-wrap))
escape-start escape-end) escape-start escape-end)
"Insert an example using inserter INS. "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@ -1035,7 +1035,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri) (terpri)
) )
(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap) (cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
dictionary) dictionary)
"Insert the template STI. "Insert the template STI.
This will first insert the include part via inheritance, then This will first insert the include part via inheritance, then
@ -1067,7 +1067,7 @@ template where a ^ inserter occurs."
inserter1 dict 'template)))))))) inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in ;; Do a regular insertion for an include, but with our override in
;; place. ;; place.
(call-next-method))) (cl-call-next-method)))
(provide 'srecode/insert) (provide 'srecode/insert)

18
lisp/cedet/srecode/map.el
View file

@ -67,11 +67,11 @@ Each app keys to an alist of files and modes (as above.)")
) )
"A map of srecode templates.") "A map of srecode templates.")
(defmethod srecode-map-entry-for-file ((map srecode-map) file) (cl-defmethod srecode-map-entry-for-file ((map srecode-map) file)
"Return the entry in MAP for FILE." "Return the entry in MAP for FILE."
(assoc file (oref map files))) (assoc file (oref map files)))
(defmethod srecode-map-entries-for-mode ((map srecode-map) mode) (cl-defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
"Return the entries in MAP for major MODE." "Return the entries in MAP for major MODE."
(let ((ans nil)) (let ((ans nil))
(dolist (f (oref map files)) (dolist (f (oref map files))
@ -79,12 +79,12 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans)))) (setq ans (cons f ans))))
ans)) ans))
(defmethod srecode-map-entry-for-app ((map srecode-map) app) (cl-defmethod srecode-map-entry-for-app ((map srecode-map) app)
"Return the entry in MAP for APP." "Return the entry in MAP for APP."
(assoc app (oref map apps)) (assoc app (oref map apps))
) )
(defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode) (cl-defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
"Return the entries in MAP for major MODE." "Return the entries in MAP for major MODE."
(let ((ans nil) (let ((ans nil)
(appentry (srecode-map-entry-for-app map app))) (appentry (srecode-map-entry-for-app map app)))
@ -93,7 +93,7 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans)))) (setq ans (cons f ans))))
ans)) ans))
(defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file) (cl-defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
"Search in all entry points in MAP for FILE. "Search in all entry points in MAP for FILE.
Return a list ( APP . FILE-ASSOC ) where APP is nil Return a list ( APP . FILE-ASSOC ) where APP is nil
in the global map." in the global map."
@ -112,13 +112,13 @@ in the global map."
;; Other? ;; Other?
)) ))
(defmethod srecode-map-delete-file-entry ((map srecode-map) file) (cl-defmethod srecode-map-delete-file-entry ((map srecode-map) file)
"Update MAP to exclude FILE from the file list." "Update MAP to exclude FILE from the file list."
(let ((entry (srecode-map-entry-for-file map file))) (let ((entry (srecode-map-entry-for-file map file)))
(when entry (when entry
(object-remove-from-list map 'files entry)))) (object-remove-from-list map 'files entry))))
(defmethod srecode-map-update-file-entry ((map srecode-map) file mode) (cl-defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
"Update a MAP entry for FILE to be used with MODE. "Update a MAP entry for FILE to be used with MODE.
Return non-nil if the MAP was changed." Return non-nil if the MAP was changed."
(let ((entry (srecode-map-entry-for-file map file)) (let ((entry (srecode-map-entry-for-file map file))
@ -136,14 +136,14 @@ Return non-nil if the MAP was changed."
)) ))
dirty)) dirty))
(defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app) (cl-defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
"Delete from MAP the FILE entry within the APP." "Delete from MAP the FILE entry within the APP."
(let* ((appe (srecode-map-entry-for-app map app)) (let* ((appe (srecode-map-entry-for-app map app))
(fentry (assoc file (cdr appe)))) (fentry (assoc file (cdr appe))))
(setcdr appe (delete fentry (cdr appe)))) (setcdr appe (delete fentry (cdr appe))))
) )
(defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app) (cl-defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
"Update the MAP entry for FILE to be used with MODE within APP. "Update the MAP entry for FILE to be used with MODE within APP.
Return non-nil if the map was changed." Return non-nil if the map was changed."
(let* ((appentry (srecode-map-entry-for-app map app)) (let* ((appentry (srecode-map-entry-for-app map app))

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

@ -55,7 +55,7 @@
"Wrap up a collection of semantic tag information. "Wrap up a collection of semantic tag information.
This class will be used to derive dictionary values.") This class will be used to derive dictionary values.")
(defmethod srecode-compound-toString((cp srecode-semantic-tag) (cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function function
dictionary) dictionary)
"Convert the compound dictionary value CP to a string. "Convert the compound dictionary value CP to a string.

7
lisp/cedet/srecode/table.el
View file

@ -26,6 +26,7 @@
;; ;;
(require 'eieio) (require 'eieio)
(require 'cl-generic)
(require 'eieio-base) (require 'eieio-base)
(require 'mode-local) (require 'mode-local)
(require 'srecode) (require 'srecode)
@ -172,7 +173,7 @@ calculate all inherited templates from parent modes."
new)))) new))))
(defmethod srecode-mode-table-find ((mt srecode-mode-table) file) (cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE. "Look in the mode table MT for a template table from FILE.
Return nil if there was none." Return nil if there was none."
(object-assoc file 'file (oref mt modetables))) (object-assoc file 'file (oref mt modetables)))
@ -235,7 +236,7 @@ Use PREDICATE is the same as for the `sort' function."
(srecode-dump tmp)) (srecode-dump tmp))
))) )))
(defmethod srecode-dump ((tab srecode-mode-table)) (cl-defmethod srecode-dump ((tab srecode-mode-table))
"Dump the contents of the SRecode mode table TAB." "Dump the contents of the SRecode mode table TAB."
(princ "MODE TABLE FOR ") (princ "MODE TABLE FOR ")
(princ (oref tab :major-mode)) (princ (oref tab :major-mode))
@ -248,7 +249,7 @@ Use PREDICATE is the same as for the `sort' function."
(setq subtab (cdr subtab))) (setq subtab (cdr subtab)))
)) ))
(defmethod srecode-dump ((tab srecode-template-table)) (cl-defmethod srecode-dump ((tab srecode-template-table))
"Dump the contents of the SRecode template table TAB." "Dump the contents of the SRecode template table TAB."
(princ "Template Table for ") (princ "Template Table for ")
(princ (eieio-object-name-string tab)) (princ (eieio-object-name-string tab))