+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>
Don't use <class> as a variable and don't assume that <class>-list-p is
(require 'cedet)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/source)
(require 'ede/base)
;;; 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.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
(concat "Build Project " (ede-name 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.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
;; Allert the user
(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."
(oset proj-a subproj (cons proj-b (oref proj-a subproj))))
;; files should inherit from `ede-project'. Create the appropriate
;; 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)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(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.
Argument PROMPT is the prompt to use when querying the user for a target."
(let ((ob (object-assoc-list 'name (oref this targets))))
(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)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(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.
Argument FILE is the file to add."
(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.
Argument FNND is an argument."
(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."
(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."
(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."
(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."
(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.
Argument COMMAND is the command to use when compiling."
(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.
Argument COMMAND is the command to use for compiling the target."
(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."
(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."
(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."
(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."
(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."
(error "Rescanning a project is not supported by %s" (eieio-object-name this)))
;; Return our findings.
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?
If TARGET belongs to a subproject, return that project file."
(if (and (slot-boundp proj 'targets)
projs (cdr projs)))
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."
(with-current-buffer buffer
(setq targets (cdr targets)))
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.
Handles complex path issues."
(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."
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."
(condition-case nil
(ede-target-buffer-in-sourcelist this buffer (oref this source))
"Execute PROC on all buffers controlled by EDE."
(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."
(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."
(mapcar proc (ede-target-buffers this)))
;; 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.
This function does not apply PROC to sub-sub projects.
See also `ede-map-all-subprojects'."
(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.
This function also applies PROC to sub-sub projects.
See also `ede-map-subprojects'."
;; (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."
(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.
Return the first non-nil value returned by PROC."
(eval (cons 'or (ede-map-targets this proc))))
;; configuring items for Semantic.
;; 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."
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."
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.
For example, <root>/src for sources of c/c++, Java, etc,
and <root>/doc for doc sources."
(message "Choosing preprocessor syms for project %s"
(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."
nil)
-(defmethod ede-preprocessor-map ((this ede-project))
+(cl-defmethod ede-preprocessor-map ((this ede-project))
"Get the pre-processor map for project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-target))
+(cl-defmethod ede-preprocessor-map ((this ede-target))
"Get the pre-processor map for project THIS."
nil)
;; Java
-(defmethod ede-java-classpath ((this ede-project))
+(cl-defmethod ede-java-classpath ((this ede-project))
"Return the classpath for this project."
;; @TODO - Can JDEE add something here?
nil)
(error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
(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."
(if (not buffer) (setq buffer (current-buffer)))
(with-current-buffer buffer
(make-local-variable (car 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."
nil)
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
can be used to define that match without loading the specific project
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."
(let ((fc (oref dirmatch fromconfig)))
(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."
(let ((fc (oref dirmatch fromconfig)))
;;
;; 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."
(let* ((d (file-name-as-directory dir))
(pf (oref this proj-file))
;(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.
THIS project description should be valid for DIR, where the project will
be loaded.
;; See if we can do without them.
;; @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.
Allows for one-project-object-for-a-tree type systems."
nil)
;; @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)
(provide 'ede/auto)
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/auto)
;;
;; Mode related methods are in ede.el. These methods are related
;; 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.
If PARENT is specified, then be relative to the PARENT project.
Specifying PARENT is useful for sub-sub projects relative to the root project."
(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."
;; @TODO - Use this in more places, and also pay attention to
;; metasubproject in ede/proj.el
;; no need to in most situations because they are either a) simple, or
;; b) cosmetic.
-(defmethod ede-name ((this ede-target))
+(cl-defmethod ede-name ((this ede-target))
"Return the name of THIS target."
(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."
(oref this name))
-(defmethod ede-name ((this ede-project))
+(cl-defmethod ede-name ((this ede-project))
"Return a short-name for THIS project file.
Do this by extracting the lowest directory 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."
(format "Project %s: %d subprojects, %d targets."
(ede-name this) (length (oref this subproj))
(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."
(format "Target %s: with %d source files."
(ede-name this) (length (oref this source))))
(ede-buffer-header-file ede-object (current-buffer))
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."
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.
Do a quick check to see if there is a Header tag in this buffer."
(with-current-buffer buffer
(ede-buffer-documentation-files ede-object (current-buffer))
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."
;; Find the info node.
(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.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
(let ((cp (ede-toplevel)))
(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.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
proj (cdr proj)))
found))
-(defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
(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."
)
;; These methods are used to determine if a target "wants", or could
;; 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."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr 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."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr src)))
src))
-(defmethod ede-target-sourcecode ((this ede-target))
+(cl-defmethod ede-target-sourcecode ((this ede-target))
"Return the sourcecode objects which THIS permits."
(let ((sc (oref this sourcetype))
(rs nil))
;;; 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."
;; Force the config to be rescanned.
(oset this config nil)
;;; 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.
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."
(oset config project proj)))
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."
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."
(let ((config (ede-config-get-configuration proj)))
(ede-commit config)))
;;; 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."
(let ((config (ede-config-get-configuration proj t)))
(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."
;; Nothing unique for the targets, use the 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.
We need to go back through the old buffers, and update them with
the new configuration."
(with-current-buffer b
(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."
;; So long as the user is trying to safe this config, make sure they can
;; get at it again later.
This class brings in method overloads for running and debugging
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."
(let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t))
(cmdsym (intern-soft (car cmdsplit))))
(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."
(let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t))
"Class to mix into a project with configuration for builds.
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.
Argument COMMAND is the command to use when compiling."
(let* ((config (ede-config-get-configuration proj t))
(comp (oref config :build-command)))
(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.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
This target brings in methods used by Semantic to query
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."
(let* ((proj (ede-target-parent this))
(root (ede-project-root proj))
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."
(let* ((proj (ede-target-parent this))
(config (ede-config-get-configuration proj)))
()
"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."
(oref (ede-config-get-configuration proj) :classpath))
;; find previous copies of this project, and make sure that one of the
;; objects is deleted.
-(defmethod initialize-instance ((this ede-cpp-root-project)
+(cl-defmethod initialize-instance ((this ede-cpp-root-project)
&rest fields)
"Make sure the :file is fully expanded."
;; Add ourselves to the master list
- (call-next-method)
+ (cl-call-next-method)
(let ((f (expand-file-name (oref this :file))))
;; Remove any previous entries from the main list.
(let ((old (eieio-instance-tracker-find (file-name-directory f)
;; This is a way to allow a subdirectory to point back to the root
;; 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)
"Return PROJ, for handling all subdirs below DIR."
proj)
;; 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
;; 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.
If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets))
;;
;; This tools also uses the ede-locate setup for augmented file name
;; 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.
This knows details about or source tree."
;; The slow part of the original is looping over subprojects.
;; This version has no subprojects, so this will handle some
;; basic cases.
- (let ((ans (call-next-method)))
+ (let ((ans (cl-call-next-method)))
(unless ans
(let* ((lf (oref proj locate-fcn))
(dir (file-name-directory (oref proj file))))
(setq ans tmp))
(setq ip (cdr ip)) ))
;; 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?
- (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."
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."
(oref this directory))
;; The following code is specific to setting up header files,
;; 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."
(save-match-data
(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.
This is for project include paths and spp source files."
;; Step one: Root of this project.
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."
(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."
(require 'semantic/db)
(let ((spp (oref this spp-table))
(oref this spp-files))
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."
(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."
(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.
Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work
(let ((default-directory (ede-project-root-directory proj)))
(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.
Argument COMMAND is the command to use for compiling the target."
(when (oref obj :project)
(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."
(message "cpp-root has nothing to rescan."))
(error "No logical target to customize"))
(ede-customize obj))
-(defmethod ede-customize ((proj ede-project))
+(cl-defmethod ede-customize ((proj ede-project))
"Customize the EDE project PROJ."
(eieio-customize-object proj 'default))
-(defmethod ede-customize ((target ede-target))
+(cl-defmethod ede-customize ((target ede-target))
"Customize the EDE TARGET."
(eieio-customize-object target 'default))
;;; Customization hooks
;;
;; 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."
(let ((ov eieio-ede-old-variables)
(nv (oref proj local-variables)))
;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified
;; changes.
-(defmethod eieio-done-customizing ((target ede-target))
+(cl-defmethod eieio-done-customizing ((target ede-target))
"Call this when a user finishes customizing TARGET."
nil)
-(defmethod ede-commit-project ((proj ede-project))
+(cl-defmethod ede-commit-project ((proj ede-project))
"Commit any change to PROJ to its file."
nil
)
"EDE Emacs Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-emacs-project)
+(cl-defmethod initialize-instance ((this ede-emacs-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-emacs-project)
+(cl-defmethod ede-project-root-directory ((this ede-emacs-project)
&optional file)
"Return the root for THIS Emacs project with 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."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
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.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
;;; 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.
All files need the macros from lisp.h!"
(require 'semantic/db)
(setq dirs (cdr dirs))))
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.
Knows about how the Emacs source tree is organized."
(let* ((ext (file-name-extension name))
'("doc"))
(t nil)))
)
- (if (not dirs) (call-next-method)
+ (if (not dirs) (cl-call-next-method)
(ede-emacs-find-in-directories name dir dirs))
))
;;; Command Support
;;
-(defmethod project-rescan ((this ede-emacs-project))
+(cl-defmethod project-rescan ((this ede-emacs-project))
"Rescan this Emacs project from the sources."
(let ((ver (ede-emacs-version (ede-project-root-directory this))))
(oset this name (car ver))
;;; 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.
Allows for one-project-object-for-a-tree type systems."
(oref this rootproject))
-(defmethod ede-project-root-directory ((this ede-project-placeholder)
+(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
&optional file)
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
(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."
(if (slot-boundp proj 'dirinode)
(oref proj dirinode)
;; the short answer we found -> ie - we are in a subproject.
(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)
"Find a subproject of PROJ that corresponds to DIR."
(if ede--disable-inode
;;; 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.
Default to making it project relative.
Argument THIS is the project to convert PATH to."
(substring fptf (match-end 0))
(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.
Default to making it project relative.
Argument THIS is the project to convert PATH to.
(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.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
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.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
;; Return it
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."
(let ((path (ede-project-root-directory this)))
(cond ((file-exists-p (expand-file-name filename path))
((file-exists-p (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.
FILENAME should be just a filename which occurs in a directory controlled
by this project."
;; Return it
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.
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
"The baseclass for all generic EDE project types."
:abstract t)
-(defmethod initialize-instance ((this ede-generic-project)
+(cl-defmethod initialize-instance ((this ede-generic-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil))
)
-(defmethod ede-project-root ((this ede-generic-project))
+(cl-defmethod ede-project-root ((this ede-generic-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
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.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
)
"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."
(oset config build-command "make -k")
(oset config debug-command "gdb ")
)
"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."
(oset config build-command "scons")
(oset config debug-command "gdb ")
)
"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."
(oset config build-command "cmake")
(oset config debug-command "gdb ")
()
"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."
)
"EDE Linux Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-linux-project)
+(cl-defmethod initialize-instance ((this ede-linux-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-linux-project)
+(cl-defmethod ede-project-root-directory ((this ede-linux-project)
&optional file)
"Return the root for THIS Linux project with 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."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
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.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
;;; 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.
All files need the macros from lisp.h!"
(require 'semantic/db)
(let ((F (expand-file-name name (expand-file-name subdir root))))
(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.
Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name))
((string-match "txt" ext)
(ede-linux-file-exists-name name dir "Documentation"))
(t nil))))
- (or F (call-next-method))))
+ (or F (cl-call-next-method))))
;;; Command Support
;;
-(defmethod project-compile-project ((proj ede-linux-project)
+(cl-defmethod project-compile-project ((proj ede-linux-project)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(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.
Argument COMMAND is the command to use for compiling the target."
(let* ((proj (ede-target-parent obj))
(compile command)))
-(defmethod project-rescan ((this ede-linux-project))
+(cl-defmethod project-rescan ((this ede-linux-project))
"Rescan this Linux project from the sources."
(let* ((dir (ede-project-root-directory this))
(bdir (ede-linux--get-build-directory dir))
)
"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."
;; Basic setup.
- (call-next-method)
+ (cl-call-next-method)
;; Make sure we have a hash table.
(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)
"Is it ok to use this project type under ROOT."
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."
(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)
"For LOC, is the file FILESTRING in our hashtable?"
(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)
"For LOC, add FILESTR to the hash with FULLFILENAME."
(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
)
"Locate with LOC occurrences of FILESUBSTRING.
(oset loc lastanswer 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
)
"Locate with LOC occurrences of FILESUBSTRING.
nil
)
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-base) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-base)) root)
"Create or update the database for the current project.
You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S"
Configure the Emacs `locate-program' variable to also
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)
"Is it ok to use this project type under ROOT."
(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)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.")
-(defmethod initialize-instance ((loc ede-locate-global)
+(cl-defmethod initialize-instance ((loc ede-locate-global)
&rest slots)
"Make sure that we can use GNU Global."
(require 'cedet-global)
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(cedet-gnu-global-version-check)
(let* ((default-directory (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)
"Is it ok to use this project type under ROOT."
(require 'cedet-global)
(newroot (cedet-gnu-global-root)))
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)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(let ((default-directory (oref loc root)))
(cedet-gnu-global-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-global) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root))
Configure EDE's use of IDUtils through the cedet-idutils.el
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)
"Make sure that we can use IDUtils."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-idutils)
(cedet-idutils-version-check)
(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)
"Is it ok to use this project type under ROOT."
(require 'cedet-idutils)
(when (cedet-idutils-support-for-directory 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)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(let ((default-directory (oref loc root)))
(cedet-idutils-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-idutils) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root))
Configure EDE's use of Cscope through the cedet-cscope.el
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)
"Make sure that we can use Cscope."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-cscope)
(cedet-cscope-version-check)
(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)
"Is it ok to use this project type under ROOT."
(require 'cedet-cscope)
(when (cedet-cscope-support-for-directory 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)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-cscope) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-cscope)) root)
"Create or update the GNU Global database for the current project."
(require 'cedet-cscope)
(cedet-cscope-create/update-database root))
don't do it. A value of nil means to just do it.")
;;; 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."
(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."
(let ((f (ede-expand-filename (ede-toplevel this) file t)))
(when (not (file-exists-p f))
(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."
(let ((b (find-file-noselect (ede-proj-configure-file this)))
;;(td (file-name-directory (ede-proj-configure-file this)))
))))
-(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."
(if (not (ede-proj-configure-file this))
(error "Could not determine configure.ac for %S" (eieio-object-name this)))
(if b (kill-buffer b)))
(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."
;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers.
(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.
By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
;; @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.
Results in --add-missing being passed to automake."
nil)
;; @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."
nil)
(declare-function ede-srecode-insert "ede/srecode")
;;; 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.
MFILENAME is the makefile to generate."
(require 'ede/srecode)
(setq name (replace-match "_" nil t 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."
(concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG"))
;;; 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.
Argument THIS is the target to get sources from."
nil)
;;; GENERIC VARIABLES
;;
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(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.
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."
(let ((conf-table (ede-proj-makefile-configuration-variables
this (oref this configuration-default)))
(insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " "
(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
moresource)
"Insert the source variables needed by THIS.
(if 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)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
(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)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(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)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
- (call-next-method)
+ (cl-call-next-method)
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
(ede-linker-only-once 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))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
;;; 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.
These are removed with make clean."
(let ((mc (ede-map-targets
(setq mc (cdr mc)))
(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.
These are removed with make clean."
;; Get the source object from THIS, and use the specified garbage.
;;; 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 ".PHONY:" (ede-name this))
(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."
(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.
Argument THIS is the project that should insert stuff."
(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.
Argument THIS is the target that should insert stuff."
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.
Argument THIS is the target that should insert stuff."
(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."
(proj-comp-insert-variable-once "SUBDIRS"
(ede-map-subprojects
(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."
(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."
(let ((junk (ede-proj-makefile-garbage-patterns this))
tmp)
"\t@false\n\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."
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."
(mapc 'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers 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.
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-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.
This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with
automake."
(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."
(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.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
out))))
;; 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.
Argument THIS is the project to create tags for.
Argument TARGETS are the targets we should depend on for TAGS."
:objectextention "")
"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)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
(concat "lib" (ede-name this) "_a_LIBRARIES")
(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))
"Add archive name to the garbage patterns.
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")))))
(provide 'ede/proj-archive)
:sourcepattern "^[A-Z]+$\\|\\.txt$")
"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."
(concat (ede-pmake-varname this) "_AUX"))
This is used when creating a Makefile to prevent duplicate variables and
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
`ede-compiler-list'."
(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
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
(car-safe linkers))
;;; 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."
(mapcar
(lambda (obj)
)
(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."
nil)
))
(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."
(if (eieio-instance-inheritor-slot-boundp this 'variables)
(with-slots (variables) this
(insert cd)))))
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.
If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
+(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(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)
"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
sourcefiles)
(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."
(ede-compiler-only-once this
(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."
(if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\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.
The object creating makefile rules must call this method for the
compiler it decides to use after inserting in the rule."
"This target consists of a group of lisp files.
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.
This inserts the PRELOADS target-local variable."
(let ((preloads (oref this pre-load-packages)))
(mapconcat 'identity preloads " ")))))
(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.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
"Compile Emacs Lisp programs with XEmacs.")
;;; 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.
Lays claim to all .elc files that match .el files in this target."
(if (string-match "\\.elc$" (buffer-file-name buffer))
;; Is this in our list.
(member fname (oref this auxsource))
)
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;;; Emacs Lisp Compiler
packages (cdr packages))))
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.
Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((proj (ede-target-parent obj))
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
(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.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
(insert version)))))
(setq vs (cdr vs)))
;; The next method will include comments such as "Version:"
- (call-next-method))))
+ (cl-call-next-method))))
;;; 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."
(cond ((ede-proj-automake-p) '("lisp_LISP" . share))
(t (concat (ede-pmake-varname this) "_LISP"))))
(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."
(let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath
)
(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."
- (call-next-method)
+ (cl-call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
(enable-local-variables nil))
(save-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."
;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
;;; 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.
Lays claim to all .elc files that match .el files in this target."
(if (string-match
(concat (regexp-quote (oref this autoload-file)) "$")
(buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;; Compilers
)
"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.
If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler)))
(setq comp (list (car avail)))))
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
moresource)
"Insert the source variables needed by THIS.
sources variable."
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."
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.
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."
(ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file)))
" ")))
)
-(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."
(require 'cedet-autogen)
(let ((default-directory (ede-expand-filename obj ".")))
(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.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
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.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
(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.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info 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."
(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."
nil)
;;; Makefile generation
;;
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(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."
(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)
"Insert the source variables needed by THIS info target.
Optional argument MORESOURCE is a list of additional sources to add to the
Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode."
(if (not (ede-proj-automake-p))
- (call-next-method)
+ (cl-call-next-method)
(let* ((sv (ede-proj-makefile-sourcevar this))
(src (copy-sequence (oref this source)))
(menu (or (oref this menu) (car src))))
(kill-buffer buffer))
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."
;; The target should be the main-menu file name translated to .info.
(let* ((source (if (not (string= (oref this mainmenu) ""))
(info (ede-makeinfo-find-info-filename source)))
(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.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
(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.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
; n
; (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."
(let ((mm (oref this mainmenu))
(s (oref this source))
;; Make sure that MM is first in the list of items.
(setq nl (cons mm (delq mm s)))
(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.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
)
"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."
(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))
"Return a list of files which THIS target depends on."
(with-slots (submakefile) this
nil)
(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."
;; DO NOT call the next method. We will never have any compilers,
;; or any dependencies, or stuff like this. This rule will let us
;;; 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."
- (call-next-method)
+ (cl-call-next-method)
(if (eieio-instance-inheritor-slot-boundp this 'dependencyvar)
(with-slots (dependencyvar) this
(insert (car dependencyvar) "=")
;;; EDE Object target type methods
;;
-(defmethod ede-proj-makefile-sourcevar
+(cl-defmethod ede-proj-makefile-sourcevar
((this ede-proj-target-makefile-objectcode))
"Return the variable name for THIS's sources."
(require 'ede/pmake)
(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))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
(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)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies
(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)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves.
(let ((h (oref this auxsource)))
;; Add more logic here when the problem is better understood.
)
"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))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared "bin_PROGRAMS"
(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))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared
(when (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."
- (call-next-method)
+ (cl-call-next-method)
(let ((lf (mapconcat 'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this
(if ldlibs
(when (and lf (not (string= "" 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."
(let ((tb (get-buffer-create " *padt*"))
(dd (if (not (string= (oref obj path) ""))
(funcall ede-debug-program-function cmd))
(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.
Optional COMMAND is the command to run in place of asking the user."
(require 'ede/shell)
)
"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."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
"\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))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig")
(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))
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
(ede-pmake-insert-variable-shared "lib_LTLIBRARIES"
(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))
"Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element."
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."
;; We need some platform gunk to make the .so change to .sl, or .a,
;; depending on the platform we are going to compile against.
(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."
(if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am)
(concat "lib" (oref this name) "_la_SOURCES")
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'ede/proj-shared)
;; Restore the directory slot
(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."
(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.
Argument PROJ is the project to save."
- (call-next-method)
+ (cl-call-next-method)
(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.
Argument TARGET is the project we are completing customization on."
- (call-next-method)
+ (cl-call-next-method)
(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."
(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."
(let ((f (ede-convert-path this (buffer-file-name buffer))))
(or (string= (file-name-nondirectory (oref this file)) f)
(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."
- (or (call-next-method)
+ (or (cl-call-next-method)
(ede-target-buffer-in-sourcelist this buffer (oref this auxsource))))
\f
(defvar ede-proj-target-history nil
"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)
"Create a new target in THIS based on the current buffer."
(let* ((name (or name (read-string "Name: " "")))
;; And save
(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."
(let* ((name (read-string "Name: " ""))
(type (completing-read "Type: " ede-proj-target-alist
:path (ede-convert-path this default-directory)
: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."
(let ((p (ede-current-project))
(ts (oref this source)))
(oset p targets (delq this (oref p targets)))
(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."
(let ((file (ede-convert-path this file))
(src (ede-target-sourcecode this)))
(t (error "`project-add-file(ede-target)' source mismatch error")))
(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.
FILE must be massaged by `ede-convert-path'."
;; Speedy delete should be safe.
(object-remove-from-list target 'auxsource (ede-convert-path target file))
(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."
(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."
(let ((pm (ede-proj-dist-makefile this))
(df (project-dist-files this)))
(file-name-directory pm))))
(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."
(list
;; Note to self, keep this first for the above fn to check against.
(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.
Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj))
;;; 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.
Argument COMMAND is the command to use for compiling the target."
(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)
"Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use."
(compile (concat ede-make-command " -f " (oref obj makefile) " "
(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."
(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."
(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."
(ede-name this))
\f
;;; 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."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr 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.
If the `compiler' slot is empty, concoct one on a first match found
basis for any given type from the `availablecompilers' slot.
;; Return the discovered compilers.
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.
If the `linker' slot is empty, concoct one on a first match found
basis for any given type from the `availablelinkers' slot.
"Return non-nil if the current project PROJ is automake mode."
(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."
(cond ((eq (oref this makefile-type) 'Makefile.am)
(concat (file-name-directory (oref this file))
(interactive)
(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.
MFILENAME is the makefile to generate."
;; For now, pass through until dirty is implemented.
(file-newer-than-file-p (oref this file) 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)
"Setup the build environment for project THIS.
Handles the Makefile, or a Makefile.am configure.ac combination.
\f
;;; Lower level overloads
;;
-(defmethod project-rescan ((this ede-proj-project))
+(cl-defmethod project-rescan ((this ede-proj-project))
"Rescan the EDE proj project THIS."
(let ((root (or (ede-project-root this) this))
)
"Encode one makefile.")
;;; 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.
OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target")
(save-buffer))
(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."
(ede-with-projectfile ot
(makefile-move-to-macro (project-am-macro ot))
(save-buffer))
(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."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
(if (= (point-min) (point))
(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)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
;; This should be handled at the EDE level, calling a method of the
;; 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.
Argument COMMAND is the command to use when compiling."
(require 'compile)
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(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.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
;; We better be in the right place when compiling a specific target.
(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."
(let ((tb (get-buffer-create " *padt*"))
(dd (oref obj path))
(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."
(require 'ede/shell)
(let ((tb (get-buffer-create " *padt*"))
(ede-shell-run-something obj cmd))
(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."
(require 'compile)
(if (not project-am-compile-project-command)
ampf))))
;;; 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."
(oref proj targets))
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."
(project-am-with-makefile-current (file-name-directory (oref this file))
;;(message "Scanning %s..." (oref this file))
)))
-(defmethod project-rescan ((this project-am-program))
+(cl-defmethod project-rescan ((this project-am-program))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(oset this :ldadd (makefile-macro-file-list
(concat (oref this :name) "_LDADD"))))
-(defmethod project-rescan ((this project-am-lib))
+(cl-defmethod project-rescan ((this project-am-lib))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(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."
(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."
(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."
(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."
(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."
(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."
(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."
(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."
"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."
"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."
"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."
"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."
(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."
(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."
"lisp_LISP")
sobj (cdr sobj)))
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."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this :file) efn)
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."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(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."
(let ((bfn (file-relative-name (buffer-file-name buffer)
(oref this :path))))
(or (string= (oref this :name) bfn)
(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."
(string= (oref this :name)
(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."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(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."
(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."
;; 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."
(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."
(let ((n (oref this :name)))
(if (string-match "\\.texi?\\(nfo\\)?" n)
(t
'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."
- (or (call-next-method)
+ (or (cl-call-next-method)
(let ((s (oref this source))
(found nil))
(while (and s (not found))
(setq s (cdr s)))
found)))
-(defmethod ede-documentation ((this project-am-texinfo))
+(cl-defmethod ede-documentation ((this project-am-texinfo))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
(project-am-extract-package-info dir)))
;; 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
per file or in .dir-locals.el or similar."
(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
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
(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.
COMMAND is a text string representing the thing to be run."
(let* ((buff (ede-shell-buffer target))
(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."
(let ((name (ede-name target)))
(get-buffer-create (format "*EDE Shell %s*" name))))
"EDE Simple project class.
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."
(when (not (file-exists-p ede-simple-save-directory))
(if (y-or-n-p (concat ede-simple-save-directory
(error "No save directory for new project")))
(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)
"Return PROJ, for handling all subdirs below DIR."
proj)
;;; 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
`ede-compiler-list'."
(let ((lst ede-sourcecode-list))
;; Add to the beginning of the 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."
(or (ede-want-file-source-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 ."
(let ((case-fold-search nil))
(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 ."
(let ((case-fold-search nil))
(and (slot-boundp this 'auxsourcepattern)
(oref this auxsourcepattern)
(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."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-source-p this (pop filenames))))
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."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-auxiliary-p this (pop filenames))))
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."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-p this (pop filenames))))
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.
Used to guess header files, but uses the auxsource regular expression."
(let ((dn (file-name-directory filename))
(setq depth (1- depth)))
(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.
Optional DEPTH is the depth we start at."
(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.
Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj)))
(concat (eieio-speedbar-derive-line-path proj)
(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."
(ede-description obj))
-(defmethod eieio-speedbar-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-description ((obj ede-target))
"Provide a speedbar description for 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.
A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-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."
(if (ede-parent-project object)
(ede-name object)
(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."
(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."
(condition-case nil
(with-slots (subproj targets) this
(append subproj targets))
(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."
(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.
It has depth DEPTH."
(with-slots (source) this
(project-update-version ede-object)
(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.
Handle saving, or other detail."
(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.
In project THIS, cycle over all targets to give them a chance to set
their sources to VERSION."
(ede-map-targets this (lambda (targ)
(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."
(if (and (slot-boundp this 'versionsource)
(oref this versionsource))
;;
;; Simple methods against the context classes.
;;
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze."
)
desired-type))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-functionarg))
"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))
"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))
"Return a tag from CONTEXT that would be most interesting to a user."
(let ((prefix (reverse (oref context :prefix))))
;; Return the found tag, or nil.
(car prefix)))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-functionarg))
"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))
"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
;;
;;
(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."
(require 'pulse)
(with-current-buffer (oref context :buffer)
(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."
(semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
(semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
(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."
(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."
(semantic-analyze-princ-sequence (oref context function) "Function: ")
(princ "Argument Index: ")
(princ (oref context index))
(princ "\n")
(semantic-analyze-princ-sequence (oref context argument) "Argument: ")
- (call-next-method))
+ (cl-call-next-method))
(defun semantic-analyze-pop-to-context (context)
"Display CONTEXT in a temporary buffer.
;;
;; These accessor methods will calculate the useful bits from the context, and cache values
;; 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.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
allhits)
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.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
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."
(let* ((nonterm (oref frame nonterm))
(pb (oref semantic-debug-current-interface parser-buffer))
(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."
(message "%S" (oref frame collection))
)
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."
;; 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."
(message "Error: %S" (oref frame condition)))
The only options available for completion are those which can be logically
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)
"calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them.
prefix
(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."
nil)
-(defmethod semantic-collector-next-action
+(cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
'complete-whitespace)))
'complete))
-(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+(cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj '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.
Calculate the cache if there isn't one."
(or (oref obj cache)
(semantic-collector-calculate-cache obj)))
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format."
(if result
(list (cons table result)))))
-(defmethod semantic-collector-calculate-completions
+(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
)))
))
-(defmethod semantic-collector-try-completion-whitespace
+(cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching
)))
-(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.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp 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."
(when (slot-boundp 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.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp obj 'current-exact-match)
(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)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
(when (slot-boundp 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)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
(if (slot-boundp obj 'last-completion)
(oref obj last-completion)))
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
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."
(oset this cache nil)
(slot-makeunbound this 'last-prefix)
These collectors track themselves on a per-buffer basis."
:abstract t)
-(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+(cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
(if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
- (let ((new (call-next-method)))
+ (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new)
(setq old new)))
(slot-makeunbound old 'last-completion)
When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'"
"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)
"Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
(declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(require 'semantic/db-find)
"The scope the local members are being completed from."))
"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)
"Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope)
a collector, and tracking tables of completion to display."
: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."
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."
(if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB)
'scroll
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
(oset obj table table)
(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."
(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."
(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)."
(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."
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."
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.
This object type doesn't do focus, so will never have a focus object."
nil)
Completions are showin in a new buffer and listed with the ability
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."
;; NOTE TO SELF. Find the character to type next, and emphasize it.
which have the same name."
: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."
(if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text))
'focus)
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(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.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
)
)))
-(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.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
(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."
(when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj
(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."
(if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table)
;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever
- (call-next-method)))
+ (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting.
multiple tags with the same name done by 'focusing' on the source
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))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting
"Display completions options in a tooltip.
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."
(condition-case nil
(require 'tooltip)
(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."
(if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer.
- (call-next-method)
+ (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table))
tooltip-frame-parameters)
(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)."
;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30)
Whichever completion is currently in focus will be displayed as ghost
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."
- (let ((ans (call-next-method))
+ (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table)
(oref obj table))))
(if (and (eq ans 'displayend)
nil
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."
(when (slot-boundp 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)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(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."
; (if (oref obj first-show)
; (progn
;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost
;; text display.
-; (call-next-method)
+; (cl-call-next-method)
; )
)
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible
()
"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.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
;;; 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)
"Create a new semantic database for DIRECTORY based on ebrowse.
If there is no database for DIRECTORY available, then
db)))
-(defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
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
;;;
;; 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.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAGS
(setq tags (cdr tags))))
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.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAG
;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
;; 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)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
(if tags
;; 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.
;; Since ebrowse tags are converted into semantic tags, we can
;; 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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; 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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; 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)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
- (call-next-method)))
+ (if tags (cl-call-next-method)
+ (cl-call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;(semanticdb-find-tags-for-completion-method table prefix tags)
- (call-next-method))
+ (cl-call-next-method))
;;; 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)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
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.
;; but we can't use it.... yet.
nil
)
"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.
It does not need refreshing."
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."
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'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
)
"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'.
Adds the number of tags in this file to the object print name."
(let ((count 0))
;;; 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.
Create one of our special tables that can act as an intermediary."
;; We need to return something since there is always the "master table"
(oset newtable parent-db obj)
(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.
For Emacs Lisp, creates a specialized table."
(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."
;; specialty table ? Probably derive tags at request time.
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.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(with-current-buffer buffer
(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.
For Emacs Lisp system DB, there isn't one."
nil)
;;; 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."
(let ((newtags nil))
(dolist (T tags)
;; There is no promise to have files associated.
(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.
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
(defvar semanticdb-elisp-mapatom-collector nil
"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)
"Find all tags named NAME in TABLE.
Uses `intern-soft' to match NAME to Emacs symbols.
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.
(let* ((sym (intern-soft name))
(fun (semanticdb-elisp-sym->tag sym 'function))
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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Uses `apropos-internal' to find matches.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(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)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; We could implement this, but it could be messy.
nil))
;;; Deep 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)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; 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)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; EIEIO is the only time this matters
(when (featurep 'eieio)
(let* ((class (intern-soft type))
;;; Code:
;;
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database-file))
directory)
"Create a new semantic database for DIRECTORY and return it.
If a database for DIRECTORY has already been loaded, return it.
"Return the project belonging to FILENAME if it was already loaded."
(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)
"Does the directory the database DB needs to write to exist?
If SUPPRESS-QUESTIONS, then do not ask to create the directory."
(setq semanticdb--inhibit-make-directory t))
nil))))
-(defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
&optional
suppress-questions)
"Write out the database DB to its file.
)
))
-(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.
Live databases are objects associated with existing directories."
(and (slot-boundp 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.
Live files are either buffers in Emacs, or files existing on the filesystem."
(let ((full-filename (semanticdb-full-filename obj)))
(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.
Restore the overlays after writing.
Argument OBJ is the object to write."
;; Do it!
(condition-case tableerror
- (call-next-method)
+ (cl-call-next-method)
(error
(when semanticdb-data-debug-on-write-error
(require 'data-debug)
;;; 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.
Uses `semanticdb-persistent-path' to determine the return value."
(let ((path semanticdb-persistent-path))
(throw 'found t))
(t (error "Invalid path %S" (car path))))
(setq path (cdr path)))
- (call-next-method))
+ (cl-call-next-method))
))
;;; 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."
;; Cheater option. In this case, we always have files directly
;; under ourselves. The main project type may not.
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
-(defmethod semanticdb-file-name-non-directory :STATIC
- ((dbclass semanticdb-project-database-file))
+(cl-defmethod semanticdb-file-name-non-directory
+ ((dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
-(defmethod semanticdb-file-name-directory :STATIC
- ((dbclass semanticdb-project-database-file) directory)
+(cl-defmethod semanticdb-file-name-directory
+ ((dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory
file (file-name-as-directory semanticdb-default-save-directory)))
directory))
-(defmethod semanticdb-cache-filename :STATIC
- ((dbclass semanticdb-project-database-file) path)
+(cl-defmethod semanticdb-cache-filename
+ ((dbclass (subclass semanticdb-project-database-file)) 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
name in a secondary directory."
(concat (semanticdb-file-name-directory dbclass path)
(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."
(oref obj file))
"Concrete search index for `semanticdb-find'.
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."
(require 'semantic/scope)
;; Clear the include path.
(semantic-scope-reset-cache)
)
-(defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
(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)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; Only reset if include statements changed.
;; Override these with system databases to as new types of back ends.
;;; 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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-included (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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(require 'semantic/find)
(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.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table))))
;;; 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.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
Return a table of all matching tags."
(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.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
Return a table of all matching tags."
(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.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
)
"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'.
Adds the number of tags in this file to the object print name."
(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.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
;;; 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 each file hit, get the traditional semantic table from that file."
;; We need to return something since there is always the "master table"
(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."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
;;
;; 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)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; 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.
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-name name 'project))
(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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project))
)
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-completion prefix 'project))
(faketags nil)
;; alone, otherwise replace with implementations similar to those
;; 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)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; 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.
Create one of our special tables that can act as an intermediary."
;; NOTE: This method overrides an accessor for the `tables' slot in
(oset newtable parent-db obj)
(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."
;; NOTE: See not for `semanticdb-get-database-tables'.
(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."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(setq tags (cdr tags)))
result))
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; 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)
))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(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)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; Note: This search method could be considered optional in an
;; alone, otherwise replace with implementations similar to those
;; 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)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(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)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(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)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; 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)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; OPTIONAL: This could be considered an optional function. It is
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'semantic)
(require 'semantic/db)
(require 'semantic/tag)
;; For the semantic-find-tags-by-name-regexp macro.
(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)
"Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG. The reference
(object-add-to-list refdbt 'db-refs dbt)
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.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
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."
(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.
Any reference to a file that cannot be found, or whos file no longer
refers to DBT will be removed."
))
(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."
;; alternate tables can't be edited, so can't be changed.
nil
)
-(defmethod semanticdb-refresh-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
"Refresh references to DBT in other files."
(let ((refs (semanticdb-includes-in-table dbt))
)
(setq refs (cdr refs)))
))
-(defmethod semanticdb-notify-references ((dbt semanticdb-table)
+(cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
method)
"Notify all references of the table DBT using method.
METHOD takes two arguments.
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-typecache))
"Reset the object IDX."
(oset tc filestream nil)
(oset tc includestream 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."
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
-(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
new-tags)
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
(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.
If there is no table, create one, and fill it in."
(semanticdb-refresh-table table)
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."
(let* ((idx (semanticdb-get-table-index table)))
(oref idx type-cache)))
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-database-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-database-typecache))
"Reset the object IDX."
(oset tc stream nil)
)
-(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
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)
"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.
If there is no table, create one, and fill it in."
(semanticdb-cache-get db 'semanticdb-database-typecache)
namespaces instead."
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."
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.
File-tags are those that belong to this file only, and excludes
all included files."
(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."
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.
Include-tags are the tags brought in via includes, all merged together into
a master list."
(types (semantic-find-tags-by-class 'type 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)
"Search the typecache in TABLE for the datatype TYPE.
If type is a string, split the string, and search for the parts.
;;
;; Routines for a typecache that crosses all tables in a given database
;; 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)
"Return the typecache for the project database DB.
If there isn't one, create it.
for a new table not associated with a buffer."
: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."
nil)
-(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
"Return a buffer associated with OBJ.
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
;; This generic method allows for sloppier coding. Many
;; functions treat "table" as something that could be a buffer,
;; file name, or other. This makes use of table more robust.
-(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.
This uses semanticdb to get a better file name."
(cond ((bufferp buffer-or-string)
((and (stringp buffer-or-string) (file-exists-p 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.
Abstract tables do not have file names associated with them."
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'."
nil)
-(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
"Mark the abstract table OBJ dirty.
Abstract tables can not be marked dirty, as there is nothing
for them to synchronize against."
;; The abstract table can not be dirty.
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.
The default is to return TAGS.
Some databases may default to searching and providing simplified tags
them to convert TAG into a more complete form."
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.
This method returns a list of the form (DATABASE . NEWTAG).
them to convert TAG into a more complete form."
(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'.
Adds the number of tags in this file to the object print name."
(if (or (not strings)
(and (= (length strings) 1) (stringp (car strings))
(string= (car strings) "")))
;; 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.
(apply 'call-next-method obj strings)
))
needed, or perhaps create hash or index tables for the current buffer."
: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.
If one doesn't exist, create it."
(if (slot-boundp obj 'index)
(oset obj index idx)
idx)))
-(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; 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)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
Examples include search results from external sources such as from
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.
This will call `semantic-fetch-tags' if that file is in memory."
nil)
)
"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.
If the buffer is in memory, return that buffer."
(let ((buff (oref obj buffer)))
buff
(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.
If the buffer is in memory, return that buffer.
If the buffer is not in memory, load it with `find-file-noselect'."
(save-match-data
(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.
If OBJ's file is not loaded, read it in first."
(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."
(expand-file-name (oref obj file)
(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'."
(oref obj dirty))
-(defmethod semanticdb-set-dirty ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
"Mark the abstract table OBJ dirty."
(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'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj
:documentation "List of `semantic-db-table' objects."))
"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.
Abstract tables do not have file names associated with them."
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'.
A database is dirty if the state of the database changed in a way
where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs)))
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'.
Adds the number of tables in this file to the object print name."
(apply 'call-next-method obj
)
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.
If a database for DIRECTORY has already been created, return it.
If DIRECTORY doesn't exist, create a new one."
(oset db reference-directory (file-truename directory)))
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."
(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.
The class of DB contains the class name for the type of table to create.
If the table for FILE exists, return it.
(object-add-to-list db 'tables newtab t))
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."
(object-assoc (file-relative-name (file-truename filename)
(oref obj reference-directory))
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
desired-class)
"Get a cache object on TABLE of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
(object-add-to-list table 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
cache)
"Remove from TABLE the cache object 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)
"Synchronize a CACHE with some NEW-TAGS."
;; 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)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-get ((db semanticdb-project-database)
desired-class)
"Get a cache object on DB of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
(object-add-to-list db 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-remove ((db semanticdb-project-database)
cache)
"Remove from TABLE the cache object 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)
"Synchronize a CACHE with some NEW-TAGS."
;; 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)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
;;; 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.
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
;; Kill off the buffer if it didn't exist when we were called.
(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.
The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj))
\f
;;; Synchronization
;;
-(defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE with some NEW-TAGS."
(oset table tags new-tags)
(semanticdb-refresh-references table)
)
-(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE where some NEW-TAGS changed."
;; You might think we need to reset the tags, but since the partial
;;; SAVE/LOAD
;;
-(defmethod semanticdb-save-db ((DB semanticdb-project-database)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database)
&optional suppress-questions)
"Cause a database to save itself.
The database base class does not save itself persistently.
predicates with `add-hook' to this variable, and semanticdb will save tag
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.
Uses `semanticdb-persistent-path' to determine the return value."
nil)
,@body))
(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.
See `semanticdb-equivalent-mode' for details.
This version is used during searches. Major-modes that opt
(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.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
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.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(eval-when-compile (require 'semantic/find))
;;; Code:
"Controls action when in `semantic-debug-mode'")
;; 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."
(if frame
(oset iface current-frame 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."
(with-current-buffer (oref iface parser-buffer)
(if (not (slot-boundp iface 'parser-location))
(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."
(with-current-buffer (oref iface source-buffer)
(if (not (slot-boundp iface 'source-location))
(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."
(delete-other-windows)
;; Deal with the data buffer
(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 .
TOKEN is a lexical token."
(set-buffer (oref iface :source-buffer))
(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.
NONTERM is the name of the rule currently being processed that shows up
as a nonterminal (or tag) in the source buffer.
))))
-(defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
"Remove all debugging overlays."
(mapc 'semantic-overlay-delete (oref iface overlays))
(oset iface overlays nil))
)
"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."
)
-(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."
)
down to your parser later."
: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."
(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."
(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."
(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."
(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."
(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."
(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."
(with-slots (current-frame) semantic-debug-current-interface
(when 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."
)
;; 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.
A frame is of the form:
( .. .what ? .. )
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."
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
))
))
-(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize CACHE with some NEW-TAGS."
(if (semantic-find-tags-by-class 'include new-tags)
(semantic-reset cache)))
-(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
A grammar target consists of grammar files that build Emacs Lisp programs for
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.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
"Compile Emacs Lisp programs.")
;;; 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.
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
;; is common to have only one target of this class per directory.
(if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
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."
(let* ((cb (current-buffer))
(proj (ede-target-parent obj))
;;; 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."
(cond ((ede-proj-automake-p)
(error "No Automake support for Semantic Grammars"))
(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."
(ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath
" ")))
)
-(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.
This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
needed for the compilation of the resulting parsers."
max-lisp-eval-depth 700)'\n"
(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.
This makes sure that all grammar lisp files are created before the dist
runs, so they are always up to date.
Argument THIS is the target that should insert stuff."
- (call-next-method)
+ (cl-call-next-method)
(insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
)
)))
-(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."
(let ((sym (car (reverse (oref context prefix))))
(doc nil))
;; This is from semantic-sb
'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."
(let ((prefix (oref context prefix)))
(when prefix
'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."
- (call-next-method)
+ (cl-call-next-method)
(let ((assignee (oref context assignee)))
(when assignee
(speedbar-insert-separator "Assignee")
'speedbar-tag-face
'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."
- (call-next-method)
+ (cl-call-next-method)
(let ((func (oref context function)))
(when func
(speedbar-insert-separator "Function")
)
"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."
(condition-case nil
(save-excursion
(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.
Uses `semantic-go-to-tag' and highlighting."
(require 'semantic/decorate)
(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.
POINT is some important location.
REASON is a symbol. See slot `reason' on `semantic-bookmark'."
(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.
If there is a buffer match, unlink the tag."
(let ((tag (oref sbm tag))
(when nearby (setq tag nearby))))
tag))
-(defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
+(cl-defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
&optional reason)
"Add a bookmark to the ring SBR from POINT.
REASON is why it is being pushed. See doc for `semantic-bookmark'
;;
;; 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."
(oset obj tag nil)
(oset obj scopetypes nil)
(oset obj typescope nil)
)
-(defmethod semanticdb-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
-(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; If there are any includes or datatypes changed, then clear.
'semantic-scope-cache)))
(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)
"Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are
;;; 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."
(require 'semantic/analyze)
(semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
)
"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."
(if (slot-boundp result :hit-files)
(oref result hit-files)
(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)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
`semantic-symref-tool'"
: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.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
)
))
-(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."
(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)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
(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."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
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."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(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.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
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."
(let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype)
(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.
Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file)
:group 'semantic
: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."
;; Grep doesn't support some types of searches.
(let ((st (oref tool :searchtype)))
;; Return the answer
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.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
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."
(let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype)
(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.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'srecode/table)
(require 'srecode/dictionary)
Plain text strings are not handled via this baseclass."
:abstract t)
-(defmethod srecode-parse-input ((ins srecode-template-inserter)
+(cl-defmethod srecode-parse-input ((ins srecode-template-inserter)
tag input STATE)
"For the template inserter INS, parse INPUT.
Shorten input only by the amount needed.
STATE is the current compilation state."
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?"
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."
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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
"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)
"Add PROMPTTAG to the current list of prompts."
(with-slots (prompts) state
;; 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."
(princ "== Template \"")
(princ (eieio-object-name-string tmp))
(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."
(princ "INS: \"")
(princ (eieio-object-name-string ins))
(eval-when-compile (require 'cl))
(require 'eieio)
+(require 'cl-generic)
(require 'srecode)
(require 'srecode/table)
(eval-when-compile (require 'semantic))
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)
"Initialize the compound variable THIS.
Makes sure that :value is compiled."
;;(when (not state)
;; (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))
(let ((val (oref this :value))
(comp nil))
))
dict))))
-(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
tpl)
"Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file."
(setq tabs (cdr tabs))))))
-(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value)
"In dictionary DICT, set NAME to have VALUE."
;; Validate inputs
(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)
"In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.
;; Return the new sub-dictionary.
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."
;; Validate inputs
(unless (stringp name)
(srecode-dictionary-add-section-dictionary dict name t)
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."
;; We need to find the has value, and then delete it.
;; Validate inputs
(remhash name namehash))
nil)
-(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state)
"Add ENTRIES to DICT.
(setq entries (nthcdr 2 entries)))
dict)
-(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
+(cl-defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
&optional force)
"Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are
(srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash))))
-(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name &optional non-recursive)
"Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the
(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.
The root dictionary is usually for a current or active insertion."
(let ((ans dict))
;; Compound values must provide at least the toString method
;; 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
dictionary)
"Convert the compound dictionary value CP to a string.
standard out is a buffer, and using `insert'."
(eieio-object-name cp))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent)
"Display information about this compound value."
(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
dictionary)
"Convert the compound dictionary variable value CP into a string.
(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)
"Display information about this compound value."
(require 'srecode/compile)
it is referenced a second time. This compound value can then be
inserted with a new editable field.")
-(defmethod srecode-compound-toString((cp srecode-field-value)
+(cl-defmethod srecode-compound-toString((cp srecode-field-value)
function
dictionary)
"Convert this field into an insertable string."
(srecode-dump dict))
))))
-(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
+(cl-defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
"Dump a dictionary."
(if (not indent) (setq indent 0))
(maphash (lambda (key entry)
)
"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."
(oset st lastinserter ins)
(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."
(oset st anchor (point)))
-(defmethod srecode-extract-state-extract ((st srecode-extract-state)
+(cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
endpoint)
"Perform an extraction on the extract state ST with ENDPOINT.
If there was no waiting inserter, do nothing."
(srecode-extract-method template dict state)
dict))))
-(defmethod srecode-extract-method ((st srecode-template) dictionary
+(cl-defmethod srecode-extract-method ((st srecode-template) dictionary
state)
"Extract template ST and store extracted text in DICTIONARY.
Optional STARTRETURN is a symbol in which the start of the first
;;; 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."
nil)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
start end dict state)
"Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing."
;;; 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."
'later)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
start end vdict state)
"Extract text from START/END and store in VDICT.
Return t if something was extracted.
;;; 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."
'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)
"Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match.
;;; 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."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
start end dict state)
"Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match.
;; Keep this library independent of SRecode proper.
(require 'eieio)
+(require 'cl-generic)
;;; Code:
(defvar srecode-field-archive nil
"An object that gets automatically bound to an overlay.
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."
;; Extract :start and :end from the olaid list.
(let ((newargs nil)
(overlay-put olay 'srecode-init-only t)
(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."
(let* ((ola (oref olaid overlay))
(start (overlay-start ola))
))
-(defmethod srecode-delete ((olaid srecode-overlaid))
+(cl-defmethod srecode-delete ((olaid srecode-overlaid))
"Delete the overlay from OLAID."
(delete-overlay (oref 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."
(= 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."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(- 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."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(setq ol (cdr ol)))
(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.
If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(let* ((ol (oref olaid overlay))
)
"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)
"Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields
(setq srecode-field-archive nil)
;; 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 all our fields
(srecode-overlaid-activate F))
;; Activate our overlay.
- (call-next-method)
+ (cl-call-next-method)
;; Position the cursor at the first field
(let ((first (car (oref ir fields))))
(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."
;; Clear us out of the baseclass.
(oset ir active-region nil)
;; Clear our fields.
(mapc 'srecode-delete (oref ir fields))
;; Call to our base
- (call-next-method)
+ (cl-call-next-method)
;; Clear our hook.
(remove-hook 'post-command-hook 'srecode-field-post-command t)
)
km)
"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."
(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."
- (call-next-method)
+ (cl-call-next-method)
(let* ((ol (oref field overlay))
(end nil)
)
)
-(defmethod srecode-delete ((olaid srecode-field))
+(cl-defmethod srecode-delete ((olaid srecode-field))
"Delete our secondary overlay."
;; Remove our spare overlay
(delete-overlay (oref olaid tail))
(slot-makeunbound olaid 'tail)
;; Do our baseclass work.
- (call-next-method)
+ (cl-call-next-method)
)
(defvar srecode-field-replication-max-size 100
(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-char (overlay-start (oref field overlay))))
;;
;; Find if a template table has a project set, and if so, is the
;; 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.
If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t."
;;
;; Find a given template based on name, and features of the current
;; buffer.
-(defmethod srecode-template-get-table ((tab srecode-template-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional
context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
;; No context, perhaps a merged name?
(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
context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME.
;;
;; 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)
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
(maphash hashfcn (oref tab namehash)))
keyout)))
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template
;; Code managing the top-level insert method and the current
;; insertion stack.
;;
-(defmethod srecode-push ((st srecode-template))
+(cl-defmethod srecode-push ((st srecode-template))
"Push the srecoder template ST onto the active stack."
(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.
ST can be a class, or an object."
(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."
(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."
;; Merge any template entries into the input dictionary.
;; This may happen twice since some templates arguments need
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary)
"Insert the STI inserter."
;; To be safe, indent the previous line since the template will
((stringp 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."
- (call-next-method)
+ (cl-call-next-method)
(when (oref ins hard)
(princ " : hard")
))
"Insert a newline before and after a template, and possibly do indenting.
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)
"Make sure there is no text before or after point."
(let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
)
"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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
dictionary)
"Don't insert anything for comment macros in STI."
nil)
(defvar srecode-inserter-variable-current-dictionary nil
"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)
"For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string.
(object-print sti) secondname)))
value))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
dictionary)
"Insert the STI inserter."
;; Convert the name into a name/fcn pair
The prompt text used is derived from the previous PROMPT command in the
template file.")
-(defmethod srecode-inserter-apply-state
+(cl-defmethod srecode-inserter-apply-state
((ins srecode-template-inserter-ask) STATE)
"For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match."
(setq prompts (cdr prompts)))
))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
dictionary)
"Insert the STI inserter."
(let ((val (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(if val
;; Does some extra work. Oh well.
- (call-next-method)
+ (cl-call-next-method)
;; How is our -ask value determined?
(if srecode-insert-with-fields-in-progress
;; Now that this value is safely stowed in the dictionary,
;; 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)
"Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
dictionary
"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)
"Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values."
val)
)
-(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
dictionary)
"Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values."
;; across multiple locations.
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."
- (call-next-method)
+ (cl-call-next-method)
(princ " : \"")
(princ (oref ins prompt))
(princ "\"")
to 10 characters, with spaces added to the left. Use `right' for adding
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)
"For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
(concat padchars value)
(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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
Some inserter macros, such as `srecode-template-inserter-include-wrap'
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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-point)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-point)
dictionary)
"Insert the STI inserter.
Save point in the class allocated 'point' slot.
"Wrap a section of a template under the control of a macro."
: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)
"Insert an example using inserter INS.
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")
(terpri)
(princ " ")
(terpri)
)
-(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT."
;; Make sure that only dictionaries are used.
;; Output the code from the sub-template.
(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)
"Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation.
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
dictionary)
"Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class."
applied to the text between the section start and the
`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)
"For the section inserter INS, parse INPUT.
Shorten input until the END token is found.
:code (cdr 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."
- (call-next-method)
+ (cl-call-next-method)
(princ "\n")
(srecode-dump-code-list (oref (oref ins template) code)
(concat indent " "))
"All template segments between the section-start and section-end
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)
"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?"
(string= name (oref ins :object-name)))
The included template will have additional dictionary entries from the subdictionary
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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
dictionary)
"For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
"No template \"%s\" found for include macro `%s'"
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)
"Insert the STI inserter.
Finds the template with this macro function part, and inserts it
then the text between this macro and the end macro will be inserted at
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)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
dictionary)
"Insert the template STI.
This will first insert the include part via inheritance, then
inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in
;; place.
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'srecode/insert)
)
"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."
(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."
(let ((ans nil))
(dolist (f (oref map files))
(setq ans (cons f 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."
(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."
(let ((ans nil)
(appentry (srecode-map-entry-for-app map app)))
(setq ans (cons f 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.
Return a list ( APP . FILE-ASSOC ) where APP is nil
in the global map."
;; 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."
(let ((entry (srecode-map-entry-for-file map file)))
(when 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.
Return non-nil if the MAP was changed."
(let ((entry (srecode-map-entry-for-file map file))
))
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."
(let* ((appe (srecode-map-entry-for-app map app))
(fentry (assoc file (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.
Return non-nil if the map was changed."
(let* ((appentry (srecode-map-entry-for-app map app))
"Wrap up a collection of semantic tag information.
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
dictionary)
"Convert the compound dictionary value CP to a string.
;;
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'mode-local)
(require 'srecode)
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.
Return nil if there was none."
(object-assoc file 'file (oref mt modetables)))
(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."
(princ "MODE TABLE FOR ")
(princ (oref tab :major-mode))
(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."
(princ "Template Table for ")
(princ (eieio-object-name-string tab))
projects / emacs.git / commitdiff