diff options
Diffstat (limited to 'lisp')
43 files changed, 582 insertions, 211 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 30f4739a8a9..1d8a05cf385 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +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 diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 2ccce8bb01d..3991a98d3f4 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,175 @@ +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. diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 36561090bd2..236040befb8 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -88,6 +88,24 @@ specific conversions during tests." (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 diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 3867f628b93..5fecd8b994f 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -330,14 +330,14 @@ Argument MENU-DEF is the menu definition to use." (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) ] @@ -382,7 +382,7 @@ but can also be used interactively." (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) @@ -727,7 +727,7 @@ Optional argument NAME is the name to give this project." '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 @@ -779,7 +779,7 @@ Optional argument NAME is the name to give this project." :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))) @@ -885,7 +885,7 @@ a string \"y\" or \"n\", which answers the y/n question done interactively." (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) @@ -979,12 +979,12 @@ Argument PROMPT is the prompt to use when querying the user for a target." (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." @@ -992,45 +992,45 @@ Argument FNND is an argument." (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. @@ -1157,18 +1157,15 @@ Optional argument OBJ is an object to find the parent of." (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. @@ -1372,20 +1369,24 @@ and <root>/doc for doc sources." ;; 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." diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index 22fce372e24..c0baf0fc8f8 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -199,8 +199,8 @@ added. Possible values are: 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 diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 1368ea348a0..5302ac3207a 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -135,7 +135,9 @@ other desired outcome.") (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) @@ -350,12 +352,12 @@ All specific project types must derive from this project." (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) @@ -610,6 +612,28 @@ instead of the current project." cp))))) +;;; 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)))) + ) + + + + ;;; Hooks & Autoloads ;; ;; These let us watch various activities, and respond appropriately. diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index d31ede723cc..cf2009ced30 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -242,11 +242,11 @@ ROOTPROJ is nil, since there is only one project." (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 @@ -272,10 +272,12 @@ ROOTPROJ is nil, since there is only one 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 @@ -339,6 +341,15 @@ The function symbol must take two arguments: 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.") @@ -366,7 +377,7 @@ 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)) @@ -404,7 +415,8 @@ If one doesn't exist, create a new one for this directory." :name (file-name-nondirectory (directory-file-name dir)) :path dir - :source nil)) + :source nil + :project proj)) (object-add-to-list proj :targets ans) ) ans)) @@ -481,15 +493,6 @@ This is for project include paths and spp source files." 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)) @@ -506,11 +509,18 @@ Also set up the lexical preprocessor map." (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)) @@ -522,6 +532,29 @@ Also set up the lexical preprocessor map." "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. diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index 925730c8121..f5a85f4a01b 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -59,7 +59,7 @@ DIR is the directory to search from." "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))) @@ -134,7 +134,7 @@ m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") 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 diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 015f4fd9663..91433add7b0 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -50,12 +50,13 @@ 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 () @@ -508,6 +509,26 @@ Argument DIR is the directory to trim upwards." 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: diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index 072e2c2666a..3dbe3153680 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -163,7 +163,7 @@ that created this EDE locate object." "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 ;; diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 310014a0b64..a29e3720ea2 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -152,7 +152,7 @@ don't do it. A value of nil means to just do it.") (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)) diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 8b426aa183f..d7720f25681 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -170,7 +170,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)." (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) @@ -194,7 +194,8 @@ is found, such as a `-version' variable, or the standard header." (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 diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 2da2737d377..702e35f0b1f 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -512,11 +512,11 @@ Optional argument COMMAND is the s the alternate command to use." (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." diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el index 88a3e0a4512..71a79a1b706 100644 --- a/lisp/cedet/ede/util.el +++ b/lisp/cedet/ede/util.el @@ -49,7 +49,7 @@ Argument NEWVERSION is the version number to use in the current project." (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. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index edf2d0cb21a..3c93a8794b1 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -466,11 +466,10 @@ unterminated syntax." (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))) ;;; Parsing functions ;; @@ -756,7 +755,7 @@ This function returns semantic tags without overlays." 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. ) @@ -934,7 +933,8 @@ Throw away all the old tags, and recreate the tag database." '("--")) (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 diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index d1476111403..000193d4a55 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -800,7 +800,7 @@ CONTEXT's content is described in `semantic-analyze-current-context'." (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)) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 6ee85b298a2..42bc482a1df 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -255,7 +255,7 @@ Optional argument TYPE-DECLARATION is how TYPE was found referenced." (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)) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 7aa93a0c942..2f8cf08af3e 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -155,15 +155,16 @@ part of the preprocessor map.") ;; 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. @@ -1946,15 +1947,17 @@ have to be wrapped in that namespace." "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 () @@ -2151,14 +2154,18 @@ actually in their parent which is not accessible.") (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") )) @@ -2173,7 +2180,7 @@ actually in their parent which is not accessible.") )) (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)) @@ -2183,25 +2190,27 @@ actually in their parent which is not accessible.") )) (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") diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 82876adb37e..7beb8ff3203 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -157,7 +157,11 @@ It should also include other symbols GCC was compiled with.") ;; `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)) diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 194e0ee5f66..1c2ddf45c9d 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -678,7 +678,8 @@ a reasonable distance." ;;(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) @@ -686,8 +687,10 @@ a reasonable distance." (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) ) @@ -710,7 +713,6 @@ a reasonable distance." (t ;; Else, show completions now (semantic-complete-inline-force-display) - )))) ;; If something goes terribly wrong, clean up after ourselves. (error (semantic-complete-inline-exit)))) @@ -761,6 +763,10 @@ END is at the end of the current symbol being completed." (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) @@ -1171,7 +1177,7 @@ These collectors track themselves on a per-buffer basis." (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))) @@ -1510,7 +1516,7 @@ one in the source buffer." (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))) diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 260f964c191..1b0f3292ad3 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -216,9 +216,8 @@ TOKTYPE is a hint to the type of tag desired." (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. diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 269ff264126..2ef4fba1288 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -44,6 +44,8 @@ (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." @@ -316,7 +318,7 @@ Argument OBJ is the object to write." (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. diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 77fd10fc7aa..2e4ca319a9d 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -244,7 +244,7 @@ This class will cache data derived during various searches.") (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))) ))) @@ -919,7 +919,7 @@ but should be good enough for debugging assertions." (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 " ") @@ -1285,7 +1285,7 @@ associated with that tag should be loaded into a buffer." (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) diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index a6088231c61..e8784c4f85c 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -190,7 +190,7 @@ If one doesn't exist, create it." (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 )) @@ -469,7 +469,7 @@ other than :table." (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 @@ -520,7 +520,7 @@ other than :table." (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 diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index 3a08db2b0d0..0451ad44fe8 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -797,7 +797,7 @@ Argument EVENT describes the event that caused this function to be called." (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)) @@ -810,7 +810,7 @@ Argument EVENT describes the event that caused this function to be called." " Needs to be parsed.") (t "")))) (princ (format "\n %s :\tUnparsed" - (object-name-string p)))) + (eieio-object-name-string p)))) ))) ))) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index 094832a8258..cb2a1faaac0 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -162,7 +162,7 @@ Lays claim to all -by.el, and -wy.el files." (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 diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index aa42a77725e..f660c69ec3d 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -313,6 +313,15 @@ TABLE is a tag table. See `semantic-something-to-tag-table'." (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 diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index ba4570e692b..9cb0f60b80a 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -51,6 +51,9 @@ (declare-function semantic-grammar-wy--install-parser "semantic/gram-wy-fallback") +(declare-function semantic-grammar-wy--install-parser + "semantic/gram-wy-fallback") + ;;;; ;;;; Set up lexer diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index e2d143b529e..32117da1af5 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -43,6 +43,11 @@ This will replace the named bucket that would have usually occurred here." :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 @@ -405,7 +410,12 @@ Returns the tag list, or t for an error." (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))) diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 6b58689524c..b32e11290ac 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -522,7 +522,7 @@ See `semantic-tag-external-member-children' for details." (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) diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 7e5913334ea..53da7b65661 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -146,36 +146,42 @@ are the same. 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 ;; diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index b91f96f611d..d6798f7523d 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -157,6 +157,30 @@ do not contain any text from preceding or following text." (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 diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 170b99c1fd2..0d68036c433 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -510,12 +510,12 @@ to the inserter constructor." ;;(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)) @@ -594,7 +594,7 @@ A list of defined variables VARS provides a variable table." (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") @@ -640,12 +640,12 @@ Argument INDENT specifies the indentation level for the list." (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)) diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 94b394a1631..fd500b6d9a3 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -70,8 +70,7 @@ HEADER - Shown section if in a header file." (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) ) ) diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index bac05666726..bbc791f09d8 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -175,7 +175,7 @@ associated with a buffer or parent." ((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 @@ -454,12 +454,12 @@ If you subclass `srecode-dictionary-compound-value' then this 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) @@ -654,7 +654,7 @@ STATE is the current compiler state." 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)) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 466efae3b9c..0d647bb56c5 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -809,7 +809,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (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)) @@ -866,7 +866,7 @@ Return the remains of INPUT." (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))) diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index db4d2deee28..29a8465c45c 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -42,9 +42,24 @@ FILENAME_AS_CLASS - file converted to a Java class name." ) (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))) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index cbe602f3299..1dd9ba4cf47 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -363,6 +363,9 @@ Return non-nil if the map changed." (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 diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 8c4a53ec891..e8e1c78198e 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -225,7 +225,7 @@ MENU-DEF is the menu to bind this into." (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) diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 455895c003d..2f43dc3872b 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -187,7 +187,7 @@ we can tell font lock about them.") "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) "") @@ -232,7 +232,7 @@ we can tell font lock about them.") "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)) ) @@ -248,7 +248,7 @@ we can tell font lock about them.") (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) diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el index 3875246cb37..1fad31dafd6 100644 --- a/lisp/cedet/srecode/srt.el +++ b/lisp/cedet/srecode/srt.el @@ -69,6 +69,7 @@ DEFAULT is the default if RET is hit." 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: @@ -104,4 +105,9 @@ MODE - The mode of this buffer. If not declared yet, guess." (provide 'srecode/srt) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "srecode/srt" +;; End: + ;;; srecode/srt.el ends here diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 802740ba063..26163bd1e51 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -251,7 +251,7 @@ Use PREDICATE is the same as for the `sort' function." (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) diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 7daa24257a1..d3ae8b191e1 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -80,38 +80,39 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ;; 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)) |