+2013-03-21 Eric Ludlam <zappo@gnu.org>
+
+ * srecode/ede-autoconf.srt: Change Copyright to FSF.
+ (ede-empty): Change AC_INIT to use PROJECT_NAME, and
+ PROJECT_VERSION.
+
+ * srecode/ede-make.srt (ede-empty): Add a dependency on :project.
+ Add header comment specifying the project's relative path.
+
+ * srecode/c.srt (header_guard): Upcase the filename symbol.
+
+2013-03-21 Vladimir Kazanov <vkazanov@inbox.ru>
+
+ * srecode/java.srt (empty-main): New.
+ (class-tag): Decapitalize class.
+
2013-03-12 Paul Eggert <eggert@cs.ucla.edu>
Add coding tags for iso-2022-7bit files that are not already tagged.
template header_guard :file :blank
----
-#ifndef {{FILENAME_SYMBOL}}
-#define {{FILENAME_SYMBOL}} 1
+#ifndef {{FILENAME_SYMBOL:upcase}}
+#define {{FILENAME_SYMBOL:upcase}} 1
{{^}}
-#endif // {{FILENAME_SYMBOL}}
+#endif // {{FILENAME_SYMBOL:upcase}}
----
context misc
;; ede/templates/autoconf.srt --- Templates for autoconf used by EDE.
;;
-;; Copyright (C) 2010 Eric M. Ludlam
+;; Copyright (C) 2010, 2013 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;;
context file
-template ede-empty
+template ede-empty :project
"Start a new EDE generated configure.in/ac file."
----
{{comment_prefix}} Automatically Generated/Maintained {{FILE}} by EDE.
{{comment_prefix}}
{{comment_prefix}} Process this file with autoconf to produce a configure script
-AC_INIT({{TEST_FILE}})
+AC_INIT({{PROJECT_NAME}}, {{PROJECT_VERSION}})
AM_INIT_AUTOMAKE([{{PROGRAM}}], 0)
AM_CONFIG_HEADER(config.h)
context file
-template ede-empty :file
+template ede-empty :file :project
----
# Automatically Generated {{FILE}} by EDE.
# For use with: {{MAKETYPE}}
+# Relative File Name: {{PROJECT_FILENAME}}
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
----
bind "e"
+template empty-main :file :user :time :java :indent
+"Fill out an empty file with a class having a static main method"
+sectiondictionary "CLASSSECTION"
+set NAME macro "FILENAME_AS_CLASS"
+----
+{{>:filecomment}}
+
+package {{FILENAME_AS_PACKAGE}};
+
+{{<CLASSSECTION:declaration:class}}
+public static void main(String args[]) {
+ {{^}}
+}
+{{/CLASSSECTION}}
+----
+bind "l"
+
context declaration
template import :blank :indent
the user-facing template."
----
{{>:declaration:javadoc-class}}
-public Class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}implements {{/NOTFIRST}}{{NAME}}{{/PARENTS}}
-{
+public class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}implements {{/NOTFIRST}}{{NAME}}{{/PARENTS}}
+{
{{^}}
};
----
+2013-03-21 Eric Ludlam <zappo@gnu.org>
+
+ * eieio/eieio-datadebug.el (data-debug/eieio-insert-slots):
+ Inhibit read only while inserting objects.
+
2013-03-13 Karl Fogel <kfogel@red-bean.com>
* saveplace.el (save-place-alist-to-file): Don't sort
+2013-03-21 Eric Ludlam <zappo@gnu.org>
+
+ * semantic.el (navigate-menu): Yank Tag :enable. Make sure
+ `senator-tag-ring' is bound.
+ (semantic-parse-region-default): Stop reversing the output of
+ parse-whole-stream.
+ (semantic-repeat-parse-whole-stream): Append returned tags
+ differently, so they come out in the right order.
+
+ * semantic/sb.el (semantic-sb-filter-tags-of-class): New option.
+ (semantic-sb-fetch-tag-table): Filter tags being bucketed to
+ exclude tags belonging to above filtered classes.
+
+ * semantic/find.el (semantic-filter-tags-by-class): New function.
+
+ * semantic/tag-ls.el (semantic-tag-similar-p-default): Add
+ short-circuit in case tag1 and 2 are identical.
+
+ * semantic/analyze/fcn.el
+ (semantic-analyze-dereference-metatype-stack): Use
+ `semantic-tag-similar-p' instead of 'eq' when comparing two tags
+ during metatype evaluation in case they are the same, but not the
+ same node. (Tweaked patch from Tomasz Gajewski) (Tiny change)
+
+ * semantic/db-find.el (semanticdb-partial-synchronize): Fix
+ require to semantic/db-typecache to be correct.
+ (semanticdb-find-tags-external-children-of-type): Make this a
+ brutish search by default.
+
+ * semantic/sort.el
+ (semantic-tag-external-member-children-default): When calling
+ `semanticdb-find-tags-external-children-of-type', pass in the
+ input tag as the place to start searching for externally defined
+ methods.
+
+ * semantic/db-file.el (semanticdb-default-save-directory): Doc
+ fix: Add ref to default value.
+
+ * semantic/complete.el (semantic-complete-post-command-hook): When
+ detecting if cursor is outside completion area, do so if cursor
+ moves before start of overlay, or the original starting location
+ of the overlay (i.e., if user deletes past beginning of the
+ overlay region).
+ (semantic-complete-inline-tag-engine): Initialize original start
+ of `semantic-complete-inline-overlay'.
+
+ * semantic/bovine/c.el (semantic-c-describe-environment): Update
+ some section titles. Test semanticdb table before printing it.
+ (semantic-c-reset-preprocessor-symbol-map): Update
+ `semantic-lex-spp-macro-symbol-obarray' outside the loop over all
+ the files contributing to its value.
+ (semantic-c-describe-environment): If there is an EDE project but
+ no spp symbols from it, say so.
+
+ * srecode/args.el (srecode-semantic-handle-:project): New argument
+ handler. Provide variable values if not in an EDE project.
+
+ * srecode/srt-mode.el (srecode-template-mode): Fix typo on srecode
+ name.
+
+ * srecode/cpp.el (srecode-semantic-handle-:c): Replace all
+ characters in FILENAME_SYMBOL that aren't valid CPP symbol chars.
+
+ * srecode/map.el (srecode-map-validate-file-for-mode): Force
+ semantic to load if it is not active in the template being added
+ to the map.
+
+ * srecode/srt.el: Add local variables for setting the autoload
+ file name.
+ (srecode-semantic-handle-:srt): New autoload cookie
+
+ * ede.el (ede-apply-preprocessor-map): Apply map to
+ `semantic-lex-spp-project-macro-symbol-obarray' instead of the
+ system one. Add require for semantic.
+
+ * ede/proj-elisp.el (ede-update-version-in-source): In case a file
+ has both a version variable and a Version: comment, always use
+ `call-next-method'.
+
+ * ede/cpp-root.el (ede-set-project-variables): Deleted.
+ `ede-preprocessor-map' does the job this function was attempting
+ to do with :spp-table.
+ (ede-preprocessor-map): Update file tests to provide better
+ messages. Do not try to get symbols from a file that is the file
+ in the current buffer.
+
+ * ede/base.el (ede-project-placeholder): Add more documentation to
+ :file slot.
+ (ede-load-cache): Use `insert-file-contents' instead of
+ `find-file-noselect' in order to avoid activating other tools.
+
+2013-03-21 David Engster <deng@randomsample.de>
+
+ * semantic/bovine/c.el (semantic-get-local-variables): Also add a
+ new variable 'this' if we are in an inline member function. For
+ detecting this, we check overlays at point if there is a class
+ spanning the current function. Also, the variable 'this' has to
+ be a pointer.
+
+ * semantic/bovine/gcc.el (semantic-gcc-setup): Fail gracefully
+ when querying g++ for defines returns an error.
+
+ * srecode/srt-mode.el:
+ * srecode/compile.el:
+ * semantic/elp.el:
+ * semantic/db-el.el:
+ * semantic/complete.el:
+ * ede.el:
+ * cogre.el:
+ * srecode/table.el:
+ * srecode/mode.el:
+ * srecode/insert.el:
+ * srecode/compile.el:
+ * semantic/decorate/include.el:
+ * semantic/db.el:
+ * semantic/adebug.el:
+ * ede/auto.el:
+ * srecode/dictionary.el:
+ * semantic/ede-grammar.el:
+ * semantic/db.el:
+ * semantic/db-find.el:
+ * semantic/db-file.el:
+ * semantic/complete.el:
+ * semantic/bovine/c.el:
+ * semantic/analyze.el:
+ * ede/util.el:
+ * ede/proj.el:
+ * ede/proj-elisp.el:
+ * ede/pconf.el:
+ * ede/locate.el:
+ * ede.el: Adapt to EIEIO namespace cleanup: Rename `object-name'
+ to `eieio-object-name', `object-set-name-string' to
+ `eieio-object-set-name-string', `object-class' to
+ `eieio-object-class', `class-parent' to `eieio-class-parent',
+ `class-parents' to `eieio-class-parents', `class-children' to
+ `eieio-class-children', `object-name-string' to
+ `eieio-object-name-string', `object-class-fast' to
+ `eieio--object-class'. Also replace direct access with new
+ accessor functions.
+
+2013-03-21 Tomasz Gajewski <tomga@wp.pl> (tiny change)
+
+ * ede/cpp-root.el (ede-project-autoload, initialize-instance): Fix
+ EDE file symbol to match rename. Fix ede-cpp-root symbol to
+ include -project in name.
+
+2013-03-21 Alex Ott <alexott@gmail.com>
+
+ * cedet-files.el (cedet-files-list-recursively): New. Recursively
+ find files whose names are matching to given regex
+
+ * ede.el (ede-current-project): Rewrite to avoid imperative style.
+
+ * ede/files.el (ede-find-file): Simplify code.
+
+ * ede/base.el (ede-normalize-file/directory): Add function to
+ normalize :file or :directory slots if they are missing.
+
+ * ede/cpp-root.el (ede-cpp-root-project): Add compile-command
+ slot.
+ (project-compile-project): Compiles project using value specified
+ in :compule-command slot or in compile-command local variable.
+ Value of slot or local variable could be string or function that
+ receives project and should return string that will be invoked as
+ command.
+ (project-compile-target): Invokes compilation of whole project
+
+ * ede/files.el (ede-find-project-root): New function to
+ find root of project that contains specific file.
+ (ede-files-find-existing): New function which checks presence of
+ given directory in the list of registered projects.
+
2013-03-04 Paul Eggert <eggert@cs.ucla.edu>
* semantic/wisent/wisent.el (wisent): Stick to ASCII in the ASCII art.
(setq file (concat "//" (substring file 1)))))
file))
+(defun cedet-files-list-recursively (dir re)
+ "Returns list of files in directory matching to given regex"
+ (when (file-accessible-directory-p dir)
+ (let ((files (directory-files dir t))
+ matched)
+ (dolist (file files matched)
+ (let ((fname (file-name-nondirectory file)))
+ (cond
+ ((or (string= fname ".")
+ (string= fname "..")) nil)
+ ((and (file-regular-p file)
+ (string-match re fname))
+ (setq matched (cons file matched)))
+ ((file-directory-p file)
+ (let ((tfiles (cedet-files-list-recursively file re)))
+ (when tfiles (setq matched (append matched tfiles)))))))))))
+
+
(provide 'cedet-files)
;;; cedet-files.el ends here
(easy-menu-create-menu
"Project Forms"
(let* ((obj (ede-current-project))
- (class (if obj (object-class obj)))
+ (class (if obj (eieio-object-class obj)))
(menu nil))
(condition-case err
(progn
(while (and class (slot-exists-p class 'menu))
;;(message "Looking at class %S" class)
(setq menu (append menu (oref class menu))
- class (class-parent class))
+ class (eieio-class-parent class))
(if (listp class) (setq class (car class))))
(append
'( [ "Add Target" ede-new-target (ede-current-project) ]
(oref proj configuration-default)))))
(oset (ede-current-project) configuration-default newconfig)
(message "%s will now build in %s mode."
- (object-name (ede-current-project))
+ (eieio-object-name (ede-current-project))
newconfig))
(defun ede-customize-forms-menu (menu-def)
'name
(let* ((l ede-project-class-files)
(cp (ede-current-project))
- (cs (when cp (object-class cp)))
+ (cs (when cp (eieio-object-class cp)))
(r nil))
(while l
(if cs
:targets nil)))
(inits (oref obj initializers)))
;; Force the name to match for new objects.
- (object-set-name-string nobj (oref nobj :name))
+ (eieio-object-set-name-string nobj (oref nobj :name))
;; Handle init args.
(while inits
(eieio-oset nobj (car inits) (car (cdr inits)))
(when (not ede-object)
(error "Can't add %s to target %s: Wrong file type"
(file-name-nondirectory (buffer-file-name))
- (object-name target)))
+ (eieio-object-name target)))
(ede-apply-target-options))
(defun ede-remove-file (&optional force)
(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" (object-name ot)))
+ (error "add-file not supported by %s" (eieio-object-name ot)))
(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" (object-name ot)))
+ (error "remove-file not supported by %s" (eieio-object-name ot)))
(defmethod project-edit-file-target ((ot ede-target))
"Edit the target OT associated with this file."
(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" (object-name proj)))
+ (error "new-target not supported by %s" (eieio-object-name proj)))
(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" (object-name proj)))
+ (error "New-target-custom not supported by %s" (eieio-object-name proj)))
(defmethod project-delete-target ((ot ede-target))
"Delete the current target OT from its parent project."
- (error "add-file not supported by %s" (object-name ot)))
+ (error "add-file not supported by %s" (eieio-object-name ot)))
(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" (object-name obj)))
+ (error "compile-project not supported by %s" (eieio-object-name obj)))
(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" (object-name obj)))
+ (error "compile-target not supported by %s" (eieio-object-name obj)))
(defmethod project-debug-target ((obj ede-target))
"Run the current project target OBJ in a debugger."
- (error "debug-target not supported by %s" (object-name obj)))
+ (error "debug-target not supported by %s" (eieio-object-name obj)))
(defmethod project-run-target ((obj ede-target))
"Run the current project target OBJ."
- (error "run-target not supported by %s" (object-name obj)))
+ (error "run-target not supported by %s" (eieio-object-name obj)))
(defmethod project-make-dist ((this ede-project))
"Build a distribution for the project based on THIS project."
- (error "Make-dist not supported by %s" (object-name this)))
+ (error "Make-dist not supported by %s" (eieio-object-name this)))
(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" (object-name this)))
+ (error "Dist-files is not supported by %s" (eieio-object-name this)))
(defmethod project-rescan ((this ede-project))
"Rescan the EDE project THIS."
- (error "Rescanning a project is not supported by %s" (object-name this)))
+ (error "Rescanning a project is not supported by %s" (eieio-object-name this)))
(defun ede-ecb-project-paths ()
"Return a list of all paths for all active EDE projects.
(defun ede-current-project (&optional dir)
"Return the current project file.
If optional DIR is provided, get the project for DIR instead."
- (let ((ans nil))
- ;; If it matches the current directory, do we have a pre-existing project?
- (when (and (or (not dir) (string= dir default-directory))
- ede-object-project)
- (setq ans ede-object-project)
- )
+ ;; If it matches the current directory, do we have a pre-existing project?
+ (let ((proj (when (and (or (not dir) (string= dir default-directory))
+ ede-object-project)
+ ede-object-project)))
;; No current project.
- (when (not ans)
+ (if proj
+ proj
(let* ((ldir (or dir default-directory)))
- (setq ans (ede-directory-get-open-project ldir))))
- ;; Return what we found.
- ans))
+ (ede-directory-get-open-project ldir)))))
(defun ede-buffer-object (&optional buffer projsym)
"Return the target object for BUFFER.
;; C/C++
(defun ede-apply-preprocessor-map ()
"Apply preprocessor tables onto the current buffer."
+ ;; TODO - what if semantic-mode isn't enabled?
+ ;; what if we never want to load a C mode? Does this matter?
+ ;; Note: This require is needed for the case where EDE ends up
+ ;; in the hook order before Semantic based hooks.
+ (require 'semantic/lex-spp)
(when (and ede-object
- (boundp 'semantic-lex-spp-macro-symbol-obarray)
- semantic-lex-spp-macro-symbol-obarray)
+ (boundp 'semantic-lex-spp-project-macro-symbol-obarray))
(let* ((objs ede-object)
(map (ede-preprocessor-map (if (consp objs)
(car objs)
objs))))
(when map
;; We can't do a require for the below symbol.
- (setq semantic-lex-spp-macro-symbol-obarray
+ (setq semantic-lex-spp-project-macro-symbol-obarray
(semantic-lex-make-spp-table map)))
(when (consp objs)
(message "Choosing preprocessor syms for project %s"
- (object-name (car objs)))))))
+ (eieio-object-name (car objs)))))))
(defmethod ede-system-include-path ((this ede-project))
"Get the system include path used by project THIS."
front of the list so more generic projects don't get priority."
;; First, can we identify PROJAUTO as already in the list? If so, replace.
(let ((projlist ede-project-class-files)
- (projname (object-name-string projauto)))
- (while (and projlist (not (string= (object-name-string (car projlist)) projname)))
+ (projname (eieio-object-name-string projauto)))
+ (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname)))
(setq projlist (cdr projlist)))
(if projlist
(dirinode :documentation "The inode id for :directory.")
(file :type string
:initarg :file
- :documentation "File name where this project is stored.")
+ :documentation "The File uniquely tagging this project instance.
+For some project types, this will be the file that stores the project configuration.
+In other projects types, this file is merely a unique identifier to this type of project.")
(rootproject ; :initarg - no initarg, don't save this slot!
:initform nil
:type (or null ede-project-placeholder-child)
(defun ede-load-cache ()
"Load the cache of EDE projects."
(save-excursion
- (let ((cachebuffer nil))
+ (let ((cachebuffer (get-buffer-create "*ede cache*")))
(condition-case nil
- (progn
- (setq cachebuffer
- (find-file-noselect ede-project-placeholder-cache-file t))
- (set-buffer cachebuffer)
+ (with-current-buffer cachebuffer
+ (erase-buffer)
+ (when (file-exists-p ede-project-placeholder-cache-file)
+ (insert-file-contents ede-project-placeholder-cache-file))
(goto-char (point-min))
(let ((c (read (current-buffer)))
(new nil)
(setq cp (ede-parent-project cp)))
cp)))))
+\f
+;;; Utility functions
+;;
+
+(defun ede-normalize-file/directory (this project-file-name)
+ "Fills :directory or :file slots if they're missing in project THIS.
+The other slot will be used to calculate values.
+PROJECT-FILE-NAME is a name of project file (short name, like 'pom.xml', etc."
+ (when (and (or (not (slot-boundp this :file))
+ (not (oref this :file)))
+ (slot-boundp this :directory)
+ (oref this :directory))
+ (oset this :file (expand-file-name project-file-name (oref this :directory))))
+ (when (and (or (not (slot-boundp this :directory))
+ (not (oref this :directory)))
+ (slot-boundp this :file)
+ (oref this :file))
+ (oset this :directory (file-name-directory (oref this :file))))
+ )
+
+
+
\f
;;; Hooks & Autoloads
;;
(ede-add-project-autoload
(ede-project-autoload "cpp-root"
:name "CPP ROOT"
- :file 'ede-cpp-root
+ :file 'ede/cpp-root
:proj-file 'ede-cpp-root-project-file-for-dir
:proj-root 'ede-cpp-root-project-root
:load-type 'ede-cpp-root-load
- :class-sym 'ede-cpp-root
+ :class-sym 'ede-cpp-root-project
:new-p nil
:safe-p t)
;; When a user creates one of these, it should override any other project
;; level include paths, and PreProcessor macro tables.
(defclass ede-cpp-root-target (ede-target)
- ()
+ ((project :initform nil
+ :initarg :project))
"EDE cpp-root project target.
All directories need at least one target.")
+;;;###autoload
(defclass ede-cpp-root-project (ede-project eieio-instance-tracker)
((tracking-symbol :initform 'ede-cpp-root-project-list)
(include-path :initarg :include-path
It should return the fully qualified file name passed in from NAME. If that file does not
exist, it should return nil."
)
+ (compile-command :initarg :compile-command
+ :initform nil
+ :type (or null string function)
+ :documentation
+ "Compilation command that will be used for this project.
+It could be string or function that will accept proj argument and should return string.
+The string will be passed to 'compuile' function that will be issued in root
+directory of project."
+ )
)
"EDE cpp-root project class.
Each directory needs a project file to control it.")
(when (or (not (file-exists-p f))
(file-directory-p f))
(delete-instance this)
- (error ":file for ede-cpp-root must be a file"))
+ (error ":file for ede-cpp-root-project must be a file"))
(oset this :file f)
(oset this :directory (file-name-directory f))
(ede-project-directory-remove-hash (file-name-directory f))
:name (file-name-nondirectory
(directory-file-name dir))
:path dir
- :source nil))
+ :source nil
+ :project proj))
(object-add-to-list proj :targets ans)
)
ans))
filename))
-(defmethod ede-set-project-variables ((project ede-cpp-root-project) &optional buffer)
- "Set variables local to PROJECT in BUFFER.
-Also set up the lexical preprocessor map."
- (call-next-method)
- (when (and (featurep 'semantic/bovine/c) (featurep 'semantic/lex-spp))
- (setq semantic-lex-spp-project-macro-symbol-obarray
- (semantic-lex-make-spp-table (oref project spp-table)))
- ))
-
(defmethod ede-system-include-path ((this ede-cpp-root-project))
"Get the system include path used by project THIS."
(oref this system-include-path))
(table (when expfile
(semanticdb-file-table-object expfile)))
)
- (if (not table)
- (message "Cannot find file %s in project." F)
+ (cond
+ ((not (file-exists-p expfile))
+ (message "Cannot find file %s in project." F))
+ ((string= expfile (buffer-file-name))
+ ;; Don't include this file in it's own spp table.
+ )
+ ((not table)
+ (message "No db table available for %s." expfile))
+ (t
(when (semanticdb-needs-refresh-p table)
(semanticdb-refresh-table table))
- (setq spp (append spp (oref table lexical-table))))))
+ (setq spp (append spp (oref table lexical-table)))))))
(oref this spp-files))
spp))
"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)
+ "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* ((cmd (oref proj :compile-command))
+ (ov (oref proj :local-variables))
+ (lcmd (when ov (cdr (assoc 'compile-command ov))))
+ (cmd-str (cond
+ ((stringp cmd) cmd)
+ ((functionp cmd) (funcall cmd proj))
+ ((stringp lcmd) lcmd)
+ ((functionp lcmd) (funcall lcmd proj)))))
+ (when cmd-str
+ (let ((default-directory (ede-project-root-directory proj)))
+ (compile cmd-str)))))
+
+(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)))
+
+
;;; Quick Hack
(defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes)
"Create a bunch of projects under directory DIR.
"Get the root directory for DIR."
(when (not dir) (setq dir default-directory))
(let ((case-fold-search t)
- (proj (ede-emacs-file-existing dir)))
+ (proj (ede-files-find-existing dir ede-emacs-project-list)))
(if proj
(ede-up-directory (file-name-directory
(oref proj :file)))
Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
- (or (ede-emacs-file-existing dir)
+ (or (ede-files-find-existing dir ede-emacs-project-list)
;; Doesn't already exist, so let's make one.
(let* ((vertuple (ede-emacs-version dir))
(proj (ede-emacs-project
There is no completion at the prompt. FILE is searched for within
the current EDE project."
(interactive "sFile: ")
- (let ((fname (ede-expand-filename (ede-current-project) file))
+ (let* ((proj (ede-current-project))
+ (fname (ede-expand-filename proj file))
)
(unless fname
(error "Could not find %s in %s"
file
- (ede-project-root-directory (ede-current-project))))
+ (ede-project-root-directory proj)))
(find-file fname)))
(defun ede-flush-project-hash ()
nil
fnd)))
+(defun ede-find-project-root (prj-file-name &optional dir)
+ "Tries to find directory with given project file"
+ (let ((prj-dir (locate-dominating-file (or dir default-directory)
+ prj-file-name)))
+ (when prj-dir
+ (expand-file-name prj-dir))))
+
+(defun ede-files-find-existing (dir prj-list)
+ "Find a project in the list of projects stored in given variable.
+DIR is the directory to search from."
+ (let ((projs prj-list)
+ (ans nil))
+ (while (and projs (not ans))
+ (let ((root (ede-project-root-directory (car projs))))
+ (when (string-match (concat "^" (regexp-quote root)) dir)
+ (setq ans (car projs))))
+ (setq projs (cdr projs)))
+ ans))
+
+
(provide 'ede/files)
;; Local variables:
"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"
- (object-name loc)))
+ (eieio-object-name loc)))
;;; LOCATE
;;
(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" (object-name this)))
+ (error "Could not determine configure.ac for %S" (eieio-object-name this)))
(let ((b (get-file-buffer (ede-proj-configure-file this))))
;; Destroy all evidence of the old configure.ac
(delete-file (ede-proj-configure-file this))
(setq utd (1+ utd)))))))
(oref obj source))
- (message "All Emacs Lisp sources are up to date in %s" (object-name 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)
(goto-char (match-beginning 1))
(insert version)))))
(setq vs (cdr vs)))
- (if (not match) (call-next-method)))))
+ ;; The next method will include comments such as "Version:"
+ (call-next-method))))
;;; Makefile generation functions
(defmethod project-debug-target ((obj ede-proj-target))
"Run the current project target OBJ in a debugger."
- (error "Debug-target not supported by %s" (object-name obj)))
+ (error "Debug-target not supported by %s" (eieio-object-name obj)))
(defmethod project-run-target ((obj ede-proj-target))
"Run the current project target OBJ."
- (error "Run-target not supported by %s" (object-name obj)))
+ (error "Run-target not supported by %s" (eieio-object-name obj)))
(defmethod ede-proj-makefile-target-name ((this ede-proj-target))
"Return the name of the main target for THIS target."
(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" (object-name ot)))
+ (error "project-update-version not supported by %s" (eieio-object-name ot)))
(defmethod ede-update-version-in-source ((this ede-project) version)
"Change occurrences of a version string in sources.
(widen)
(when (or (< end start) (> end (point-max)))
(error "Invalid parse region bounds %S, %S" start end))
- (nreverse
- (semantic-repeat-parse-whole-stream
+ (semantic-repeat-parse-whole-stream
(or (cdr (assq start semantic-lex-block-streams))
(semantic-lex start end depth))
- nonterminal returnonerror))))
+ nonterminal returnonerror)))
\f
;;; Parsing functions
;;
tag 'reparse-symbol nonterm))
tag)
(semantic--tag-expand tag))
- result (append tag result))
+ result (append result tag))
;; No error in this case, a purposeful nil means don't
;; store anything.
)
'("--"))
(define-key edit-menu [senator-yank-tag]
'(menu-item "Yank Tag" senator-yank-tag
- :enable (not (ring-empty-p senator-tag-ring))
+ :enable (and (boundp 'senator-tag-ring)
+ (not (ring-empty-p senator-tag-ring)))
:help "Yank the head of the tag ring into the buffer"))
(define-key edit-menu [senator-copy-tag-to-register]
'(menu-item "Copy Tag To Register" senator-copy-tag-to-register
(semantic-analyze-pulse context)
(with-output-to-temp-buffer "*Semantic Context Analysis*"
(princ "Context Type: ")
- (princ (object-name context))
+ (princ (eieio-object-name context))
(princ "\n")
(princ "Bounds: ")
(princ (oref context bounds))
(nexttype (semantic-analyze-dereference-metatype type scope type-declaration))
(idx 0))
(catch 'metatype-recursion
- (while (and nexttype (not (eq (car nexttype) lasttype)))
+ (while (and nexttype (not (semantic-tag-similar-p (car nexttype) lasttype)))
(setq lasttype (car nexttype)
lasttypedeclaration (cadr nexttype))
(setq nexttype (semantic-analyze-dereference-metatype lasttype scope lasttypedeclaration))
;; not be in a buffer.
(semanticdb-refresh-table table t)
(error (message "Error updating tables for %S"
- (object-name table)))))
+ (eieio-object-name table)))))
(setq filemap (append filemap (oref table lexical-table)))
- ;; Update symbol obarray
- (setq-mode-local c-mode
- semantic-lex-spp-macro-symbol-obarray
- (semantic-lex-make-spp-table
- (append semantic-lex-c-preprocessor-symbol-map-builtin
- semantic-lex-c-preprocessor-symbol-map
- filemap)))))))))))
+ )))))
+ ;; Update symbol obarray
+ (setq-mode-local c-mode
+ semantic-lex-spp-macro-symbol-obarray
+ (semantic-lex-make-spp-table
+ (append semantic-lex-c-preprocessor-symbol-map-builtin
+ semantic-lex-c-preprocessor-symbol-map
+ filemap))))))
;; Make sure the preprocessor symbols are set up when mode-local kicks
;; in.
"Do what `semantic-get-local-variables' does, plus add `this' if needed."
(let* ((origvar (semantic-get-local-variables-default))
(ct (semantic-current-tag))
- (p (semantic-tag-function-parent ct)))
+ (p (when (semantic-tag-of-class-p ct 'function)
+ (or (semantic-tag-function-parent ct)
+ (car-safe (semantic-find-tags-by-type
+ "class" (semantic-find-tag-by-overlay)))))))
;; If we have a function parent, then that implies we can
- (if (and p (semantic-tag-of-class-p ct 'function))
- ;; Append a new tag THIS into our space.
- (cons (semantic-tag-new-variable "this" p nil)
+ (if p
+ ;; Append a new tag THIS into our space.
+ (cons (semantic-tag-new-variable "this" p nil :pointer 1)
origvar)
;; No parent, just return the usual
- origvar)
- ))
+ origvar)))
(define-mode-local-override semantic-idle-summary-current-symbol-info
c-mode ()
(princ "\n")))
(princ "\n\nMacro Summary:\n")
+
(when semantic-lex-c-preprocessor-symbol-file
- (princ "\n Your CPP table is primed from these files:\n")
+ (princ "\n Your CPP table is primed from these system files:\n")
(dolist (file semantic-lex-c-preprocessor-symbol-file)
(princ " ")
(princ file)
(princ "\n")
(princ " in table: ")
- (princ (object-print (semanticdb-file-table-object file)))
+ (let ((fto (semanticdb-file-table-object file)))
+ (if fto
+ (princ (object-print fto))
+ (princ "No Table")))
(princ "\n")
))
))
(when semantic-lex-c-preprocessor-symbol-map
- (princ "\n User symbol map:\n")
+ (princ "\n User symbol map (primed from system files):\n")
(dolist (S semantic-lex-c-preprocessor-symbol-map)
(princ " ")
(princ (car S))
))
(when (and (boundp 'ede-object)
- ede-object
- (arrayp semantic-lex-spp-project-macro-symbol-obarray))
+ ede-object)
(princ "\n Project symbol map:\n")
(when (and (boundp 'ede-object) ede-object)
- (princ " Your project symbol map is derived from the EDE object:\n ")
+ (princ " Your project symbol map is also derived from the EDE object:\n ")
(princ (object-print ede-object)))
(princ "\n\n")
- (let ((macros nil))
- (mapatoms
- #'(lambda (symbol)
- (setq macros (cons symbol macros)))
- semantic-lex-spp-project-macro-symbol-obarray)
- (dolist (S macros)
- (princ " ")
- (princ (symbol-name S))
- (princ " = ")
- (princ (symbol-value S))
- (princ "\n")
- )))
+ (if (arrayp semantic-lex-spp-project-macro-symbol-obarray)
+ (let ((macros nil))
+ (mapatoms
+ #'(lambda (symbol)
+ (setq macros (cons symbol macros)))
+ semantic-lex-spp-project-macro-symbol-obarray)
+ (dolist (S macros)
+ (princ " ")
+ (princ (symbol-name S))
+ (princ " = ")
+ (princ (symbol-value S))
+ (princ "\n")
+ ))
+ ;; Else, not map
+ (princ " No Symbols.\n")))
(princ "\n\n Use: M-x semantic-lex-spp-describe RET\n")
(princ "\n to see the complete macro table.\n")
;; `cpp' command in `semantic-gcc-setup' doesn't work on
;; Mac, try `gcc'.
(apply 'semantic-gcc-query "gcc" cpp-options))))
- (defines (semantic-cpp-defs query))
+ (defines (if (stringp query)
+ (semantic-cpp-defs query)
+ (message (concat "Could not query gcc for defines. "
+ "Maybe g++ is not installed."))
+ nil))
(ver (cdr (assoc 'version fields)))
(host (or (cdr (assoc 'target fields))
(cdr (assoc '--target fields))
;;(message "Inline Hook installed, but overlay deleted.")
(semantic-complete-inline-exit))
;; Exit if commands caused us to exit the area of interest
- (let ((s (semantic-overlay-start semantic-complete-inline-overlay))
+ (let ((os (semantic-overlay-get semantic-complete-inline-overlay 'semantic-original-start))
+ (s (semantic-overlay-start semantic-complete-inline-overlay))
(e (semantic-overlay-end semantic-complete-inline-overlay))
(b (semantic-overlay-buffer semantic-complete-inline-overlay))
(txt nil)
(cond
;; EXIT when we are no longer in a good place.
((or (not (eq b (current-buffer)))
- (<= (point) s)
- (> (point) e))
+ (< (point) s)
+ (< (point) os)
+ (> (point) e)
+ )
;;(message "Exit: %S %S %S" s e (point))
(semantic-complete-inline-exit)
)
(t
;; Else, show completions now
(semantic-complete-inline-force-display)
-
))))
;; If something goes terribly wrong, clean up after ourselves.
(error (semantic-complete-inline-exit))))
(semantic-overlay-put semantic-complete-inline-overlay
'window-config-start
(current-window-configuration))
+ ;; Save the original start. We need to exit completion if START
+ ;; moves.
+ (semantic-overlay-put semantic-complete-inline-overlay
+ 'semantic-original-start start)
;; Install our command hooks
(add-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
(add-hook 'post-command-hook 'semantic-complete-post-command-hook)
(let ((old nil)
(bl semantic-collector-per-buffer-list))
(while (and bl (null old))
- (if (eq (object-class (car bl)) this)
+ (if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
(let ((new (call-next-method)))
(insert (semantic-format-tag-summarize tag nil t) "\n\n")
(when table
(insert "From table: \n")
- (insert (object-name table) "\n\n"))
+ (insert (eieio-object-name table) "\n\n"))
(when buf
(insert "In buffer: \n\n")
(insert (format "%S" buf)))
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- (aref (class-v semanticdb-project-database)
- class-public-a)) ;; slots
- (semantic-elisp-desymbolify (class-parents sym)) ;; parents
+ (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots
+ (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
;; Figure it out on our own.
(defcustom semanticdb-default-save-directory
(locate-user-emacs-file "semanticdb" ".semanticdb")
"Directory name where semantic cache files are stored.
+By default, it is either ~/.emacs.d/semanticdb, or ~/.semanticdb depending
+on which exists.
If this value is nil, files are saved in the current directory. If the value
is a valid directory, then it overrides `semanticdb-default-file-name' and
stores caches in a coded file name in this directory."
(data-debug-new-buffer (concat "*SEMANTICDB ERROR*"))
(data-debug-insert-thing obj "*" "")
(setq semanticdb-data-debug-on-write-error nil))
- (message "Error Writing Table: %s" (object-name obj))
+ (message "Error Writing Table: %s" (eieio-object-name obj))
(error "%S" (car (cdr tableerror)))))
;; Clear the dirty bit.
(let ((tab-idx (semanticdb-get-table-index tab)))
;; Not a full reset?
(when (oref tab-idx type-cache)
- (require 'db-typecache)
+ (require 'semantic/db-typecache)
(semanticdb-typecache-notify-reset
(oref tab-idx type-cache)))
)))
(if (< (length result) 2)
(concat "#<FIND RESULT "
(mapconcat (lambda (a)
- (concat "(" (object-name (car a) ) " . "
+ (concat "(" (eieio-object-name (car a) ) " . "
"#<TAG LIST " (number-to-string (length (cdr a))) ">)"))
result
" ")
(semanticdb-find-tags-collector
(lambda (table tags)
(semanticdb-find-tags-external-children-of-type-method table type tags))
- path find-file-match))
+ path find-file-match t))
(defun semanticdb-find-tags-subclasses-of-type
(type &optional path find-file-match)
(oref obj index)
(let ((idx nil))
(setq idx (funcall semanticdb-default-find-index-class
- (concat (object-name obj) " index")
+ (concat (eieio-object-name obj) " index")
;; Fill in the defaults
:table obj
))
(let ((cache (oref table cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (object-class-fast (car cache)) desired-class)
+ (if (eq (eieio--object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
(let ((cache (oref db cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (object-class-fast (car cache)) desired-class)
+ (if (eq (eieio--object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
(dolist (p path)
(if (slot-boundp p 'tags)
(princ (format "\n %s :\t%d tags, %d are includes. %s"
- (object-name-string p)
+ (eieio-object-name-string p)
(length (oref p tags))
(length (semantic-find-tags-by-class
'include p))
" Needs to be parsed.")
(t ""))))
(princ (format "\n %s :\tUnparsed"
- (object-name-string p))))
+ (eieio-object-name-string p))))
)))
)))
(setq comp (1+ comp))
(setq utd (1+ utd))))))))
(oref obj source))
- (message "All Semantic Grammar sources are up to date in %s" (object-name obj))
+ (message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
;;; Makefile generation functions
(eq ,class (semantic-tag-class (car tags)))
,table))
+(defmacro semantic-filter-tags-by-class (class &optional table)
+ "Find all tags of class not in the list CLASS in TABLE.
+CLASS is a list of symbols representing the class of the token,
+such as 'variable, of 'function..
+TABLE is a tag table. See `semantic-something-to-tag-table'."
+ `(semantic--find-tags-by-macro
+ (not (memq (semantic-tag-class (car tags)) ,class))
+ ,table))
+
(defmacro semantic-find-tags-by-type (type &optional table)
"Find all tags of with a type TYPE in TABLE.
TYPE is a string or tag representing a data type as defined in the
(declare-function semantic-grammar-wy--install-parser
"semantic/gram-wy-fallback")
+(declare-function semantic-grammar-wy--install-parser
+ "semantic/gram-wy-fallback")
+
\f
;;;;
;;;; Set up lexer
:group 'speedbar
:type 'integer)
+(defvar semantic-sb-filter-tags-of-class '(code)
+ "Tags classes to not display in speedbar.
+Make this buffer local for modes that have different types of tags
+that should be ignored.")
+
(defcustom semantic-sb-button-format-tag-function 'semantic-format-tag-abbreviate
"*Function called to create the text for a but from a token."
:group 'speedbar
(setq out (semantic-adopt-external-members out))
;; Dump all the tokens into buckets.
(semantic-sb-with-tag-buffer (car out)
- (semantic-bucketize out)))
+ (semantic-bucketize out nil
+ (lambda (tagsin)
+ ;; Remove all boring tags.
+ (semantic-filter-tags-by-class
+ semantic-sb-filter-tags-of-class
+ tagsin)))))
(error t))
t)))
(semanticdb-minor-mode-p)
(require 'semantic/db-find))
(let ((m (semanticdb-find-tags-external-children-of-type
- (semantic-tag-name tag))))
+ (semantic-tag-name tag) tag)))
(if m (apply #'append (mapcar #'cdr m))))
(semantic--find-tags-by-function
`(lambda (tok)
IGNORABLE-ATTRIBUTES are tag attributes that can be ignored.
See `semantic-tag-similar-p' for details."
- (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes))
- (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore))
- (semantic--tag-similar-types-p tag1 tag2)
- (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))))
- (attr1 (semantic-tag-attributes tag1))
- (attr2 (semantic-tag-attributes tag2))
- (A2 t)
- (A3 t)
- )
- ;; Test if there are non-ignorable attributes in A2 which are not present in A1
- (while (and A2 attr2)
- (let ((a (car attr2)))
- (unless (or (eq a :type) (memq a ignore))
- (setq A2 (semantic-tag-get-attribute tag1 a)))
- (setq attr2 (cdr (cdr attr2)))))
- (while (and A2 attr1 A3)
- (let ((a (car attr1)))
-
- (cond ((or (eq a :type) ;; already tested above.
- (memq a ignore)) ;; Ignore them...
- nil)
-
- (t
- (setq A3
- (semantic--tag-attribute-similar-p
- a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a)
- ignorable-attributes)))
- ))
- (setq attr1 (cdr (cdr attr1))))
- (and A1 A2 A3)))
+ (or
+ ;; Tags are similar if they have the exact same lisp object
+ ;; Added for performance when testing a relatively common case in some uses
+ ;; of this code.
+ (eq tag1 tag2)
+ ;; More complex similarness test.
+ (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes))
+ (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore))
+ (semantic--tag-similar-types-p tag1 tag2)
+ (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))))
+ (attr1 (semantic-tag-attributes tag1))
+ (attr2 (semantic-tag-attributes tag2))
+ (A2 t)
+ (A3 t)
+ )
+ ;; Test if there are non-ignorable attributes in A2 which are not present in A1
+ (while (and A2 attr2)
+ (let ((a (car attr2)))
+ (unless (or (eq a :type) (memq a ignore))
+ (setq A2 (semantic-tag-get-attribute tag1 a)))
+ (setq attr2 (cdr (cdr attr2)))))
+ (while (and A2 attr1 A3)
+ (let ((a (car attr1)))
+
+ (cond ((or (eq a :type) ;; already tested above.
+ (memq a ignore)) ;; Ignore them...
+ nil)
+
+ (t
+ (setq A3
+ (semantic--tag-attribute-similar-p
+ a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a)
+ ignorable-attributes)))
+ ))
+ (setq attr1 (cdr (cdr attr1))))
+ (and A1 A2 A3))))
;;; FULL NAMES
;;
(srecode-dictionary-show-section dict "RCS")
)))
+;;; :project ARGUMENT HANDLING
+;;
+;; When the :project argument is required, fill the dictionary with
+;; information that the current project (from EDE) might know
+(defun srecode-semantic-handle-:project (dict)
+ "Add macros into the dictionary DICT based on the current ede project."
+ (let* ((bfn (buffer-file-name))
+ (dir (file-name-directory bfn)))
+ (if (ede-toplevel)
+ (let* ((projecttop (ede-toplevel-project default-directory))
+ (relfname (file-relative-name bfn projecttop))
+ (reldir (file-relative-name dir projecttop))
+ )
+ (srecode-dictionary-set-value dict "PROJECT_FILENAME" relfname)
+ (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" reldir)
+ (srecode-dictionary-set-value dict "PROJECT_NAME" (ede-name (ede-toplevel)))
+ (srecode-dictionary-set-value dict "PROJECT_VERSION" (oref (ede-toplevel) :version))
+ )
+ ;; If there is no EDE project, then put in some base values.
+ (srecode-dictionary-set-value dict "PROJECT_FILENAME" bfn)
+ (srecode-dictionary-set-value dict "PROJECT_DIRECTORY" dir)
+ (srecode-dictionary-set-value dict "PROJECT_NAME" "N/A")
+ (srecode-dictionary-set-value dict "PROJECT_VERSION" "1.0"))))
+
;;; :system ARGUMENT HANDLING
;;
;; When a :system argument is required, fill the dictionary with
;;(message "Compile: %s %S" name props)
(if (not key)
(apply 'srecode-template-inserter-variable name props)
- (let ((classes (class-children srecode-template-inserter))
+ (let ((classes (eieio-class-children srecode-template-inserter))
(new nil))
;; Loop over the various subclasses and
;; create the correct inserter.
(while (and (not new) classes)
- (setq classes (append classes (class-children (car classes))))
+ (setq classes (append classes (eieio-class-children (car classes))))
;; Do we have a match?
(when (and (not (class-abstract-p (car classes)))
(equal (oref (car classes) key) key))
(defmethod srecode-dump ((tmp srecode-template))
"Dump the contents of the SRecode template tmp."
(princ "== Template \"")
- (princ (object-name-string tmp))
+ (princ (eieio-object-name-string tmp))
(princ "\" in context ")
(princ (oref tmp context))
(princ "\n")
(defmethod srecode-dump ((ins srecode-template-inserter) indent)
"Dump the state of the SRecode template inserter INS."
(princ "INS: \"")
- (princ (object-name-string ins))
+ (princ (eieio-object-name-string ins))
(when (oref ins :secondname)
(princ "\" : \"")
(princ (oref ins :secondname)))
(princ "\" type \"")
- (let* ((oc (symbol-name (object-class ins)))
+ (let* ((oc (symbol-name (eieio-object-class ins)))
(junk (string-match "srecode-template-inserter-" oc))
(on (if junk
(substring oc (match-end 0))
(srecode-dictionary-show-section dict "NOTHEADER"))
;; Strip out bad characters
- (while (string-match "\\.\\| " fsym)
- (setq fsym (replace-match "_" t t fsym)))
+ (setq fsym (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" fsym))
(srecode-dictionary-set-value dict "FILENAME_SYMBOL" fsym)
)
)
((srecode-dictionary-child-p buffer-or-parent)
(setq parent buffer-or-parent
buffer (oref buffer-or-parent buffer)
- origin (concat (object-name buffer-or-parent) " in "
+ origin (concat (eieio-object-name buffer-or-parent) " in "
(if buffer (buffer-name buffer)
"no buffer")))
(when buffer
method could return nil, but if it does that, it must insert
the value itself using `princ', or by detecting if the current
standard out is a buffer, and using `insert'."
- (object-name cp))
+ (eieio-object-name cp))
(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent)
"Display information about this compound value."
- (princ (object-name cp))
+ (princ (eieio-object-name cp))
)
(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
4)))
(while entry
(princ " --> SUBDICTIONARY ")
- (princ (object-name dict))
+ (princ (eieio-object-name dict))
(princ "\n")
(srecode-dump (car entry) newindent)
(setq entry (cdr entry))
(srecode-insert-report-error
dict
"Only section dictionaries allowed for `%s'"
- (object-name-string sti)))
+ (eieio-object-name-string sti)))
;; Output the code from the sub-template.
(srecode-insert-method (slot-value sti slot) dict))
(let* ((out (srecode-compile-split-code tag input STATE
(oref ins :object-name))))
(oset ins template (srecode-template
- (object-name-string ins)
+ (eieio-object-name-string ins)
:context nil
:args nil
:code (cdr out)))
)
(while (string-match "\\.\\| " fpak)
(setq fpak (replace-match "_" t t fpak)))
- (if (string-match "src/" dir)
- (setq dir (substring dir (match-end 0)))
- (setq dir (file-name-nondirectory (directory-file-name dir))))
+ ;; We can extract package from:
+ ;; 1) a java EDE project source paths,
+ (cond ((ede-current-project)
+ (let* ((proj (ede-current-project))
+ (pths (ede-source-paths proj 'java-mode))
+ (pth)
+ (res))
+ (while (and (not res)
+ (setq pth (expand-file-name (car pths))))
+ (when (string-match pth dir)
+ (setq res (substring dir (match-end 0))))
+ (setq pths (cdr pths)))
+ (setq dir res)))
+ ;; 2) a simple heuristic
+ ((string-match "src/" dir)
+ (setq dir (substring dir (match-end 0))))
+ ;; 3) outer directory as a fallback
+ (t (setq dir (file-name-nondirectory (directory-file-name dir)))))
(setq dir (directory-file-name dir))
(while (string-match "/" dir)
(setq dir (replace-match "." t t dir)))
(let ((semantic-init-hook nil))
(semantic-new-buffer-fcn))
)
+ ;; Force semantic to be enabled in this buffer.
+ (unless (semantic-active-p)
+ (semantic-new-buffer-fcn))
(semantic-fetch-tags)
(let* ((mode-tag
(ctxtcons (assoc ctxt alltabs))
(bind (if (slot-boundp temp 'binding)
(oref temp binding)))
- (name (object-name-string temp)))
+ (name (eieio-object-name-string temp)))
(when (not ctxtcons)
(if (string= context ctxt)
"Keymap used in srecode mode.")
;;;###autoload
-(define-derived-mode srecode-template-mode fundamental-mode "SRecorder"
+(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
"Major-mode for writing SRecode macros."
(set (make-local-variable 'comment-start) ";;")
(set (make-local-variable 'comment-end) "")
"Provide help for working with macros in a template."
(interactive)
(let* ((root 'srecode-template-inserter)
- (chl (aref (class-v root) class-children))
+ (chl (eieio--class-children (class-v root)))
(ess (srecode-template-get-escape-start))
(ees (srecode-template-get-escape-end))
)
(showexample t)
)
(setq chl (cdr chl))
- (setq chl (append (aref (class-v C) class-children) chl))
+ (setq chl (append (eieio--class-children (class-v C)) chl))
(catch 'skip
(when (eq C 'srecode-template-inserter-section-end)
nil initial (or hist 'srecode-read-major-mode-history))
)
+;;;###autoload
(defun srecode-semantic-handle-:srt (dict)
"Add macros into the dictionary DICT based on the current SRT file.
Adds the following:
(provide 'srecode/srt)
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "srecode/srt"
+;; End:
+
;;; srecode/srt.el ends here
(defmethod srecode-dump ((tab srecode-template-table))
"Dump the contents of the SRecode template table TAB."
(princ "Template Table for ")
- (princ (object-name-string tab))
+ (princ (eieio-object-name-string tab))
(princ "\nPriority: ")
(prin1 (oref tab :priority))
(when (oref tab :application)
;; Each object should have an opportunity to show stuff about itself.
(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
- prefix)
+ prefix)
"Insert the slots of OBJ into the current DDEBUG buffer."
- (data-debug-insert-thing (eieio-object-name-string obj)
- prefix
- "Name: ")
- (let* ((cl (eieio-object-class obj))
- (cv (class-v cl)))
- (data-debug-insert-thing (class-constructor cl)
- prefix
- "Class: ")
- ;; Loop over all the public slots
- (let ((publa (eieio--class-public-a cv))
- )
- (while publa
- (if (slot-boundp obj (car publa))
- (let* ((i (class-slot-initarg cl (car publa)))
- (v (eieio-oref obj (car publa))))
- (data-debug-insert-thing
- v prefix (concat
- (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")))
- ;; Unbound case
- (let ((i (class-slot-initarg cl (car publa))))
- (data-debug-insert-custom
- "#unbound" prefix
- (concat (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")
- 'font-lock-keyword-face))
- )
- (setq publa (cdr publa))))))
+ (let ((inhibit-read-only t))
+ (data-debug-insert-thing (eieio-object-name-string obj)
+ prefix
+ "Name: ")
+ (let* ((cl (eieio-object-class obj))
+ (cv (class-v cl)))
+ (data-debug-insert-thing (class-constructor cl)
+ prefix
+ "Class: ")
+ ;; Loop over all the public slots
+ (let ((publa (eieio--class-public-a cv))
+ )
+ (while publa
+ (if (slot-boundp obj (car publa))
+ (let* ((i (class-slot-initarg cl (car publa)))
+ (v (eieio-oref obj (car publa))))
+ (data-debug-insert-thing
+ v prefix (concat
+ (if i (symbol-name i)
+ (symbol-name (car publa)))
+ " ")))
+ ;; Unbound case
+ (let ((i (class-slot-initarg cl (car publa))))
+ (data-debug-insert-custom
+ "#unbound" prefix
+ (concat (if i (symbol-name i)
+ (symbol-name (car publa)))
+ " ")
+ 'font-lock-keyword-face))
+ )
+ (setq publa (cdr publa)))))))
;;; Augment the Data debug thing display list.
(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
projects / emacs.git / commitdiff