summaryrefslogtreecommitdiff
path: root/lisp/cedet
diff options
context:
space:
mode:
authorKen Raeburn <raeburn@raeburn.org>2015-11-01 01:42:21 -0400
committerKen Raeburn <raeburn@raeburn.org>2015-11-01 01:42:21 -0400
commit39372e1a1032521be74575bb06f95a3898fbae30 (patch)
tree754bd242a23d2358ea116126fcb0a629947bd9ec /lisp/cedet
parent6a3121904d76e3b2f63007341d48c5c1af55de80 (diff)
parente11aaee266da52937a3a031cb108fe13f68958c3 (diff)
downloademacs-39372e1a1032521be74575bb06f95a3898fbae30.tar.gz
merge from trunk
Diffstat (limited to 'lisp/cedet')
-rw-r--r--lisp/cedet/ChangeLog.1 (renamed from lisp/cedet/ChangeLog)823
-rw-r--r--lisp/cedet/cedet-cscope.el2
-rw-r--r--lisp/cedet/cedet-files.el2
-rw-r--r--lisp/cedet/cedet-global.el23
-rw-r--r--lisp/cedet/cedet-idutils.el2
-rw-r--r--lisp/cedet/cedet.el2
-rw-r--r--lisp/cedet/data-debug.el24
-rw-r--r--lisp/cedet/ede.el443
-rw-r--r--lisp/cedet/ede/auto.el225
-rw-r--r--lisp/cedet/ede/autoconf-edit.el3
-rw-r--r--lisp/cedet/ede/base.el64
-rw-r--r--lisp/cedet/ede/config.el424
-rw-r--r--lisp/cedet/ede/cpp-root.el152
-rw-r--r--lisp/cedet/ede/custom.el16
-rw-r--r--lisp/cedet/ede/detect.el210
-rw-r--r--lisp/cedet/ede/dired.el10
-rw-r--r--lisp/cedet/ede/emacs.el125
-rw-r--r--lisp/cedet/ede/files.el342
-rw-r--r--lisp/cedet/ede/generic.el325
-rw-r--r--lisp/cedet/ede/linux.el265
-rw-r--r--lisp/cedet/ede/locate.el64
-rw-r--r--lisp/cedet/ede/make.el2
-rw-r--r--lisp/cedet/ede/makefile-edit.el2
-rw-r--r--lisp/cedet/ede/pconf.el31
-rw-r--r--lisp/cedet/ede/pmake.el65
-rw-r--r--lisp/cedet/ede/proj-archive.el10
-rw-r--r--lisp/cedet/ede/proj-aux.el4
-rw-r--r--lisp/cedet/ede/proj-comp.el26
-rw-r--r--lisp/cedet/ede/proj-elisp.el57
-rw-r--r--lisp/cedet/ede/proj-info.el22
-rw-r--r--lisp/cedet/ede/proj-misc.el8
-rw-r--r--lisp/cedet/ede/proj-obj.el20
-rw-r--r--lisp/cedet/ede/proj-prog.el20
-rw-r--r--lisp/cedet/ede/proj-scheme.el4
-rw-r--r--lisp/cedet/ede/proj-shared.el16
-rw-r--r--lisp/cedet/ede/proj.el77
-rw-r--r--lisp/cedet/ede/project-am.el122
-rw-r--r--lisp/cedet/ede/shell.el19
-rw-r--r--lisp/cedet/ede/simple.el6
-rw-r--r--lisp/cedet/ede/source.el18
-rw-r--r--lisp/cedet/ede/speedbar.el30
-rw-r--r--lisp/cedet/ede/srecode.el2
-rw-r--r--lisp/cedet/ede/system.el2
-rw-r--r--lisp/cedet/ede/util.el8
-rw-r--r--lisp/cedet/inversion.el6
-rw-r--r--lisp/cedet/mode-local.el143
-rw-r--r--lisp/cedet/pulse.el137
-rw-r--r--lisp/cedet/semantic.el175
-rw-r--r--lisp/cedet/semantic/analyze.el172
-rw-r--r--lisp/cedet/semantic/analyze/complete.el14
-rw-r--r--lisp/cedet/semantic/analyze/debug.el13
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el2
-rw-r--r--lisp/cedet/semantic/analyze/refs.el14
-rw-r--r--lisp/cedet/semantic/bovine.el2
-rw-r--r--lisp/cedet/semantic/bovine/c-by.el2224
-rw-r--r--lisp/cedet/semantic/bovine/c.el277
-rw-r--r--lisp/cedet/semantic/bovine/debug.el10
-rw-r--r--lisp/cedet/semantic/bovine/el.el2
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el26
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el132
-rw-r--r--lisp/cedet/semantic/bovine/make-by.el391
-rw-r--r--lisp/cedet/semantic/bovine/make.el7
-rw-r--r--lisp/cedet/semantic/bovine/scm-by.el196
-rw-r--r--lisp/cedet/semantic/bovine/scm.el6
-rw-r--r--lisp/cedet/semantic/chart.el2
-rw-r--r--lisp/cedet/semantic/complete.el149
-rw-r--r--lisp/cedet/semantic/ctxt.el7
-rw-r--r--lisp/cedet/semantic/db-debug.el2
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el54
-rw-r--r--lisp/cedet/semantic/db-el.el58
-rw-r--r--lisp/cedet/semantic/db-file.el39
-rw-r--r--lisp/cedet/semantic/db-find.el34
-rw-r--r--lisp/cedet/semantic/db-global.el30
-rw-r--r--lisp/cedet/semantic/db-javascript.el38
-rw-r--r--lisp/cedet/semantic/db-mode.el10
-rw-r--r--lisp/cedet/semantic/db-ref.el17
-rw-r--r--lisp/cedet/semantic/db-typecache.el34
-rw-r--r--lisp/cedet/semantic/db.el124
-rw-r--r--lisp/cedet/semantic/debug.el52
-rw-r--r--lisp/cedet/semantic/decorate.el16
-rw-r--r--lisp/cedet/semantic/decorate/include.el44
-rw-r--r--lisp/cedet/semantic/decorate/mode.el12
-rw-r--r--lisp/cedet/semantic/dep.el2
-rw-r--r--lisp/cedet/semantic/doc.el14
-rw-r--r--lisp/cedet/semantic/ede-grammar.el22
-rw-r--r--lisp/cedet/semantic/edit.el10
-rw-r--r--lisp/cedet/semantic/find.el14
-rw-r--r--lisp/cedet/semantic/format.el12
-rw-r--r--lisp/cedet/semantic/fw.el57
-rw-r--r--lisp/cedet/semantic/grammar-wy.el6
-rw-r--r--lisp/cedet/semantic/grammar.el149
-rw-r--r--lisp/cedet/semantic/html.el2
-rw-r--r--lisp/cedet/semantic/ia-sb.el16
-rw-r--r--lisp/cedet/semantic/ia.el37
-rw-r--r--lisp/cedet/semantic/idle.el15
-rw-r--r--lisp/cedet/semantic/imenu.el4
-rw-r--r--lisp/cedet/semantic/java.el4
-rw-r--r--lisp/cedet/semantic/lex-spp.el163
-rw-r--r--lisp/cedet/semantic/lex.el116
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el14
-rw-r--r--lisp/cedet/semantic/sb.el2
-rw-r--r--lisp/cedet/semantic/scope.el66
-rw-r--r--lisp/cedet/semantic/senator.el20
-rw-r--r--lisp/cedet/semantic/sort.el2
-rw-r--r--lisp/cedet/semantic/symref.el222
-rw-r--r--lisp/cedet/semantic/symref/cscope.el6
-rw-r--r--lisp/cedet/semantic/symref/filter.el2
-rw-r--r--lisp/cedet/semantic/symref/global.el6
-rw-r--r--lisp/cedet/semantic/symref/grep.el70
-rw-r--r--lisp/cedet/semantic/symref/idutils.el8
-rw-r--r--lisp/cedet/semantic/symref/list.el95
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el12
-rw-r--r--lisp/cedet/semantic/tag-write.el2
-rw-r--r--lisp/cedet/semantic/tag.el12
-rw-r--r--lisp/cedet/semantic/texi.el6
-rw-r--r--lisp/cedet/semantic/util-modes.el12
-rw-r--r--lisp/cedet/semantic/util.el5
-rw-r--r--lisp/cedet/semantic/wisent.el8
-rw-r--r--lisp/cedet/semantic/wisent/comp.el36
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el116
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el2
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el14
-rw-r--r--lisp/cedet/semantic/wisent/javat-wy.el688
-rw-r--r--lisp/cedet/semantic/wisent/js-wy.el530
-rw-r--r--lisp/cedet/semantic/wisent/python-wy.el847
-rw-r--r--lisp/cedet/semantic/wisent/python.el9
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el12
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/args.el60
-rw-r--r--lisp/cedet/srecode/compile.el38
-rw-r--r--lisp/cedet/srecode/cpp.el4
-rw-r--r--lisp/cedet/srecode/ctxt.el2
-rw-r--r--lisp/cedet/srecode/dictionary.el43
-rw-r--r--lisp/cedet/srecode/document.el6
-rw-r--r--lisp/cedet/srecode/el.el4
-rw-r--r--lisp/cedet/srecode/expandproto.el2
-rw-r--r--lisp/cedet/srecode/extract.el26
-rw-r--r--lisp/cedet/srecode/fields.el47
-rw-r--r--lisp/cedet/srecode/filters.el2
-rw-r--r--lisp/cedet/srecode/find.el12
-rw-r--r--lisp/cedet/srecode/getset.el2
-rw-r--r--lisp/cedet/srecode/insert.el138
-rw-r--r--lisp/cedet/srecode/java.el11
-rw-r--r--lisp/cedet/srecode/map.el26
-rw-r--r--lisp/cedet/srecode/mode.el2
-rw-r--r--lisp/cedet/srecode/semantic.el4
-rw-r--r--lisp/cedet/srecode/srt-mode.el11
-rw-r--r--lisp/cedet/srecode/srt-wy.el306
-rw-r--r--lisp/cedet/srecode/srt.el2
-rw-r--r--lisp/cedet/srecode/table.el9
-rw-r--r--lisp/cedet/srecode/template.el2
-rw-r--r--lisp/cedet/srecode/texi.el14
153 files changed, 4915 insertions, 8117 deletions
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog.1
index c39a8a700ef..c9ddc382d50 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog.1
@@ -1,6 +1,686 @@
-2013-07-29 David Engster <deng@randomsample.de>
+2015-02-22 Paul Eggert <eggert@cs.ucla.edu>
- * lisp/cedet/cedet.el (cedet-packages): Remove speedbar since its
+ Spelling fixes
+ * semantic/doc.el (semantic-documentation-comment-preceding-tag):
+ Rename from semantic-documentation-comment-preceeding-tag. All
+ uses changed. Leave an obsolete alias behind.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+ (semanticdb-project-database => sym). Avoid eieio--class-public-a
+ when possible.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use cl-generic instead of EIEIO's defgeneric/defmethod.
+ * **/*.el: Mechanically replace all calls to defmethod/defgeneric by
+ calls to cl-defmethod/cl-defgeneric.
+ * srecode/table.el:
+ * srecode/fields.el:
+ * srecode/dictionary.el:
+ * srecode/compile.el:
+ * semantic/debug.el:
+ * semantic/db-ref.el:
+ * ede/base.el:
+ * ede/auto.el:
+ * ede.el: Require `cl-generic'.
+
+2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Don't use <class> as a variable and don't assume that <class>-list-p is
+ automatically defined.
+
+ * ede/speedbar.el (ede-speedbar-compile-line)
+ (ede-speedbar-get-top-project-for-line):
+ * ede.el (ede-buffer-belongs-to-target-p)
+ (ede-buffer-belongs-to-project-p, ede-build-forms-menu)
+ (ede-add-project-to-global-list):
+ * semantic/db-typecache.el (semanticdb-get-typecache):
+ * semantic/db-file.el (semanticdb-load-database):
+ * semantic/db-el.el (semanticdb-elisp-sym->tag):
+ * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper):
+ * ede/project-am.el (project-am-preferred-target-type):
+ * ede/proj.el (ede-proj-load):
+ * ede/custom.el (ede-customize-current-target, ede-customize-target):
+ * semantic/ede-grammar.el ("semantic grammar"):
+ * semantic/scope.el (semantic-scope-reset-cache)
+ (semantic-calculate-scope):
+ * srecode/map.el (srecode-map-update-map):
+ * srecode/insert.el (srecode-insert-show-error-report)
+ (srecode-insert-method, srecode-insert-include-lookup)
+ (srecode-insert-method):
+ * srecode/fields.el (srecode-active-template-region):
+ * srecode/compile.el (srecode-flush-active-templates)
+ (srecode-compile-inserter): Don't use <class> as a variable.
+ Use `oref-default' for class slots.
+
+ * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var.
+ (semantic-grammar-eldoc-get-macro-docstring): Use it instead of
+ eldoc-last-data.
+ * semantic/fw.el (semantic-exit-on-input): Use `declare'.
+ (semantic-throw-on-input): Use `with-current-buffer'.
+ * semantic/db.el (semanticdb-abstract-table-list): Define if not
+ pre-defined.
+ * semantic/db-find.el (semanticdb-find-tags-collector):
+ Use save-current-buffer.
+ (semanticdb-find-tags-collector): Don't use <class> as a variable.
+ * semantic/complete.el (semantic-complete-active-default)
+ (semantic-complete-current-matched-tag): Declare.
+ (semantic-complete-inline-custom-type): Don't use <class> as a variable.
+ * semantic/bovine/make.el (semantic-analyze-possible-completions):
+ Use with-current-buffer.
+ * semantic.el (semantic-parser-warnings): Declare.
+ * ede/base.el (ede-target-list): Define if not pre-defined.
+ (ede-with-projectfile): Prefer find-file-noselect over
+ save-window-excursion.
+
+2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children.
+
+ * semantic/db.el (semanticdb-cache-get): Prefer eieio-object-class over
+ eieio--object-class.
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Prefer find-class over
+ class-v.
+
+ * ede/generic.el (ede-find-target): Prefer \` and \' to ^ and $.
+
+2014-12-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * semantic.el (semantic-analyze-completion-at-point-function)
+ (semantic-analyze-notc-completion-at-point-function)
+ (semantic-analyze-nolongprefix-completion-at-point-function):
+ Do nothing if the current buffer is not using Semantic (bug#19077).
+
+2014-12-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * semantic/lex-spp.el (semantic-lex-spp-analyzer-do-replace):
+ Rename from semantic-lex-spp-anlyzer-do-replace.
+
+2014-12-08 Matt Curtis <matt.r.curtis@gmail.com> (tiny change)
+
+ * pulse.el (pulse-momentary-highlight-one-line): Respect the POINT
+ argument (bug#17260).
+
+2014-11-09 Eric Ludlam <zappo@gnu.org>
+
+ * semantic.el (semantic-mode): Add/remove 3
+ completion-at-point-functions.
+ (semantic-completion-at-point-function): Remove.
+ (semantic-analyze-completion-at-point-function)
+ (semantic-analyze-notc-completion-at-point-function)
+ (semantic-analyze-nolongprefix-completion-at-point-function):
+ New completion at point functions.
+
+ * semantic/doc.el (semantic-doc-snarf-comment-for-tag): Fix case
+ when comment-end is empty string.
+
+ * semantic/debug.el
+ (semantic-debug-parser-debugger-source): New buffer local
+ variable.
+ (semantic-debug-interface): Add 'nil' initform to overlays.
+ (semantic-debug-mode): Remove read-only tags from buffers on exit.
+ (semantic-debug): Add autoload cookie. Force the language
+ specific debugger to load.
+
+ * semantic/db.el (generic::semanticdb-full-filename): New generic
+ method to allow this method to be used on buffer names via an
+ associated database.
+
+ * semantic/symref.el
+ (semantic-symref-cleanup-recent-buffers-fcn): When cleaning up
+ buffers, don't clean up buffers that are being used (i.e., in a
+ window) when the hook fires.
+ (semantic-symref-recently-opened-buffers): New tracking variable.
+ (semantic-symref-cleanup-recent-buffers-fcn): New hook fcn.
+ (semantic-symref-result-get-tags): Move logic into
+ `semantic-symref-hit-to-tag-via-buffer', and cleanup buffers via
+ the symref cleanup function in post-command-hook.
+ (semantic-symref-hit-to-tag-via-buffer): Logic that used to be
+ from above.
+ (semantic-symref-hit-to-tag-via-db): New.
+
+ * semantic/analyze.el:
+ (semantic-analyze-find-tag-sequence-default): If first entry in
+ sequence is the only one, apply tagclass filter.
+ (semantic-analyze-princ-sequence): Show slot even if empty.
+ (semantic-analyze-find-tag-sequence)
+ (semantic-analyze-find-tag-sequence-default): Add flags argument.
+ Add support for forcing the final entry of the sequence to be of
+ class variable.
+ (semantic-analyze-find-tag): Fix bug where input class filter was
+ ignored if there was a typecache match.
+ (semantic-analyze-current-context-default): For assignments, the
+ assignee now must be of class variable.
+
+ * semantic/analyze/complete.el
+ (semantic-analyze-possible-completions-default):
+ Add 'no-longprefix' flag. When used, the prefix and prefixtypes are
+ shortened to just the last symbol.
+
+ * semantic/bovine/c.el (semantic-c-do-lex-if): Catch errors from
+ 'hideif', and push to the parser warning stack.
+ (semantic-lex-cpp-define): When a comment is at the end of a
+ macro, do not subtract an extra 1 from the found position.
+ Fixes bug with: #define foo (a)/**/ adding an extra ')' to the stream.
+
+ * semantic/bovine/scm.el (semantic-lex-scheme-symbol):
+ Allow symbols to be one char long.
+
+ * semantic/bovine/grammar.el
+ (bovine-grammar-calculate-source-on-path): New.
+ (bovine-grammar-setupcode-builder): Use it.
+
+ * ede.el (ede/detect): New require.
+ (ede-version): Bump version
+ (ede-initialize-state-current-buffer): Use new
+ `ede-detect-directory-for-project' to detect projects first
+ instead of depending on currente dir only.
+ (ede-delete-project-from-global-list): New.
+ (ede-flush-deleted-projects): Use above.
+ (ede-check-project-query-fcn): New variable
+ (ede-check-project-directory): Use above when querying the user.
+ Added to support unit testing of this security measure.
+ (ede-initialize-state-current-buffer):
+ Use `ede-directory-project-cons' instead of the -detect- fcn to take
+ advantage of the cache. Pass found project into
+ `ede-load-project-file'.
+ (ede-load-project-file): Add new input DETECTIN.
+ (ede-rescan-toplevel): Get the proj root a better way.
+ (ede-load-project-file): Return the loaded object. When asking
+ for existing project, ask for an exact match.
+ (ede-initialize-state-current-buffer): Simplify some conditional
+ logic.
+ (ede-load-project-file): Simplify conditional logic.
+ (ede-global-list-sanity-check): New Testing fcn.
+ (ede-parent-project): Replace old code with call to faster
+ `ede-find-subproject-for-directory'.
+ (ede-load-project-file):
+ Use `ede-directory-get-toplevel-open-project' instead of above
+ deleted. Rename "pfc" to "autoloader".
+ Use `ede-directory-project-cons' to detect a project. Delete no
+ project found case where we search up the tree.
+
+ * ede/auto.el (ede-project-autoload): Fix doc typo.
+ Add `:root-only' slot.
+ (ede-auto-load-project): Doc update: warn to not use.
+ (ede-dir-to-projectfile): Delete.
+ (ede-project-autoload-dirmatch): Add subdir-only slot.
+ Make configdatastash unbound by default.
+ (ede-do-dirmatch): If subdir-only is true, then don't allow exact
+ matches. Account for configdatastash as unbound. Assume value of
+ nil means no tool installed. Make sure loaded path matches from
+ beginning. Stash the regexp, not the raw string.
+ (ede-project-class-files): Note that makefile and automake are not
+ root only.
+ (ede-auto-detect-in-dir): New (for use with `ede/detect.el').
+ (ede-project-dirmatch-p): Delete.
+ (ede-project-root-directory): Remove body, return nil.
+ (ede-project-autoload): :proj-root-dirmatch can be null & doc fix.
+ (ede-auto-detect-in-dir): If there is no :proj-file, check for a
+ dirmatch.
+
+ * ede/generic.el (ede/config): Replace require of ede.
+ (ede-generic-new-autoloader): Generic projects are now safe by
+ default. Note this is NOT a root only project.
+ (project-rescan, ede-project-root, ede-generic-target-java)
+ (ede-java-classpath, ede-find-subproject-for-directory): New.
+ (ede-enable-generic-projects): Add new autoloaders for git, bzr,
+ hg, sv, CVS.
+ (ede-generic-vc-project)
+ (ede-generic-vc-project::ede-generic-setup-configuration): New.
+ (ede-generic-config): Remove slots: c-include-path,
+ c-preprocessor-table, c-preprocessor-files, classpath,
+ build-command, debug-command, run command. Inherit from
+ ede-extra-config-build, ede-extra-config-program.
+ Make run-command :value match :custom so only strings are accepted.
+ Add some more :group slot specifiers.
+ (ede-generic-project): Add mixins `ede-project-with-config-c' and
+ `ede-project-with-config-java'. Inherit from
+ `ede-project-with-config-build',
+ `ede-project-with-config-program'. Subclass
+ `ede-project-with-config'. Remove duplication from new baseclass.
+ (ede-generic-target): Inherit from `ede-target-with-config-build',
+ `ede-target-with-config-program'. Subclass `ede-target-with-config'.
+ (ede-generic-target-c-cpp): Add mixin `ede-target-with-config-c'.
+ (ede-generic-target-java): Add mixin `ede-target-with-config-java'.
+ (ede-preprocessor-map, ede-system-include-path)
+ (edejava-classpath): Delete, moved to config.el.
+ (project-compile-project, project-compile-target)
+ (project-debug-target, project-run-target): Delete.
+ (ede-generic-get-configuration, ede-generic-setup-configuration)
+ (ede-commit-project, project-rescan)
+ (ede-generic-project::ede-customize)
+ (ede-generic-target::ede-customize)
+ (ede-generic-config::eieio-done-customizing)
+ (ede-generic-config::ede-commit): Delete. Subsumed by new
+ baseclass.
+ (ede-preprocessor-map, ede-system-include-path)
+ (project-debug-target, project-run-target): Call new
+ `ede-config-get-configuration' instead of old version.
+ (ede-generic-load): Do not add to global list here.
+
+ * ede/files.el (ede-find-project-root)
+ (ede-files-find-existing)
+ (ede-directory-get-toplevel-open-project-new): Delete.
+ (ede-project-root-directory): Use `ede-project-root' first.
+ (ede-project-directory-remove-hash)
+ (ede--directory-project-from-hash)
+ (ede--directory-project-add-description-to-hash): Rename to make
+ internal symbols (via --). Expand input dir first.
+ (ede-directory-project-p): Doc fix (note obsoleted.)
+ (ede-toplevel-project-or-nil): Alias to `ede-toplevel-project'.
+ (ede-toplevel-project): Doc Fix. Delete commented out old code.
+ Simplify returning result from ede-detect-directory-for-project.
+ (ede-directory-get-open-project): Support when
+ inodes are disabled. If disabled to str compare on root project.
+ (ede-directory-get-toplevel-open-project): Enabled nested
+ projects. When doing directory name matching, save the 'short'
+ version of an answer (non-exact match) and eventually select the
+ shortest answer at the end. Expand the filename of tested
+ projects. Better support for when inodes are disabled.
+ Add 'exact' option so that it will return a project that is an exact
+ match.
+ (ede-find-subproject-for-directory): Small optimization to run
+ `file-truename' less often.
+ (ede-directory-project-p): Move content, then use
+ `ede-directory-project-cons'.
+ Use `ede-detect-directory-for-project', replacing old detection loop.
+ (ede-directory-project-cons): New, from above.
+ (ede-toplevel-project): Toss old scanning code.
+ Use `ede-detect-directory-for-project' instead.
+ (ede-directory-get-toplevel-open-project-new): New.
+
+ * ede/linux.el (ede-linux-project-root): Delete.
+ (ede-project-autoload): Remove dirmatch entry - it is no longer
+ needed.
+
+ * ede/proj.el (project-rescan): Replace direct
+ manipulation of `ede-projects' with equivalent and better
+ functions.
+ (ede-proj-load): Replace call to test if dir has project to
+ explicity ask filesystem if Project.ede is there.
+
+ * ede/config.el:
+ * ede/detect.el: New files.
+
+ * ede/project-am.el (project-run-target): Add "./" to program to
+ run for systems where '.' isn't in PATH.
+ (project-am-load): Remove old code regarding `ede-constructing'.
+ Just read in the makefiles.
+
+ * ede/linux.el (ede-linux-load): Do not add to global list here.
+ Don't check for existing anymore.
+ (project-rescan): New.
+ (ede-linux-project-list, ede-linux-file-existing): Delete.
+ (ede-linux-project-root): Delete body. Need symbol for autoloads
+ for now.
+ (ede-linux-project): No longer instance tracker.
+ (ede-project-autoload): Don't provide :proj-root
+
+ * ede/emacs.el (ede-emacs-load): Do not add project to global list
+ here. Don't look for existing first.
+ (ede-project-autoload): Remove dirmatch entry - it is no longer
+ needed. Don't provide proj-root anymore.
+ (ede-emacs-project-list, ede-emacs-file-existing): Delete.
+ (ede-emacs-project-root): Remove body (need symbol for loaddefs
+ still).
+ (ede-emacs-project): Do not instance track anymore.
+
+ * ede/cpp-root.el (initialize-instance): Remove commented code.
+ Add note about why we are adding the project to the master list.
+ Make sure if we are replacing a prev version, remove from global
+ list.
+ (ede-cpp-root-file-existing)
+ (ede-cpp-root-project-file-for-dir)
+ (ede-cpp-root-count, ede-cpp-root-project-root, ede-cpp-root-load)
+ (ede-project-autoload cpp-root): Delete.
+ (ede-project-root-directory): Return :directory instead of
+ calculating from :file.
+ (project-rescan): New.
+
+ * ede/base.el (ede-toplevel): Only use buffer cached value if
+ subproj not passed in.
+
+ * srecode/java.el (srecode-semantic-handle-:java): Fix case when
+ an EDE project didn't support java paths.
+
+2014-11-09 David Engster <dengste@eml.cc>
+
+ * ede/proj-elisp.el (ede-proj-target-elisp::ede-proj-tweak-autoconf):
+ Kill buffer after saving modified elisp-comp script, so as to avoid
+ "file has changed on disk; really edit the buffer" questions when
+ script gets rewritten.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * srecode/args.el (srecode-semantic-handle-:time):
+ Don't call current-time twice to get the current time stamp,
+ as this can lead to inconsistent results.
+
+2014-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/complete.el: Require semantic/db-find.
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/wisent/comp.el (wisent-defcontext): Move declarations
+ outside of eval-when-compile. Use `declare'.
+ (wisent-with-context): Add `defvar' declarations in case this macro is
+ used in a file compiled with lexical-binding.
+ (wisent-semantic-action-expand-body): Avoid add-to-list on local var.
+
+2014-09-22 David Engster <deng@randomsample.de>
+
+ * ede/emacs.el (ede-emacs-version): Do not call 'egrep' to
+ determine Emacs version (it was dead code anyway). Make sure that
+ configure.ac or configure.in exist. (Bug#18476)
+
+2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/ia.el (semantic-ia-complete-symbol-menu): Use posn-at-point
+ instead of senator-completion-menu-point-as-event; un-comment, tho keep
+ the "no smart completion" fallback commented since it still doesn't
+ work.
+
+2014-05-01 Glenn Morris <rgm@gnu.org>
+
+ * ede.el (ede-project-directories, ede-check-project-directory):
+ * semantic/ia-sb.el (semantic-ia-sb-show-doc):
+ * semantic/tag.el (semantic-tag-in-buffer-p):
+ * semantic/bovine/c.el (semantic-tag-abstract-p):
+ Doc fixes (replace `iff').
+
+2014-04-01 Glenn Morris <rgm@gnu.org>
+
+ * ede/emacs.el (ede-emacs-version): Update AC_INIT regexp. (Bug#17160)
+
+2014-03-29 Glenn Morris <rgm@gnu.org>
+
+ * ede/dired.el (ede-dired-minor-mode): Add autoload cookie.
+ (generated-autoload-file, generated-autoload-load-name):
+ Set file-local values.
+ * ede.el: Load ede/loaddefs at compile time too.
+ (ede-dired-minor-mode): Remove hand-written autoload.
+
+2014-03-04 Glenn Morris <rgm@gnu.org>
+
+ * semantic/util.el (semantic-complete-symbol):
+ Replace use of obsolete argument of display-completion-list.
+
+2014-02-03 Glenn Morris <rgm@gnu.org>
+
+ * semantic/senator.el (senator-copy-tag-to-register):
+ Use register-read-with-preview, if available.
+
+2014-01-13 Eric Ludlam <zappo@gnu.org>
+
+ * semantic/analyze/refs.el (semantic-analyze-refs-impl): Fix typo
+ in a doc string.
+
+ * semantic/ia.el (semantic-ia-complete-symbol): Ignore case if
+ prefix is all lower case.
+ (semantic-ia-fast-jump): Push mark before jumping to an include file.
+
+ * semantic/complete.el (semantic-displayor-point-position):
+ Calculate if the toolbar is on the left when calculating point
+ position.
+
+2014-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * semantic/decorate/include.el (semantic-decoration-mouse-3):
+ Rename from semantic-decoratiton-mouse-3. All uses changed.
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * ede/linux.el (project-linux-build-directory-default)
+ (project-linux-architecture-default): Fix custom types. Add version.
+
+2013-12-12 David Engster <deng@randomsample.de>
+
+ * semantic/analyze.el (semantic-analyze-find-tag-sequence-default):
+ Always add scope to the local miniscope for each type. Otherwise,
+ structure tags are not analyzed correctly. Also, always search
+ the extended miniscope even when not dealing with types.
+
+ * semantic/ctxt.el (semantic-get-local-variables-default):
+ Also try to parse local variables for buffers which are currently
+ marked as unparseable. Otherwise, it is often impossible to
+ complete local variables.
+
+ * semantic/scope.el (semantic-analyze-scoped-types-default): If we
+ cannot find a type in the typecache, also look into the the types
+ we already found. This is necessary since in C++, a 'using
+ namespace' can be dependend on a previous one.
+ (semantic-completable-tags-from-type): When creating the list of
+ completable types, pull in types which are referenced through
+ 'using' statements, and also preserve their filenames.
+
+ * semantic/bovine/c.el (semantic/analyze/refs): Require.
+ (semantic-analyze-tag-references): New override. Mainly copied
+ from the default implementation, but if nothing could be found (or
+ just the tag itself), drop all namespaces from the scope and
+ search again. This is necessary for implementations which are
+ defined outside of the namespace and only pull those in through
+ 'using' statements.
+ (semantic-ctxt-scoped-types): Go through all tags around point and
+ search them for using statements. In the case for using
+ statements outside of function scope, append them in the correct
+ order instead of using 'cons'. This is important since using
+ statements may depend on previous ones.
+ (semantic-expand-c-tag-namelist): Do not try to parse struct
+ definitions as default values. The grammar parser seems to return
+ the point positions slightly differently (as a cons instead of a
+ list). Also, set parent for typedefs to 'nil'. It does not
+ really make sense to set a parent class for typedefs, and it can
+ also lead to endless loops when calculating scope.
+ (semantic-c-reconstitute-token): Change handling of function
+ pointers; instead of seeing them as variables, handle them as
+ functions with a 'function-pointer' attribute. Also, correctly
+ deal with function pointers as function arguments.
+ (semantic-c-reconstitute-function-arglist): New function to parse
+ function pointers inside an argument list.
+ (semantic-format-tag-name): Use 'function-pointer' attribute
+ instead of the old 'functionpointer-flag'.
+ (semantic-cpp-lexer): Use new `semantic-lex-spp-paren-or-list'.
+
+ * semantic/bovine/gcc.el (semantic-gcc-setup): Add 'features.h' to
+ the list of files whose preprocessor symbols are included.
+ This pulls in things like __USE_POSIX and similar.
+
+ * semantic/format.el (semantic-format-tag-prototype-default):
+ Display default values if available.
+
+ * semantic/analyze/refs.el (semantic-analyze-refs-impl)
+ (semantic-analyze-refs-proto): Add 'default-value' as ignorable in
+ call to `semantic-tag-similar-p'.
+
+ * semantic/db-mode.el (semanticdb-semantic-init-hook-fcn):
+ Always set buffer for `semanticdb-current-table'.
+
+ * semantic/db.el (semanticdb-table::semanticdb-refresh-table):
+ The previous change turned up a bug in this method. Since the current
+ table now correctly has a buffer set, the first clause in the
+ `cond' would be taken, but there was a `save-excursion' missing.
+
+ * semantic/lex-spp.el (semantic-c-end-of-macro): Declare.
+ (semantic-lex-spp-token-macro-to-macro-stream): Deal with macros
+ which open/close a scope. For this, leave an overlay if we
+ encounter a single open paren and return a semantic-list in the
+ lexer. When this list gets expanded, retrieve the old position
+ from the overlay. See the comments in the function for further
+ details.
+ (semantic-lex-spp-find-closing-macro): New function to find the
+ next macro which closes scope (i.e., has a closing paren).
+ (semantic-lex-spp-replace-or-symbol-or-keyword): Go to end of
+ closing macro if necessary.
+ (semantic-lex-spp-paren-or-list): New lexer to specially deal with
+ parens in macro definitions.
+
+ * semantic/decorate/mode.el (semantic-decoration-mode): Do not
+ decorate available tags immediately but in an idle timer, since
+ EDE will usually not be activated yet, which will make it
+ impossible to find project includes.
+
+ * semantic/decorate/include.el
+ (semantic-decoration-on-includes-highlight-default):
+ Remove 'unloaded' from throttle when decorating includes, otherwise all
+ would be loaded. Rename 'table' to 'currenttable' to make things
+ clearer.
+
+ * ede/linux.el (cl): Require during compile.
+
+2013-12-12 Lluís Vilanova <xscript@gmx.net>
+
+ * ede/linux.el (project-linux-build-directory-default)
+ (project-linux-architecture-default): Add customizable variables.
+ (ede-linux-project): Add additional slots to track Linux-specific
+ information (out-of-tree build directory and selected
+ architecture).
+ (ede-linux--get-build-directory, ede-linux--get-archs)
+ (ede-linux--detect-architecture, ede-linux--get-architecture)
+ (ede-linux--include-path): Add function to detect Linux-specific
+ information.
+ (ede-linux-load): Set new Linux-specific information when creating
+ a project.
+ (ede-expand-filename-impl): Use new and more accurate include
+ information.
+
+2013-12-12 Eric Ludlam <zappo@gnu.org>
+
+ * semantic/scope.el (semantic-calculate-scope): Return a clone of
+ the scopecache, so that everyone is working with its own (shallow)
+ copy. Otherwise, if one caller is resetting the scope, it would
+ be reset for all others working with the scope cache as well.
+
+2013-12-12 Alex Ott <alexott@gmail.com>
+
+ * ede/generic.el (project-run-target): Remove incorrect require.
+
+ * semantic/format.el (semantic-format-tag-prototype-default):
+ Use concat only for strings.
+
+2013-11-30 Glenn Morris <rgm@gnu.org>
+
+ Stop keeping (most) generated cedet grammar files in the repository.
+ * semantic/bovine/grammar.el (bovine--make-parser-1):
+ New function, split from bovine-make-parsers.
+ (bovine-make-parsers): Use bovine--make-parser-1.
+ (bovine-batch-make-parser): New function.
+ * semantic/wisent/grammar.el (wisent--make-parser-1):
+ New function, split from wisent-make-parsers.
+ (wisent-make-parsers): Use wisent--make-parser-1.
+ (wisent-batch-make-parser): New function.
+ * semantic/db.el (semanticdb-save-all-db):
+ Avoid prompting in batch mode.
+ * semantic/grammar.el (semantic-grammar-footer-template):
+ Disable version-control and autoloads in the output.
+ (semantic-grammar-create-package):
+ Add option to return nil if output is up-to-date.
+ * semantic/bovine/c-by.el, semantic/bovine/make-by.el:
+ * semantic/bovine/scm-by.el, semantic/wisent/javat-wy.el:
+ * semantic/wisent/js-wy.el, semantic/wisent/python-wy.el:
+ * srecode/srt-wy.el: Remove generated files from repository.
+
+2013-11-16 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * semantic/fw.el (semantic-exit-on-input)
+ (semantic-throw-on-input): Restore point before
+ accept-process-output because timers which redisplay can run.
+ (Bug#15045)
+
+2013-11-03 Johan Bockgård <bojohan@gnu.org>
+
+ * semantic/lex.el (semantic-lex-start-block)
+ (semantic-lex-end-block): Move after definition of
+ semantic-lex-token macro.
+
+2013-10-28 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * semantic/idle.el (semantic-idle-symbol-highlight)
+ (semantic-idle-symbol-highlight-face): Define face with defface
+ and obsolete the replaced one defined with defvar. (Bug#15745)
+ * pulse.el (pulse-momentary-highlight-overlay)
+ (pulse-momentary-highlight-region): Fix typo in doc
+
+2013-10-30 Glenn Morris <rgm@gnu.org>
+
+ * semantic/grammar.el (semantic-grammar-mode-keywords-2)
+ (semantic-grammar-mode-keywords-3): Handle renamed font-lock vars.
+
+2013-10-20 Johan Bockgård <bojohan@gnu.org>
+
+ * semantic/db-mode.el (global-semanticdb-minor-mode):
+ Remove hooks correctly.
+ (semanticdb-toggle-global-mode): Pass `toggle' to minor mode function.
+
+2013-09-28 Leo Liu <sdl.web@gmail.com>
+
+ * semantic/texi.el (semantic-analyze-possible-completions):
+ Use ispell-lookup-words instead. (Bug#15460)
+
+2013-09-20 Glenn Morris <rgm@gnu.org>
+
+ * semantic.el (semantic-new-buffer-fcn-was-run, semantic-active-p):
+ Move from here...
+ * semantic/fw.el: ...to here.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * semantic/find.el (semantic-brute-find-first-tag-by-name):
+ Replace obsolete function assoc-ignore-case with assoc-string.
+
+ * semantic/complete.el (tooltip-mode, tooltip-frame-parameters)
+ (tooltip-show): Declare.
+
+2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/symref/list.el (semantic-symref-results-mode):
+ Use define-derived-mode.
+ (semantic-symref-produce-list-on-results): Set up the results here
+ instead of in semantic-symref-results-mode. Move after
+ semantic-symref-current-results's defvar now that it refers to that var.
+ (semantic-symref-auto-expand-results)
+ (semantic-symref-results-summary-function)
+ (semantic-symref-results-mode-hook): Remove redundant :group arg.
+ (semantic-symref, semantic-symref-symbol, semantic-symref-regexp):
+ Initialize directly in the let.
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * semantic/ia.el (semantic-ia-complete-symbol-menu):
+ Comment it out, since it cannot work. (Bug#14522)
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * semantic/find.el (semantic-find-first-tag-by-name):
+ Replace obsolete function assoc-ignore-case with assoc-string.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/grammar.el (semantic-grammar-mode): Use define-derived-mode.
+ (semantic-grammar-mode-syntax-table): Rename from
+ semantic-grammar-syntax-table.
+ (semantic-grammar-mode-map): Rename from semantic-grammar-map.
+ * data-debug.el (data-debug-mode-map): Rename from data-debug-map.
+ (data-debug-mode): Use define-derived-mode.
+
+2013-09-05 Glenn Morris <rgm@gnu.org>
+
+ * semantic/fw.el (semantic-make-local-hook):
+ Simplify by dropping Emacs <= 20.
+
+2013-07-29 David Engster <deng@randomsample.de>
+
+ * cedet.el (cedet-packages): Remove speedbar since its
development does no longer happens in CEDET upstream but in Emacs
proper. Also remove cedet-contrib and cogre since those are only
in upstream.
@@ -10,18 +690,18 @@
* semantic/decorate/mode.el
(semantic-decoration-on-includes-p-default)
- (semantic-decoration-on-includes-highlight-default): Declare for
+ (semantic-decoration-on-includes-highlight-default): Declare for
byte compiler.
* semantic/wisent/python.el (semantic/format): New require.
-2013-07-27 Eric Ludlam <zappo@gnu.org>
+2013-07-27 Eric Ludlam <zappo@gnu.org>
- * lisp/cedet/semantic/edit.el (semantic-edits-splice-remove): Wrap
- debug message removing middle tag in semantic-edits-verbose-flag
+ * semantic/edit.el (semantic-edits-splice-remove):
+ Wrap debug message removing middle tag in semantic-edits-verbose-flag
check.
-2013-07-27 David Engster <deng@randomsample.de>
+2013-07-27 David Engster <deng@randomsample.de>
* semantic/bovine/el.el (semantic/db-el): New require.
@@ -64,8 +744,8 @@
`semantic/decorate/include' anymore.
(semantic-toggle-decoration-style): Error if an unknown decoration
style is toggled.
- (define-semantic-decoration-style): Add new :load option. When
- :load is specified, add autoload tokens for the definition
+ (define-semantic-decoration-style): Add new :load option.
+ When :load is specified, add autoload tokens for the definition
functions so that code is loaded when the mode is used.
(semantic-decoration-on-includes): New autoload definition for
highlighting includes.
@@ -89,8 +769,8 @@
* semantic/ctxt.el (semantic-ctxt-end-of-symbol): New.
(semantic-ctxt-current-symbol-default): New.
- * semantic/bovine/el.el (semantic-default-elisp-setup): Add
- autoload cookie. Explain existence.
+ * semantic/bovine/el.el (semantic-default-elisp-setup):
+ Add autoload cookie. Explain existence.
(footer): Add local variable for loaddefs.
* semantic/db.el (semanticdb-file-table-object): Add new filter,
@@ -115,7 +795,7 @@
* ede/cpp-root.el (ede-preprocessor-map): Protect against init
problems.
- * ede/proj.el (ede-proj-target): Added a new "custom" option for
+ * ede/proj.el (ede-proj-target): Add a new "custom" option for
custom symbols representing a compiler or linker instead of
restricting things to only the predefined compilers and linkers.
@@ -193,19 +873,19 @@
2013-04-27 David Engster <deng@randomsample.de>
* semantic/complete.el
- (semantic-collector-calculate-completions-raw): If
- `completionslist' is not set, refresh the cache if necessary and
+ (semantic-collector-calculate-completions-raw):
+ If `completionslist' is not set, refresh the cache if necessary and
use it for completions. This fixes the
`semantic-collector-buffer-deep' collector (bug#14265).
2013-03-26 Leo Liu <sdl.web@gmail.com>
- * semantic/senator.el (senator-copy-tag-to-register): Move
- register handling logic from register.el. (Bug#14052)
+ * semantic/senator.el (senator-copy-tag-to-register):
+ Move register handling logic from register.el. (Bug#14052)
2013-03-21 Eric Ludlam <zappo@gnu.org>
- * semantic.el (navigate-menu): Yank Tag :enable. Make sure
+ * 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.
@@ -218,17 +898,17 @@
* 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/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
+ (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.
+ * 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.
@@ -238,19 +918,19 @@
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/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
+ * 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/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.
@@ -266,8 +946,8 @@
* 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
+ * 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
@@ -282,7 +962,7 @@
has both a version variable and a Version: comment, always use
`call-next-method'.
- * ede/cpp-root.el (ede-set-project-variables): Deleted.
+ * ede/cpp-root.el (ede-set-project-variables): Delete.
`ede-preprocessor-map' does the job this function was attempting
to do with :spp-table.
(ede-preprocessor-map): Update file tests to provide better
@@ -297,8 +977,8 @@
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
+ 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.
@@ -307,18 +987,15 @@
* 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:
@@ -345,14 +1022,14 @@
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
+ * 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.
+ * 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.
@@ -558,9 +1235,9 @@
* ede.el (ede-buffer-belongs-to-project-p): Use ede-object-project
to allow use in more kinds of buffers.
(ede-project-forms-menu): Add `Default configuration' menu item.
- (ede-configuration-forms-menu): New, for use in above.
- (ede-project-configurations-set): New command used from menu.
- (ede-java-classpath): New conveninece for Java support.
+ (ede-configuration-forms-menu): New, for use in above.
+ (ede-project-configurations-set): New command used from menu.
+ (ede-java-classpath): New conveninece for Java support.
(ede-apply-object-keymap): Combine keybindings from the project
and the target, not just whatever is local to the buffer.
(ede-apply-target-options): Call fcn to apply project local
@@ -627,9 +1304,9 @@
(-scheme, -makefile-misc, ede-proj-target-makefile-program)
(-makefile-archive, -makefile-shared-object)
(ede-proj-target-makefile-info, -grammar): New autoloads.
- (ede-proj-project): Inherit from eieio-persistent-read.
+ (ede-proj-project): Inherit from eieio-persistent-read.
Specify extension and header line.
- (ede-proj-load, ede-proj-save): Replace with impl using
+ (ede-proj-load, ede-proj-save): Replace with impl using
eieio-persistent-read.
* ede/project-am.el (project-add-file): Use ede-target-parent
@@ -673,7 +1350,7 @@
* semantic/db-typecache.el
(semanticdb-abstract-table::semanticdb-typecache-find-method):
Allow proxied tags to be resolved during the search.
- (semanticdb-typecache-complete-flush): Support missing or empty
+ (semanticdb-typecache-complete-flush): Support missing or empty
pointmax slot, to allow for more database types.
* semantic/db.el (semanticdb-abstract-table): Add db-refs slot.
@@ -738,7 +1415,7 @@
* srecode/compile.el (srecode-compile-templates): Add "framework"
special variable support.
- (srecode-compile-template-table): Support framework specifier.
+ (srecode-compile-template-table): Support framework specifier.
* srecode/cpp.el (srecode-semantic-handle-:c)
(srecode-semantic-handle-:cpp): New functions.
@@ -763,7 +1440,7 @@
* srecode/srt-mode.el (srecode-font-lock-keywords): Update.
* srecode/table.el (srecode-template-table): Add :framework slot.
- (srecode-dump): Dump it.
+ (srecode-dump): Dump it.
(srecode-mode-table): Add new modetables slot.
(srecode-get-mode-table): Find the mode, but also find all parent
modes, and merge the tables together in :tables from :modetables.
@@ -799,7 +1476,7 @@
(ede-proj-makefile-insert-variables): Do not insert preload items.
(ede-proj-target-elisp-autoloads): Don't depend on cedet-autogen.
- * ede/util.el (ede-make-buffer-writable):
+ * ede/util.el (ede-make-buffer-writable):
* semantic/debug.el (semantic-debug-mode): Set buffer-read-only
instead of calling toggle-read-only.
@@ -821,9 +1498,9 @@
(semantic-c-convert-spp-value-to-hideif-value)
(semantic-c-evaluate-symbol-for-hideif, semantic-c-hideif-lookup)
(semantic-c-hideif-defined): Revive hideif code from CEDET trunk.
- (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for
+ (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for
regular expression parsing.
- (semantic-cpp-lexer): Add semantic-lex-c-ifdef.
+ (semantic-cpp-lexer): Add semantic-lex-c-ifdef.
(semantic-expand-c-tag): Check if tag is non-nil before adding it
to return list.
(semantic-expand-c-extern-C, semantic-expand-c-complex-type):
@@ -923,9 +1600,9 @@
(project-compile-project, project-compiler-target): New methods.
* inversion.el (inversion-decoders): New regexps for SXEmacs.
- (inversion-package-version): More verbose error message.
- (inversion-<): Deal with new special cases.
- (inversion-require-emacs): New argument sxemacs-ver; use it.
+ (inversion-package-version): More verbose error message.
+ (inversion-<): Deal with new special cases.
+ (inversion-require-emacs): New argument sxemacs-ver; use it.
2012-10-01 Nelson Ferreira <nelson.ferreira@ieee.org>
@@ -938,7 +1615,7 @@
(semantic-gcc-setup): If the first attempt at calling cpp fails,
try straight GCC.
-2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de>
+2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de>
* semantic/idle.el
(semantic-idle-breadcrumbs--display-in-header-line):
@@ -978,7 +1655,7 @@
* semantic/wisent/python.el (wisent-python-string-start-re)
(wisent-python-string-re, wisent-python-forward-string)
- (wisent-python-forward-line,wisent-python-lex-string):
+ (wisent-python-forward-line, wisent-python-lex-string):
New variables.
(wisent-python-forward-balanced-expression): New function.
@@ -1081,7 +1758,7 @@
(ede-directory-safe-p): Check it.
(ede-initialize-state-current-buffer, ede, ede-new)
(ede-check-project-directory, ede-rescan-toplevel)
- (ede-load-project-file, ede-parent-project, ede-current-project):
+ (ede-load-project-file, ede-parent-project, ede-current-project)
(ede-target-parent): Avoid loading in a project unless it is safe,
since it may involve malicious code. This security flaw was
pointed out by Hiroshi Oota.
@@ -1194,7 +1871,7 @@
(semantic-decoration-unknown-include-describe): Fix filenames in
docstring.
- * semantic/ede-grammar.el (semantic-ede-grammar-compiler-wisent):
+ * semantic/ede-grammar.el (semantic-ede-grammar-compiler-wisent)
(semantic-ede-grammar-compiler-bovine): Fix requires that are
added to the grammar-make-script.
@@ -1211,7 +1888,7 @@
2011-10-19 Chong Yidong <cyd@gnu.org>
- * ede.el (ede-minor-mode,global-ede-mode):
+ * ede.el (ede-minor-mode, global-ede-mode):
* semantic.el (semantic-mode): Doc fix to reflect new
define-minor-mode calling behavior.
@@ -1435,10 +2112,10 @@
Synch EDE to CEDET 1.0.
* cedet-idutils.el (cedet-idutils-make-command): New option.
- (cedet-idutils-mkid-call):
+ (cedet-idutils-mkid-call)
(cedet-idutils-create/update-database): New functions.
- * cedet-cscope.el (cedet-cscope-create):
+ * cedet-cscope.el (cedet-cscope-create)
(cedet-cscope-create/update-database): New functions.
(cedet-cscope-support-for-directory): Make interactive.
@@ -1490,7 +2167,7 @@
(ede-project-root, ede-project-root-directory): Move to
ede/auto.el.
- * ede/locate.el (ede-locate-flush-hash):
+ * ede/locate.el (ede-locate-flush-hash)
(ede-locate-create/update-root-database): New methods.
(initialize-instance): Use ede-locate-flush-hash.
@@ -1603,7 +2280,7 @@
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a position.
- * semantic/complete.el (semantic-collector-local-members):
+ * semantic/complete.el (semantic-collector-local-members)
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
@@ -1775,7 +2452,7 @@
Use define-minor-mode in CEDET where applicable.
- * srecode/mode.el (srecode-minor-mode,global-srecode-minor-mode):
+ * srecode/mode.el (srecode-minor-mode, global-srecode-minor-mode):
Use define-minor-mode.
* semantic/util-modes.el (semantic-add-minor-mode):
@@ -2262,7 +2939,7 @@
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype)
(semantic-analyzer-debug-insert-include-summary):
- * semantic/util.el (semantic-file-tag-table):
+ * semantic/util.el (semantic-file-tag-table)
(semantic-describe-buffer-var-helper, semantic-something-to-tag-table)
(semantic-recursive-find-nonterminal-by-name):
* semantic/tag-ls.el (semantic-tag-calculate-parent-default):
@@ -2270,15 +2947,15 @@
* semantic/symref.el (semantic-symref-parse-tool-output):
* semantic/sb.el (semantic-sb-fetch-tag-table):
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
- * semantic/idle.el (semantic-idle-work-for-one-buffer):
+ * semantic/idle.el (semantic-idle-work-for-one-buffer)
(semantic-idle-summary-maybe-highlight):
* semantic/ia-sb.el (semantic-ia-speedbar)
(semantic-ia-sb-tag-info):
* semantic/grammar.el (semantic-analyze-possible-completions):
* semantic/find.el (semantic-brute-find-tag-by-position):
- * semantic/ede-grammar.el (project-compile-target):
+ * semantic/ede-grammar.el (project-compile-target)
(ede-proj-makefile-insert-variables):
- * semantic/debug.el (semantic-debug-set-parser-location):
+ * semantic/debug.el (semantic-debug-set-parser-location)
(semantic-debug-set-source-location, semantic-debug-interface-layout)
(semantic-debug-mode, semantic-debug):
* semantic/db.el (semanticdb-needs-refresh-p):
@@ -2309,10 +2986,10 @@
* ede.el (ede-buffer-header-file, ede-find-target)
(ede-buffer-documentation-files, ede-project-buffers, ede-set)
(ede-target-buffers, ede-buffers, ede-make-project-local-variable):
- * cedet-idutils.el (cedet-idutils-fnid-call):
+ * cedet-idutils.el (cedet-idutils-fnid-call)
(cedet-idutils-lid-call, cedet-idutils-expand-filename)
(cedet-idutils-version-check):
- * cedet-global.el (cedet-gnu-global-call):
+ * cedet-global.el (cedet-gnu-global-call)
(cedet-gnu-global-expand-filename, cedet-gnu-global-root)
(cedet-gnu-global-version-check, cedet-gnu-global-scan-hits):
* cedet-cscope.el (cedet-cscope-call)
@@ -2540,8 +3217,6 @@
* srecode/srt-mode.el (srecode-template-mode): Doc fix.
- * files.el (auto-mode-alist): Add .srt and Project.ede.
-
* semantic.el (semantic-mode):
Handle srecode-template-mode-hook as well.
(semantic-mode): Use js-mode-hook for Javascript hook.
@@ -2785,7 +3460,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 1452535f294..94b7b077199 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -1,6 +1,6 @@
;;; cedet-cscope.el --- CScope support for CEDET
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 236040befb8..8e3901a609e 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -1,6 +1,6 @@
;;; cedet-files.el --- Common routines dealing with file names.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index 04861c5e58f..3ceed5d3b54 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -1,6 +1,6 @@
;;; cedet-global.el --- GNU Global support for CEDET.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
@@ -36,7 +36,7 @@
(defcustom cedet-global-gtags-command "gtags"
"Command name for the GNU Global gtags executable.
-GTAGS is used to create the tags table queried by the 'global' command."
+GTAGS is used to create the tags table queried by the `global' command."
:type 'string
:group 'cedet)
@@ -93,6 +93,13 @@ SCOPE is the scope of the search, such as 'project or 'subdirs."
(apply 'call-process cedet-global-gtags-command
nil b nil
flags)
+
+ ;; Check for warnings.
+ (with-current-buffer b
+ (goto-char (point-min))
+ (when (re-search-forward "Error\\|Warning\\|invalid" nil t)
+ (error "Output:\n%S" (buffer-string))))
+
b))
(defun cedet-gnu-global-expand-filename (filename)
@@ -179,10 +186,14 @@ If a database already exists, then just update it."
(let ((root (cedet-gnu-global-root dir)))
(if root (setq dir root))
(let ((default-directory dir))
- (cedet-gnu-global-gtags-call
- (when root
- '("-i");; Incremental update flag.
- )))))
+ (if root
+ ;; Incremental update. This can be either "gtags -i" or
+ ;; "global -u"; the gtags manpage says it's better to use
+ ;; "global -u".
+ (cedet-gnu-global-call (list "-u"))
+ (cedet-gnu-global-gtags-call nil)
+ )
+ )))
(provide 'cedet-global)
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index 49d22b6a0ab..65af51c26b0 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -1,6 +1,6 @@
;;; cedet-idutils.el --- ID Utils support for CEDET.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Old-Version: 0.2
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index f34442996c1..facd2bcaff7 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -1,6 +1,6 @@
;;; cedet.el --- Setup CEDET environment
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index c468ec1046a..300bd04600b 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1,6 +1,6 @@
-;;; data-debug.el --- Datastructure Debugger
+;;; data-debug.el --- Data structure debugger
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.2
@@ -55,7 +55,7 @@
(defalias 'data-debug-overlay-p 'extentp)
(if (not (fboundp 'propertize))
(defun dd-propertize (string &rest properties)
- "Mimic 'propertize' in from Emacs 23."
+ "Mimic `propertize' in from Emacs 23."
(add-text-properties 0 (length string) properties string)
string
)
@@ -869,7 +869,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
table)
"Syntax table used in data-debug macro buffers.")
-(defvar data-debug-map
+(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1")
+(defvar data-debug-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
(define-key km [mouse-2] 'data-debug-expand-or-contract-mouse)
@@ -887,22 +888,15 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
:group 'data-debug
:type 'hook)
-(defun data-debug-mode ()
+(define-derived-mode data-debug-mode fundamental-mode "DATA-DEBUG"
"Major-mode for the Analyzer debugger.
-\\{data-debug-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'data-debug-mode
- mode-name "DATA-DEBUG"
- comment-start ";;"
+\\{data-debug-mode-map}"
+ (setq comment-start ";;"
comment-end ""
buffer-read-only t)
- (set (make-local-variable 'comment-start-skip)
+ (setq-local comment-start-skip
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set-syntax-table data-debug-mode-syntax-table)
- (use-local-map data-debug-map)
- (run-hooks 'data-debug-hook)
(buffer-disable-undo)
(set (make-local-variable 'font-lock-global-modes) nil)
(font-lock-mode -1)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 3483d541122..76ec3567c63 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,6 +1,6 @@
;;; ede.el --- Emacs Development Environment gloss
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -40,13 +40,17 @@
;; (global-ede-mode t)
(require 'cedet)
+(require 'cl-lib)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/source)
(require 'ede/base)
(require 'ede/auto)
+(require 'ede/detect)
-(load "ede/loaddefs" nil 'nomessage)
+(eval-and-compile
+ (load "ede/loaddefs" nil 'nomessage))
(declare-function ede-commit-project "ede/custom")
(declare-function ede-convert-path "ede/files")
@@ -60,7 +64,7 @@
(declare-function ede-up-directory "ede/files")
(declare-function semantic-lex-make-spp-table "semantic/lex-spp")
-(defconst ede-version "1.2"
+(defconst ede-version "2.0"
"Current version of the Emacs EDE.")
;;; Code:
@@ -99,7 +103,7 @@ target willing to take the file. 'never means never perform the check."
If the value is t, EDE may search in any directory.
If the value is a function, EDE calls that function with one
-argument, the directory name; the function should return t iff
+argument, the directory name; the function should return t if
EDE should look for project files in the directory.
Otherwise, the value should be a list of fully-expanded directory
@@ -246,20 +250,20 @@ Argument LIST-O-O is the list of objects to choose from."
(let ((obj ede-object))
(if (consp obj)
(setq obj (car obj)))
- (and obj (obj-of-class-p obj ede-target))))
+ (and obj (obj-of-class-p obj 'ede-target))))
(defun ede-buffer-belongs-to-project-p ()
"Return non-nil if this buffer belongs to at least one project."
(if (or (null ede-object) (consp ede-object)) nil
- (obj-of-class-p ede-object-project ede-project)))
+ (obj-of-class-p ede-object-project 'ede-project)))
(defun ede-menu-obj-of-class-p (class)
"Return non-nil if some member of `ede-object' is a child of CLASS."
(if (listp ede-object)
- (eval (cons 'or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object)))
+ (cl-some (lambda (o) (obj-of-class-p o class)) ede-object)
(obj-of-class-p ede-object class)))
-(defun ede-build-forms-menu (menu-def)
+(defun ede-build-forms-menu (_menu-def)
"Create a sub menu for building different parts of an EDE system.
Argument MENU-DEF is the menu definition to use."
(easy-menu-filter-return
@@ -279,7 +283,7 @@ Argument MENU-DEF is the menu definition to use."
;; First, collect the build items from the project
(setq newmenu (append newmenu (ede-menu-items-build obj t)))
;; Second, declare the current target menu items
- (if (and ede-obj (ede-menu-obj-of-class-p ede-target))
+ (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target))
(while ede-obj
(setq newmenu (append newmenu
(ede-menu-items-build (car ede-obj) t))
@@ -303,7 +307,7 @@ Argument MENU-DEF is the menu definition to use."
(append newmenu (list [ "Make distribution" ede-make-dist t ]))
)))))
-(defun ede-target-forms-menu (menu-def)
+(defun ede-target-forms-menu (_menu-def)
"Create a target MENU-DEF based on the object belonging to this buffer."
(easy-menu-filter-return
(easy-menu-create-menu
@@ -324,7 +328,7 @@ Argument MENU-DEF is the menu definition to use."
;; This is bad, but I'm not sure what else to do.
(oref (car obj) menu)))))))))
-(defun ede-project-forms-menu (menu-def)
+(defun ede-project-forms-menu (_menu-def)
"Create a target MENU-DEF based on the object belonging to this buffer."
(easy-menu-filter-return
(easy-menu-create-menu
@@ -336,7 +340,7 @@ Argument MENU-DEF is the menu definition to use."
(progn
(while (and class (slot-exists-p class 'menu))
;;(message "Looking at class %S" class)
- (setq menu (append menu (oref class menu))
+ (setq menu (append menu (oref-default class menu))
class (eieio-class-parent class))
(if (listp class) (setq class (car class))))
(append
@@ -350,7 +354,7 @@ Argument MENU-DEF is the menu definition to use."
menu)
)))))
-(defun ede-configuration-forms-menu (menu-def)
+(defun ede-configuration-forms-menu (_menu-def)
"Create a submenu for selecting the default configuration for this project.
The current default is in the current object's CONFIGURATION-DEFAULT slot.
All possible configurations are in CONFIGURATIONS.
@@ -385,7 +389,7 @@ but can also be used interactively."
(eieio-object-name (ede-current-project))
newconfig))
-(defun ede-customize-forms-menu (menu-def)
+(defun ede-customize-forms-menu (_menu-def)
"Create a menu of the project, and targets that can be customized.
Argument MENU-DEF is the definition of the current menu."
(easy-menu-filter-return
@@ -408,7 +412,7 @@ Argument MENU-DEF is the definition of the current menu."
targ)))))))
-(defun ede-apply-object-keymap (&optional default)
+(defun ede-apply-object-keymap (&optional _default)
"Add target specific keybindings into the local map.
Optional argument DEFAULT indicates if this should be set to the default
version of the keymap."
@@ -416,19 +420,18 @@ version of the keymap."
(proj ede-object-project))
(condition-case nil
(let ((keys (ede-object-keybindings object)))
- ;; Add keys for the project to whatever is in the current object
- ;; so long as it isn't the same.
- (when (not (eq object proj))
- (setq keys (append keys (ede-object-keybindings proj))))
- (while keys
- (local-set-key (concat "\C-c." (car (car keys)))
- (cdr (car keys)))
- (setq keys (cdr keys))))
+ (dolist (key
+ ;; Add keys for the project to whatever is in the current
+ ;; object so long as it isn't the same.
+ (if (eq object proj)
+ keys
+ (append keys (ede-object-keybindings proj))))
+ (local-set-key (concat "\C-c." (car key)) (cdr key))))
(error nil))))
;;; Menu building methods for building
;;
-(defmethod ede-menu-items-build ((obj ede-project) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-project) &optional current)
"Return a list of menu items for building project OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
@@ -438,7 +441,7 @@ If optional argument CURRENT is non-nil, return sub-menu code."
(concat "Build Project " (ede-name obj))
`(project-compile-project ,obj))))))
-(defmethod ede-menu-items-build ((obj ede-target) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-target) &optional current)
"Return a list of menu items for building target OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
@@ -450,8 +453,6 @@ If optional argument CURRENT is non-nil, return sub-menu code."
;;; Mode Declarations
;;
-(eval-and-compile
- (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t))
(defun ede-apply-target-options ()
"Apply options to the current buffer for the active project/target."
@@ -501,59 +502,63 @@ Sets buffer local variables for EDE."
;; Init the buffer.
(let* ((ROOT nil)
(proj (ede-directory-get-open-project default-directory
- 'ROOT))
- (projauto nil))
-
- (when (or proj ROOT
- ;; If there is no open project, look up the project
- ;; autoloader to see if we should initialize.
- (setq projauto (ede-directory-project-p default-directory t)))
-
- (when (and (not proj) projauto)
-
- ;; No project was loaded, but we have a project description
- ;; object. This means that we can check if it is a safe
- ;; project to load before requesting it to be loaded.
-
- (when (or (oref projauto safe-p)
- ;; The project style is not safe, so check if it is
- ;; in `ede-project-directories'.
- (let ((top (ede-toplevel-project default-directory)))
- (ede-directory-safe-p top)))
-
- ;; The project is safe, so load it in.
- (setq proj (ede-load-project-file default-directory 'ROOT))))
-
- ;; Only initialize EDE state in this buffer if we found a project.
- (when proj
-
- (setq ede-object (ede-buffer-object (current-buffer)
+ 'ROOT)))
+
+ (when (not proj)
+ ;; If there is no open project, look up the project
+ ;; autoloader to see if we should initialize.
+ (let ((projdetect (ede-directory-project-cons default-directory)))
+
+ (when projdetect
+ ;; No project was loaded, but we have a project description
+ ;; object. This means that we try to load it.
+ ;;
+ ;; Before loading, we need to check if it is a safe
+ ;; project to load before requesting it to be loaded.
+
+ (when (or (oref (cdr projdetect) safe-p)
+ ;; The project style is not safe, so check if it is
+ ;; in `ede-project-directories'.
+ (let ((top (car projdetect)))
+ (ede-directory-safe-p top)))
+
+ ;; The project is safe, so load it in.
+ (setq proj (ede-load-project-file default-directory projdetect 'ROOT))))))
+
+ ;; If PROJ is now loaded in, we can initialize our buffer to it.
+ (when proj
+
+ ;; ede-object represents the specific EDE related class that best
+ ;; represents this buffer. It could be a project (for a project file)
+ ;; or a target. Also save off ede-object-project, the project that
+ ;; the buffer belongs to for the case where ede-object is a target.
+ (setq ede-object (ede-buffer-object (current-buffer)
'ede-object-project))
- (setq ede-object-root-project
- (or ROOT (ede-project-root ede-object-project)))
+ ;; Every project has a root. It might be the same as ede-object.
+ ;; Cache that also as the root is a very common thing to need.
+ (setq ede-object-root-project
+ (or ROOT (ede-project-root ede-object-project)))
- (if (and (not ede-object) ede-object-project)
- (ede-auto-add-to-target))
+ ;; Check to see if we want to add this buffer to a target.
+ (if (and (not ede-object) ede-object-project)
+ (ede-auto-add-to-target))
- (ede-apply-target-options)))))
+ ;; Apply any options from the found target.
+ (ede-apply-target-options))))
(defun ede-reset-all-buffers ()
"Reset all the buffers due to change in EDE."
(interactive)
- (let ((b (buffer-list)))
- (while b
- (when (buffer-file-name (car b))
- (with-current-buffer (car b)
- ;; Reset all state variables
- (setq ede-object nil
- ede-object-project nil
- ede-object-root-project nil)
- ;; Now re-initialize this buffer.
- (ede-initialize-state-current-buffer)
- )
- )
- (setq b (cdr b)))))
+ (dolist (b (buffer-list))
+ (when (buffer-file-name b)
+ (with-current-buffer b
+ ;; Reset all state variables
+ (setq ede-object nil
+ ede-object-project nil
+ ede-object-root-project nil)
+ ;; Now re-initialize this buffer.
+ (ede-initialize-state-current-buffer)))))
;;;###autoload
(define-minor-mode global-ede-mode
@@ -617,13 +622,10 @@ of objects with the `ede-want-file-p' method."
(if (or (eq ede-auto-add-method 'never)
(ede-ignore-file (buffer-file-name)))
nil
- (let (wants desires)
- ;; Find all the objects.
- (setq wants (oref (ede-current-project) targets))
- (while wants
- (if (ede-want-file-p (car wants) (buffer-file-name))
- (setq desires (cons (car wants) desires)))
- (setq wants (cdr wants)))
+ (let (desires)
+ (dolist (want (oref (ede-current-project) targets));Find all the objects.
+ (if (ede-want-file-p want (buffer-file-name))
+ (push want desires)))
(if desires
(cond ((or (eq ede-auto-add-method 'ask)
(and (eq ede-auto-add-method 'multi-ask)
@@ -680,6 +682,7 @@ Otherwise, create a new project for DIR."
(if (ede-check-project-directory dir)
(progn
;; Load the project in DIR, or make one.
+ ;; @TODO - IS THIS REAL?
(ede-load-project-file dir)
;; Check if we loaded anything on the previous line.
@@ -701,11 +704,15 @@ Otherwise, create a new project for DIR."
(error "%s is not an allowed project directory in `ede-project-directories'"
dir)))
+(defvar ede-check-project-query-fcn 'y-or-n-p
+ "Function used to ask the user if they want to permit a project to load.
+This is abstracted out so that tests can answer this question.")
+
(defun ede-check-project-directory (dir)
"Check if DIR should be in `ede-project-directories'.
If it is not, try asking the user if it should be added; if so,
add it and save `ede-project-directories' via Customize.
-Return nil iff DIR should not be in `ede-project-directories'."
+Return nil if DIR should not be in `ede-project-directories'."
(setq dir (directory-file-name (expand-file-name dir))) ; strip trailing /
(or (eq ede-project-directories t)
(and (functionp ede-project-directories)
@@ -713,9 +720,11 @@ Return nil iff DIR should not be in `ede-project-directories'."
;; If `ede-project-directories' is a list, maybe add it.
(when (listp ede-project-directories)
(or (member dir ede-project-directories)
- (when (y-or-n-p (format "`%s' is not listed in `ede-project-directories'.
+ (when (funcall ede-check-project-query-fcn
+ (format-message
+ "`%s' is not listed in `ede-project-directories'.
Add it to the list of allowed project directories? "
- dir))
+ dir))
(push dir ede-project-directories)
;; If possible, save `ede-project-directories'.
(if (or custom-file user-init-file)
@@ -738,7 +747,7 @@ Optional argument NAME is the name to give this project."
(r nil))
(while l
(if cs
- (if (eq (oref (car l) :class-sym)
+ (if (eq (oref (car l) class-sym)
cs)
(setq r (cons (car l) r)))
(if (oref (car l) new-p)
@@ -748,7 +757,7 @@ Optional argument NAME is the name to give this project."
(if cs
(error "No valid interactive sub project types for %s"
cs)
- (error "EDE error: Can't fin project types to create")))
+ (error "EDE error: Can't find project types to create")))
r)
)
nil t)))
@@ -783,10 +792,12 @@ Optional argument NAME is the name to give this project."
(error
"Unknown file name specifier %S"
pf)))
- :targets nil)))
+ :targets nil)
+
+ ))
(inits (oref obj initializers)))
;; Force the name to match for new objects.
- (eieio-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)))
@@ -805,7 +816,7 @@ Optional argument NAME is the name to give this project."
;; Allert the user
(message "Project created and saved. You may now create targets."))
-(defmethod ede-add-subproject ((proj-a ede-project) proj-b)
+(cl-defmethod ede-add-subproject ((proj-a ede-project) proj-b)
"Add into PROJ-A, the subproject PROJ-B."
(oset proj-a subproj (cons proj-b (oref proj-a subproj))))
@@ -822,16 +833,17 @@ ARGS are additional arguments to pass to method SYM."
(defun ede-rescan-toplevel ()
"Rescan all project files."
(interactive)
- (if (not (ede-directory-get-open-project default-directory))
- ;; This directory isn't open. Can't rescan.
- (error "Attempt to rescan a project that isn't open")
+ (when (not (ede-toplevel))
+ ;; This directory isn't open. Can't rescan.
+ (error "Attempt to rescan a project that isn't open"))
- ;; Continue
- (let ((toppath (ede-toplevel-project default-directory))
- (ede-deep-rescan t))
+ ;; Continue
+ (let ((root (ede-toplevel))
+ (ede-deep-rescan t))
- (project-rescan (ede-load-project-file toppath))
- (ede-reset-all-buffers))))
+ (project-rescan root)
+ (ede-reset-all-buffers)
+ ))
(defun ede-new-target (&rest args)
"Create a new target specific to this type of project file.
@@ -839,7 +851,7 @@ Different projects accept different arguments ARGS.
Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is
a string \"y\" or \"n\", which answers the y/n question done interactively."
(interactive)
- (apply 'project-new-target (ede-current-project) args)
+ (apply #'project-new-target (ede-current-project) args)
(when (and buffer-file-name
(not (file-directory-p buffer-file-name)))
(setq ede-object nil)
@@ -919,6 +931,8 @@ Optional argument FORCE forces the file to be removed without asking."
(interactive)
(ede-invoke-method 'project-edit-file-target))
+;;; Compilation / Debug / Run
+;;
(defun ede-compile-project ()
"Compile the current project."
(interactive)
@@ -967,75 +981,75 @@ Optional argument FORCE forces the file to be removed without asking."
;; files should inherit from `ede-project'. Create the appropriate
;; methods based on those below.
-(defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
; checkdoc-params: (prompt)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-interactive-select-target this prompt))
-(defmethod project-interactive-select-target ((this ede-project) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project) prompt)
"Interactively query for a target that exists in project THIS.
Argument PROMPT is the prompt to use when querying the user for a target."
(let ((ob (object-assoc-list 'name (oref this targets))))
(cdr (assoc (completing-read prompt ob nil t) ob))))
-(defmethod project-add-file ((this ede-project-placeholder) file)
+(cl-defmethod project-add-file ((this ede-project-placeholder) file)
; checkdoc-params: (file)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-add-file this file))
-(defmethod project-add-file ((ot ede-target) file)
+(cl-defmethod project-add-file ((ot ede-target) _file)
"Add the current buffer into project project target OT.
Argument FILE is the file to add."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-remove-file ((ot ede-target) fnnd)
+(cl-defmethod project-remove-file ((ot ede-target) _fnnd)
"Remove the current buffer from project target OT.
Argument FNND is an argument."
(error "remove-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-edit-file-target ((ot ede-target))
+(cl-defmethod project-edit-file-target ((_ot ede-target))
"Edit the target OT associated with this file."
(find-file (oref (ede-current-project) file)))
-(defmethod project-new-target ((proj ede-project) &rest args)
+(cl-defmethod project-new-target ((proj ede-project) &rest _args)
"Create a new target. It is up to the project PROJ to get the name."
(error "new-target not supported by %s" (eieio-object-name proj)))
-(defmethod project-new-target-custom ((proj ede-project))
+(cl-defmethod project-new-target-custom ((proj ede-project))
"Create a new target. It is up to the project PROJ to get the name."
(error "New-target-custom not supported by %s" (eieio-object-name proj)))
-(defmethod project-delete-target ((ot ede-target))
+(cl-defmethod project-delete-target ((ot ede-target))
"Delete the current target OT from its parent project."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-compile-project ((obj ede-project) &optional command)
+(cl-defmethod project-compile-project ((obj ede-project) &optional _command)
"Compile the entire current project OBJ.
Argument COMMAND is the command to use when compiling."
(error "compile-project not supported by %s" (eieio-object-name obj)))
-(defmethod project-compile-target ((obj ede-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-target) &optional _command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(error "compile-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-debug-target ((obj ede-target))
+(cl-defmethod project-debug-target ((obj ede-target))
"Run the current project target OBJ in a debugger."
(error "debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-target))
+(cl-defmethod project-run-target ((obj ede-target))
"Run the current project target OBJ."
(error "run-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-make-dist ((this ede-project))
+(cl-defmethod project-make-dist ((this ede-project))
"Build a distribution for the project based on THIS project."
(error "Make-dist not supported by %s" (eieio-object-name this)))
-(defmethod project-dist-files ((this ede-project))
+(cl-defmethod project-dist-files ((this ede-project))
"Return a list of files that constitute a distribution of THIS project."
(error "Dist-files is not supported by %s" (eieio-object-name this)))
-(defmethod project-rescan ((this ede-project))
+(cl-defmethod project-rescan ((this ede-project))
"Rescan the EDE project THIS."
(error "Rescanning a project is not supported by %s" (eieio-object-name this)))
@@ -1059,94 +1073,102 @@ On success, return the added project."
(error "No project created to add to master list"))
(when (not (eieio-object-p proj))
(error "Attempt to add non-object to master project list"))
- (when (not (obj-of-class-p proj ede-project-placeholder))
+ (when (not (obj-of-class-p proj 'ede-project-placeholder))
(error "Attempt to add a non-project to the ede projects list"))
(add-to-list 'ede-projects proj)
proj)
+(defun ede-delete-project-from-global-list (proj)
+ "Remove project PROJ from the master list of projects."
+ (setq ede-projects (remove proj ede-projects)))
+
(defun ede-flush-deleted-projects ()
"Scan the projects list for projects which no longer exist.
Flush the dead projects from the project cache."
(interactive)
(let ((dead nil))
(dolist (P ede-projects)
- (when (not (file-exists-p (oref P :file)))
+ (when (not (file-exists-p (oref P file)))
(add-to-list 'dead P)))
(dolist (D dead)
- (setq ede-projects (remove D ede-projects)))
+ (ede-delete-project-from-global-list D))
))
-(defun ede-load-project-file (dir &optional rootreturn)
+(defvar ede--disable-inode) ;Defined in ede/files.el.
+
+(defun ede-global-list-sanity-check ()
+ "Perform a sanity check to make sure there are no duplicate projects."
+ (interactive)
+ (let ((scanned nil))
+ (dolist (P ede-projects)
+ (if (member (oref P directory) scanned)
+ (error "Duplicate project (by dir) found in %s!" (oref P directory))
+ (push (oref P directory) scanned)))
+ (unless ede--disable-inode
+ (setq scanned nil)
+ (dolist (P ede-projects)
+ (if (member (ede--project-inode P) scanned)
+ (error "Duplicate project (by inode) found in %s!" (ede--project-inode P))
+ (push (ede--project-inode P) scanned))))
+ (message "EDE by directory %sis still sane." (if ede--disable-inode "" "& inode "))))
+
+(defun ede-load-project-file (dir &optional detectin rootreturn)
"Project file independent way to read a project in from DIR.
+Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project'
+which can be passed in to save time.
Optional ROOTRETURN will return the root project for DIR."
- ;; Only load if something new is going on. Flush the dirhash.
- (ede-project-directory-remove-hash dir)
- ;; Do the load
- ;;(message "EDE LOAD : %S" file)
- (let* ((file dir)
- (path (file-name-as-directory (expand-file-name dir)))
- (pfc (ede-directory-project-p path))
- (toppath nil)
- (o nil))
- (cond
- ((not pfc)
- ;; @TODO - Do we really need to scan? Is this a waste of time?
- ;; Scan upward for a the next project file style.
- (let ((p path))
- (while (and p (not (ede-directory-project-p p)))
- (setq p (ede-up-directory p)))
- (if p (ede-load-project-file p)
- nil)
- ;; recomment as we go
- ;;nil
- ))
- ;; Do nothing if we are building an EDE project already.
- (ede-constructing
- nil)
- ;; Load in the project in question.
- (t
- (setq toppath (ede-toplevel-project path))
- ;; We found the top-most directory. Check to see if we already
- ;; have an object defining its project.
- (setq pfc (ede-directory-project-p toppath t))
-
- ;; See if it's been loaded before
- (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file
- ede-projects))
-
- ;; If not open yet, load it.
- (unless o
- (let ((ede-constructing pfc))
- (setq o (ede-auto-load-project pfc toppath))))
-
- ;; Return the found root project.
- (when rootreturn (set rootreturn o))
-
- (let (tocheck found)
- ;; Now find the project file belonging to FILE!
- (setq tocheck (list o))
- (setq file (ede-dir-to-projectfile pfc (expand-file-name path)))
- (while (and tocheck (not found))
- (let ((newbits nil))
- (when (car tocheck)
- (if (string= file (oref (car tocheck) file))
- (setq found (car tocheck)))
- (setq newbits (oref (car tocheck) subproj)))
- (setq tocheck
- (append (cdr tocheck) newbits))))
- (if (not found)
- (message "No project for %s, but passes project-p test" file)
- ;; Now that the file has been reset inside the project object, do
- ;; the cache maintenance.
- (setq ede-project-cache-files
- (delete (oref found file) ede-project-cache-files)))
- found)))))
+ ;; Don't do anything if we are in the process of
+ ;; constructing an EDE object.
+ ;;
+ ;; Prevent recursion.
+ (unless ede-constructing
+
+ ;; Only load if something new is going on. Flush the dirhash.
+ (ede-project-directory-remove-hash dir)
+
+ ;; Do the load
+ ;;(message "EDE LOAD : %S" file)
+ (let* ((path (file-name-as-directory (expand-file-name dir)))
+ (detect (or detectin (ede-directory-project-cons path)))
+ (autoloader nil)
+ (toppath nil)
+ (o nil))
+
+ (when detect
+ (setq toppath (car detect))
+ (setq autoloader (cdr detect))
+
+ ;; See if it's been loaded before. Use exact matching since
+ ;; know that 'toppath' is the root of the project.
+ (setq o (ede-directory-get-toplevel-open-project toppath 'exact))
+
+ ;; If not open yet, load it.
+ (unless o
+ ;; NOTE: We set ede-constructing to the autoloader we are using.
+ ;; Some project types have one class, but many autoloaders
+ ;; and this is how we tell the instantiation which kind of
+ ;; project to make.
+ (let ((ede-constructing autoloader))
+
+ ;; This is the only place `ede-auto-load-project' should be called.
+
+ (setq o (ede-auto-load-project autoloader toppath))))
+
+ ;; Return the found root project.
+ (when rootreturn (set rootreturn o))
+
+ ;; The project has been found (in the global list) or loaded from
+ ;; disk (via autoloader.) We can now search for the project asked
+ ;; for from DIR in the sub-list.
+ (ede-find-subproject-for-directory o path)
+
+ ;; Return the project.
+ o))))
;;; PROJECT ASSOCIATIONS
;;
;; Moving between relative projects. Associating between buffers and
;; projects.
-
(defun ede-parent-project (&optional obj)
"Return the project belonging to the parent directory.
Return nil if there is no previous directory.
@@ -1220,7 +1242,7 @@ that contains the target that becomes buffer's object."
;; Return our findings.
ede-object))
-(defmethod ede-target-in-project-p ((proj ede-project) target)
+(cl-defmethod ede-target-in-project-p ((proj ede-project) target)
"Is PROJ the parent of TARGET?
If TARGET belongs to a subproject, return that project file."
(if (and (slot-boundp proj 'targets)
@@ -1245,7 +1267,7 @@ could become slow in time."
projs (cdr projs)))
ans)))
-(defmethod ede-find-target ((proj ede-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-project) buffer)
"Fetch the target in PROJ belonging to BUFFER or nil."
(with-current-buffer buffer
@@ -1267,16 +1289,16 @@ could become slow in time."
(setq targets (cdr targets)))
f)))))
-(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
+(cl-defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
"Return non-nil if object THIS is in BUFFER to a SOURCE list.
Handles complex path issues."
(member (ede-convert-path this (buffer-file-name buffer)) source))
-(defmethod ede-buffer-mine ((this ede-project) buffer)
+(cl-defmethod ede-buffer-mine ((_this ede-project) _buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
nil)
-(defmethod ede-buffer-mine ((this ede-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-target) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
(condition-case nil
(ede-target-buffer-in-sourcelist this buffer (oref this source))
@@ -1326,26 +1348,26 @@ This includes buffers controlled by a specific target of PROJECT."
"Execute PROC on all buffers controlled by EDE."
(mapcar proc (ede-buffers)))
-(defmethod ede-map-project-buffers ((this ede-project) proc)
+(cl-defmethod ede-map-project-buffers ((this ede-project) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-project-buffers this)))
-(defmethod ede-map-target-buffers ((this ede-target) proc)
+(cl-defmethod ede-map-target-buffers ((this ede-target) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-target-buffers this)))
;; other types of mapping
-(defmethod ede-map-subprojects ((this ede-project) proc)
+(cl-defmethod ede-map-subprojects ((this ede-project) proc)
"For object THIS, execute PROC on all direct subprojects.
This function does not apply PROC to sub-sub projects.
See also `ede-map-all-subprojects'."
(mapcar proc (oref this subproj)))
-(defmethod ede-map-all-subprojects ((this ede-project) allproc)
+(cl-defmethod ede-map-all-subprojects ((this ede-project) allproc)
"For object THIS, execute PROC on THIS and all subprojects.
This function also applies PROC to sub-sub projects.
See also `ede-map-subprojects'."
- (apply 'append
+ (apply #'append
(list (funcall allproc this))
(ede-map-subprojects
this
@@ -1355,14 +1377,14 @@ See also `ede-map-subprojects'."
;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file)))
-(defmethod ede-map-targets ((this ede-project) proc)
+(cl-defmethod ede-map-targets ((this ede-project) proc)
"For object THIS, execute PROC on all targets."
(mapcar proc (oref this targets)))
-(defmethod ede-map-any-target-p ((this ede-project) proc)
+(cl-defmethod ede-map-any-target-p ((this ede-project) proc)
"For project THIS, map PROC to all targets and return if any non-nil.
Return the first non-nil value returned by PROC."
- (eval (cons 'or (ede-map-targets this proc))))
+ (cl-some proc (oref this targets)))
;;; Some language specific methods.
@@ -1371,15 +1393,15 @@ Return the first non-nil value returned by PROC."
;; configuring items for Semantic.
;; Generic paths
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((_this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-system-include-path ((this ede-target))
+(cl-defmethod ede-system-include-path ((_this ede-target))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-source-paths ((this ede-project) mode)
+(cl-defmethod ede-source-paths ((_this ede-project) _mode)
"Get the base to all source trees in the current project for MODE.
For example, <root>/src for sources of c/c++, Java, etc,
and <root>/doc for doc sources."
@@ -1407,20 +1429,20 @@ and <root>/doc for doc sources."
(message "Choosing preprocessor syms for project %s"
(eieio-object-name (car objs)))))))
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((_this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-project))
+(cl-defmethod ede-preprocessor-map ((_this ede-project))
"Get the pre-processor map for project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-target))
+(cl-defmethod ede-preprocessor-map ((_this ede-target))
"Get the pre-processor map for project THIS."
nil)
;; Java
-(defmethod ede-java-classpath ((this ede-project))
+(cl-defmethod ede-java-classpath ((_this ede-project))
"Return the classpath for this project."
;; @TODO - Can JDEE add something here?
nil)
@@ -1433,8 +1455,7 @@ and <root>/doc for doc sources."
If VARIABLE is not project local, just use set. Optional argument PROJ
is the project to use, instead of `ede-current-project'."
(interactive "sVariable: \nxExpression: ")
- (let ((p (or proj (ede-toplevel)))
- a)
+ (let ((p (or proj (ede-toplevel))))
;; Make the change
(ede-make-project-local-variable variable p)
(ede-set-project-local-variable variable value p)
@@ -1476,7 +1497,7 @@ It does not apply the value to buffers."
(error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
(setcdr va value)))
-(defmethod ede-set-project-variables ((project ede-project) &optional buffer)
+(cl-defmethod ede-set-project-variables ((project ede-project) &optional buffer)
"Set variables local to PROJECT in BUFFER."
(if (not buffer) (setq buffer (current-buffer)))
(with-current-buffer buffer
@@ -1484,10 +1505,26 @@ It does not apply the value to buffers."
(make-local-variable (car v))
(set (car v) (cdr v)))))
-(defmethod ede-commit-local-variables ((proj ede-project))
+(cl-defmethod ede-commit-local-variables ((_proj ede-project))
"Commit change to local variables in PROJ."
nil)
+;;; Integration with project.el
+
+(defun project-try-ede (dir)
+ (let ((project-dir
+ (locate-dominating-file
+ dir
+ (lambda (dir)
+ (ede-directory-get-open-project dir 'ROOT)))))
+ (when project-dir
+ (ede-directory-get-open-project project-dir 'ROOT))))
+
+(cl-defmethod project-roots ((project ede-project))
+ (list (ede-project-root-directory project)))
+
+(add-hook 'project-find-functions #'project-try-ede)
+
(provide 'ede)
;; Include this last because it depends on ede.
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index c0baf0fc8f8..7c2a6b8dbf1 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -1,6 +1,6 @@
;;; ede/auto.el --- Autoload features for EDE
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -30,6 +30,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
@@ -47,8 +48,13 @@
:initform nil
:documentation
"An index into the match-data of `configregex'.")
- (configdatastash :initform nil
- :documentation
+ (subdir-only :initarg :subdir-only
+ :initform t
+ :documentation
+ "Non-nil means an exact match to the found directory is a non-match.
+This implies projects exist only in subdirectories of the configuration path.
+If `:subdir-only' is nil, then the directory from the configuration file is the project.")
+ (configdatastash :documentation
"Save discovered match string.")
)
"Support complex matches for projects that live in named directories.
@@ -57,7 +63,7 @@ location is varied dependent on other complex criteria, this class
can be used to define that match without loading the specific project
into memory.")
-(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
+(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
(let ((fc (oref dirmatch fromconfig)))
@@ -72,7 +78,7 @@ into memory.")
(t (error "Unknown dirmatch type.")))))
-(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
+(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
(let ((fc (oref dirmatch fromconfig)))
@@ -80,8 +86,11 @@ into memory.")
;; If the thing to match is stored in a config file.
((stringp fc)
(when (file-exists-p fc)
- (let ((matchstring (oref dirmatch configdatastash)))
- (unless matchstring
+ (let ((matchstring
+ (if (slot-boundp dirmatch 'configdatastash)
+ (oref dirmatch configdatastash)
+ nil)))
+ (when (and (not matchstring) (not (slot-boundp dirmatch 'configdatastash)))
(save-current-buffer
(let* ((buff (get-file-buffer fc))
(readbuff
@@ -94,10 +103,25 @@ into memory.")
(setq matchstring
(match-string (or (oref dirmatch configregexidx) 0)))))
(if (not buff) (kill-buffer readbuff))))
- ;; Save what we find in our cache.
- (oset dirmatch configdatastash matchstring))
+ (when matchstring
+ ;; If this dirmatch only finds subdirs of matchstring, then
+ ;; force matchstring to be a directory.
+ (when (oref dirmatch subdir-only)
+ (setq matchstring (file-name-as-directory matchstring)))
+ ;; Convert matchstring to a regexp
+ (setq matchstring (concat "^" (regexp-quote matchstring)))
+ ;; Stash it for later.
+ (oset dirmatch configdatastash matchstring))
+ ;; Debug
+ ;;(message "Stashing config data for dirmatch %S as %S" (eieio-object-name dirmatch) matchstring)
+ )
+ ;;(message "dirmatch %s against %s" matchstring (expand-file-name file))
;; Match against our discovered string
- (and matchstring (string-match (regexp-quote matchstring) file))
+ (setq file (file-name-as-directory (expand-file-name file)))
+ (and matchstring (string-match matchstring (expand-file-name file))
+ (or (not (oref dirmatch subdir-only))
+ (not (= (match-end 0) (length file))))
+ )
)))
;; Add new matches here
@@ -119,13 +143,21 @@ into memory.")
:documentation "The lisp file belonging to this class.")
(proj-file :initarg :proj-file
:documentation "Name of a project file of this type.")
+ (root-only :initarg :root-only
+ :initform t ;; Default - majority case.
+ :documentation
+ "Non-nil if project detection only finds proj-file @ project root.")
(proj-root-dirmatch :initarg :proj-root-dirmatch
- :initform ""
- :type (or string ede-project-autoload-dirmatch)
+ :initform nil
+ :type (or null string ede-project-autoload-dirmatch)
:documentation
"To avoid loading a project, check if the directory matches this.
-For projects that use directory name matches, a function would load that project.
-Specifying this matcher will allow EDE to check without loading the project.")
+Specifying this matcher object will allow EDE to perform a complex
+check without loading the project.
+
+NOTE: If you use dirmatch, you may need to set :root-only to nil.
+While it may be a root based project, all subdirs will happen to return
+true for the dirmatch, so for scanning purposes, set it to nil.")
(proj-root :initarg :proj-root
:type function
:documentation "A function symbol to call for the project root.
@@ -165,22 +197,22 @@ type is required and the load function used.")
(defvar ede-project-class-files
(list
- (ede-project-autoload "edeproject-makefile"
- :name "Make" :file 'ede/proj
+ (ede-project-autoload :name "Make" :file 'ede/proj
:proj-file "Project.ede"
+ :root-only nil
:load-type 'ede-proj-load
:class-sym 'ede-proj-project
:safe-p nil)
- (ede-project-autoload "edeproject-automake"
- :name "Automake" :file 'ede/proj
+ (ede-project-autoload :name "Automake" :file 'ede/proj
:proj-file "Project.ede"
+ :root-only nil
:initializers '(:makefile-type Makefile.am)
:load-type 'ede-proj-load
:class-sym 'ede-proj-project
:safe-p nil)
- (ede-project-autoload "automake"
- :name "automake" :file 'ede/project-am
+ (ede-project-autoload :name "automake" :file 'ede/project-am
:proj-file "Makefile.am"
+ :root-only nil
:load-type 'project-am-load
:class-sym 'project-am-makefile
:new-p nil
@@ -190,17 +222,30 @@ type is required and the load function used.")
(put 'ede-project-class-files 'risky-local-variable t)
+(defun ede-show-supported-projects ()
+ "Display all the project types registered with EDE."
+ (interactive)
+ (let ((b (get-buffer-create "*EDE Autodetect Projects*")))
+ (set-buffer b)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (dolist (prj ede-project-class-files)
+ (insert (oref prj name))
+ (newline))
+ (display-buffer b)
+ ))
+
(defun ede-add-project-autoload (projauto &optional flag)
"Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'.
Optional argument FLAG indicates how this autoload should be
added. Possible values are:
- 'generic - A generic project type. Keep this at the very end.
- 'unique - A unique project type for a specific project. Keep at the very
- front of the list so more generic projects don't get priority."
+ `generic' - A generic project type. Keep this at the very end.
+ `unique' - A unique project type for a specific project. Keep at the very
+ 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 (eieio-object-name-string projauto)))
- (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname)))
+ (projname (oref projauto name)))
+ (while (and projlist (not (string= (oref (car projlist) name) projname)))
(setq projlist (cdr projlist)))
(if projlist
@@ -233,106 +278,62 @@ added. Possible values are:
;; Splice into the list.
(setcdr prev (cons projauto next))))))))
-;;; EDE project-autoload methods
+;;; Project Autoload Methods
;;
-(defmethod ede-project-root ((this ede-project-autoload))
- "If a project knows its root, return it here.
-Allows for one-project-object-for-a-tree type systems."
- nil)
-
-(defun ede-project-dirmatch-p (file dirmatch)
- "Return non-nil if FILE matches DIRMATCH.
-DIRMATCH could be nil (no match), a string (regexp match),
-or an `ede-project-autoload-dirmatch' object."
- ;; If dirmatch is a string, then we simply match it against
- ;; the file we are testing.
- (if (stringp dirmatch)
- (string-match dirmatch file)
- ;; if dirmatch is instead a dirmatch object, we test against
- ;; that object instead.
- (if (ede-project-autoload-dirmatch-p dirmatch)
- (ede-do-dirmatch dirmatch file)
- (error "Unknown project directory match type."))
- ))
-(defmethod ede-project-root-directory ((this ede-project-autoload)
- &optional file)
- "If a project knows its root, return it here.
-Allows for one-project-object-for-a-tree type systems.
-Optional FILE is the file to test. If there is no FILE, use
-the current buffer."
- (when (not file)
- (setq file default-directory))
- (when (slot-boundp this :proj-root)
- (let ((dirmatch (oref this proj-root-dirmatch))
- (rootfcn (oref this proj-root))
- (callfcn t))
- (when rootfcn
- (if ;; If the dirmatch (an object) is not installed, then we
- ;; always skip doing a match.
- (and (ede-project-autoload-dirmatch-p dirmatch)
- (not (ede-dirmatch-installed dirmatch)))
- (setq callfcn nil)
- ;; Other types of dirmatch:
- (when (and
- ;; If the Emacs Lisp file handling this project hasn't
- ;; been loaded, we will use the quick dirmatch feature.
- (not (featurep (oref this file)))
- ;; If the dirmatch is an empty string, then we always
- ;; skip doing a match.
- (not (and (stringp dirmatch) (string= dirmatch "")))
- )
- ;; If this file DOES NOT match dirmatch, we set the callfcn
- ;; to nil, meaning don't load the ede support file for this
- ;; type of project. If it does match, we will load the file
- ;; and use a more accurate programmatic match from there.
- (unless (ede-project-dirmatch-p file dirmatch)
- (setq callfcn nil))))
- ;; Call into the project support file for a match.
- (when callfcn
- (condition-case nil
- (funcall rootfcn file)
- (error
- (funcall rootfcn))))
- ))))
-
-(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir)
- "Return a full file name of project THIS found in DIR.
-Return nil if the project file does not exist."
+;; New method using detect.el
+(cl-defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir)
+ "Return non-nil if THIS project autoload is found in DIR."
(let* ((d (file-name-as-directory dir))
- (root (ede-project-root-directory this d))
(pf (oref this proj-file))
- (dm (oref this proj-root-dirmatch))
- (f (cond ((stringp pf)
- (expand-file-name pf (or root d)))
- ((and (symbolp pf) (fboundp pf))
- ;; If there is a symbol to call, lets make extra
- ;; sure we really can call it without loading in
- ;; other EDE projects. This happens if the file is
- ;; already loaded, or if there is a dirmatch, but
- ;; root is empty.
- (when (and (featurep (oref this file))
- (or (not (stringp dm))
- (not (string= dm "")))
- root)
- (funcall pf (or root d))))))
- )
- (when (and f (file-exists-p f))
- f)))
-
-(defmethod ede-auto-load-project ((this ede-project-autoload) dir)
+ (f (when (stringp pf) (expand-file-name pf d))))
+ (if f
+ (and f (file-exists-p f))
+ (let ((dirmatch (oref this proj-root-dirmatch)))
+ (cond
+ ((stringp dirmatch)
+ nil) ; <- do something here - maybe obsolete the option?
+ ((ede-project-autoload-dirmatch-p dirmatch)
+ (if (and dirmatch (ede-dirmatch-installed dirmatch))
+ (ede-do-dirmatch dirmatch dir)
+ ;(message "Dirmatch %S not installed." dirmatch)
+ )))))))
+
+(cl-defmethod ede-auto-load-project ((this ede-project-autoload) dir)
"Load in the project associated with THIS project autoload description.
THIS project description should be valid for DIR, where the project will
-be loaded."
+be loaded.
+
+NOTE: Do not call this - it should only be called from `ede-load-project-file'."
;; Last line of defense: don't load unsafe projects.
- (when (not (or (oref this :safe-p)
+ (when (not (or (oref this safe-p)
(ede-directory-safe-p dir)))
(error "Attempt to load an unsafe project (bug elsewhere in EDE)"))
;; Things are good - so load the project.
(let ((o (funcall (oref this load-type) dir)))
(when (not o)
(error "Project type error: :load-type failed to create a project"))
- (ede-add-project-to-global-list o)))
+ (ede-add-project-to-global-list o)
+ ;; @TODO - Add to hash over at `ede-inode-directory-hash'.
+ ))
+
+
+
+
+
+
+;;; -------- Old Methods
+;; See if we can do without them.
+
+;; @FIXME - delete from loaddefs to remove this.
+(cl-defmethod ede-project-root ((this ede-project-autoload))
+ "If a project knows its root, return it here.
+Allows for one-project-object-for-a-tree type systems."
+ nil)
+
+;; @FIXME - delete from loaddefs to remove this.
+(cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
+ "" nil)
(provide 'ede/auto)
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index 77e5f777866..687b8a0f5ad 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -1,6 +1,6 @@
;;; ede/autoconf-edit.el --- Keymap for autoconf
-;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
@@ -60,6 +60,7 @@ configure the initial configure script using `autoconf-new-automake-string'"
(defvar autoconf-preferred-macro-order
'("AC_INIT"
+ "AC_CONFIG_SRCDIR"
"AM_INIT_AUTOMAKE"
"AM_CONFIG_HEADER"
;; Arg parsing
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index a94ce8f1868..f49cb5bdb16 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,6 +1,6 @@
;;; ede/base.el --- Baseclasses for EDE.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -27,6 +27,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/auto)
@@ -104,7 +105,7 @@ which files this object is interested in."
:accessor ede-object-menu)
)
"A target is a structure that describes a file set that produces something.
-Targets, as with 'Make', is an entity that will manage a file set
+Targets, as with `Make', is an entity that will manage a file set
and knows how to compile or otherwise transform those files into some
other desired outcome.")
@@ -159,6 +160,9 @@ and querying them will cause the actual project to get loaded.")
;; Projects can also affect how EDE works, by changing what appears in
;; the EDE menu, or how some keys are bound.
;;
+(unless (fboundp 'ede-target-list-p)
+ (cl-deftype ede-target-list () '(list-of ede-target)))
+
(defclass ede-project (ede-project-placeholder)
((subproj :initform nil
:type list
@@ -287,16 +291,18 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
- `(save-window-excursion
- (let* ((pf (if (obj-of-class-p ,obj ede-target)
- (ede-target-parent ,obj)
- ,obj))
- (dbka (get-file-buffer (oref pf file))))
- (if (not dbka) (find-file (oref pf file))
- (switch-to-buffer dbka))
+ (declare (indent 1))
+ (unless (symbolp obj)
+ (message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
+ `(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
+ (ede-target-parent ,obj)
+ ,obj))
+ (dbka (get-file-buffer (oref pf file))))
+ (with-current-buffer
+ (if (not dbka) (find-file-noselect (oref pf file))
+ dbka)
,@forms
(if (not dbka) (kill-buffer (current-buffer))))))
-(put 'ede-with-projectfile 'lisp-indent-function 1)
;;; The EDE persistent cache.
;;
@@ -397,7 +403,7 @@ If set to nil, then the cache is not saved."
;;
;; Mode related methods are in ede.el. These methods are related
;; project specific activities not directly tied to a keybinding.
-(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
+(cl-defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
"Get a path name for PROJ which is relative to the parent project.
If PARENT is specified, then be relative to the PARENT project.
Specifying PARENT is useful for sub-sub projects relative to the root project."
@@ -407,7 +413,7 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
(file-relative-name dir (file-name-directory (oref parent file)))
"")))
-(defmethod ede-subproject-p ((proj ede-project))
+(cl-defmethod ede-subproject-p ((proj ede-project))
"Return non-nil if PROJ is a sub project."
;; @TODO - Use this in more places, and also pay attention to
;; metasubproject in ede/proj.el
@@ -420,26 +426,26 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
;; no need to in most situations because they are either a) simple, or
;; b) cosmetic.
-(defmethod ede-name ((this ede-target))
+(cl-defmethod ede-name ((this ede-target))
"Return the name of THIS target."
(oref this name))
-(defmethod ede-target-name ((this ede-target))
+(cl-defmethod ede-target-name ((this ede-target))
"Return the name of THIS target, suitable for make or debug style commands."
(oref this name))
-(defmethod ede-name ((this ede-project))
+(cl-defmethod ede-name ((this ede-project))
"Return a short-name for THIS project file.
Do this by extracting the lowest directory name."
(oref this name))
-(defmethod ede-description ((this ede-project))
+(cl-defmethod ede-description ((this ede-project))
"Return a description suitable for the minibuffer about THIS."
(format "Project %s: %d subprojects, %d targets."
(ede-name this) (length (oref this subproj))
(length (oref this targets))))
-(defmethod ede-description ((this ede-target))
+(cl-defmethod ede-description ((this ede-target))
"Return a description suitable for the minibuffer about THIS."
(format "Target %s: with %d source files."
(ede-name this) (length (oref this source))))
@@ -458,11 +464,11 @@ Not all buffers need headers, so return nil if no applicable."
(ede-buffer-header-file ede-object (current-buffer))
nil))
-(defmethod ede-buffer-header-file ((this ede-project) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
"Return nil, projects don't have header files."
nil)
-(defmethod ede-buffer-header-file ((this ede-target) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-target) buffer)
"There are no default header files in EDE.
Do a quick check to see if there is a Header tag in this buffer."
(with-current-buffer buffer
@@ -484,12 +490,12 @@ Some projects may have multiple documentation files, so return a list."
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
-(defmethod ede-buffer-documentation-files ((this ede-project) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
-(defmethod ede-buffer-documentation-files ((this ede-target) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
@@ -500,7 +506,7 @@ Also do a quick check to see if there is a Documentation tag in this BUFFER."
(let ((cp (ede-toplevel)))
(ede-buffer-documentation-files cp (current-buffer))))))
-(defmethod ede-documentation ((this ede-project))
+(cl-defmethod ede-documentation ((this ede-project))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -515,7 +521,7 @@ files in the project."
proj (cdr proj)))
found))
-(defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -526,7 +532,7 @@ files in the project."
(ede-html-documentation (ede-toplevel))
)
-(defmethod ede-html-documentation ((this ede-project))
+(cl-defmethod ede-html-documentation ((this ede-project))
"Return a list of HTML files provided by project THIS."
)
@@ -536,7 +542,7 @@ files in the project."
;; These methods are used to determine if a target "wants", or could
;; somehow handle a file, or some source type.
;;
-(defmethod ede-want-file-p ((this ede-target) file)
+(cl-defmethod ede-want-file-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -544,7 +550,7 @@ files in the project."
(setq src (cdr src)))
src))
-(defmethod ede-want-file-source-p ((this ede-target) file)
+(cl-defmethod ede-want-file-source-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -552,7 +558,7 @@ files in the project."
(setq src (cdr src)))
src))
-(defmethod ede-target-sourcecode ((this ede-target))
+(cl-defmethod ede-target-sourcecode ((this ede-target))
"Return the sourcecode objects which THIS permits."
(let ((sc (oref this sourcetype))
(rs nil))
@@ -605,7 +611,7 @@ Display the results as a debug list."
"Return the ede project which is the root of the current project.
Optional argument SUBPROJ indicates a subproject to start from
instead of the current project."
- (or ede-object-root-project
+ (or (when (not subproj) ede-object-root-project)
(let* ((cp (or subproj (ede-current-project))))
(or (and cp (ede-project-root cp))
(progn
@@ -620,7 +626,7 @@ instead of the current project."
(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."
+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)
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
new file mode 100644
index 00000000000..f5578a21883
--- /dev/null
+++ b/lisp/cedet/ede/config.el
@@ -0,0 +1,424 @@
+;;; ede/config.el --- Configuration Handler baseclass
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Eric Ludlam <eric@siege-engine.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Some auto-detecting projects (such as the 'generic' project type)
+;; can be enhanced by also saving a configuration file that is EDE
+;; specific. EDE will be able to load that configuration from the save
+;; file as a way of augmenting what is normally already detected.
+;;
+;; How To Use:
+;;
+;; Subclass `ede-extra-config', and add the features you want to use.
+;; Several mixins are available for adding in C++ or Java support. Bring
+;; in the pieces you need.
+;;
+;; Your project and targets should all have a common baseclass from
+;; `ede-project-with-config' or `ede-target-with-config'. When
+;; subclassing the project, be sure to override the class allocated
+;; slots for the `config-class'. This will tie your new project to
+;; the new configuration type.
+;;
+;; You can also override the file name used to save the configuration
+;; object in.
+;;
+;; If you need to take special action in `project-rescan' be sure to also
+;; call `call-next-method' to also get the configuration rescanned.
+;;
+;; Note on config file safety:
+;;
+;; Normally an EDE project that loads a save file should have it's
+;; autoload slot :safe-p set to nil. Projects who save data via
+;; config.el can mark their project as :safe-p t. The config system will
+;; do the queries needed to protect the user. This allows a generic
+;; project to become active in cases where no save file exists, nor is
+;; needed.
+
+;;; Code:
+(require 'ede)
+
+;;; CONFIG
+;;
+;; This is the base of a configuration class supported by the
+;; `ede-project-with-config' baseclass.
+;;
+(defclass ede-extra-config (eieio-persistent)
+ ((extension :initform ".ede")
+ (file-header-line :initform ";; EDE Project Configuration")
+ (project :type ede-project-with-config-child
+ :documentation
+ "The project this config is bound to.")
+ (ignored-file :initform nil
+ :type (or null symbol)
+ :documentation
+ "Set to non-nil if this was created and an on-disk file
+was ignored. Use this to warn the user that they might want to load in
+an on-disk version.")
+ )
+ "Baseclass for auxiliary configuration files for EDE.
+This should be subclassed by projects that auto detect a project
+and also want to save some extra level of configuration.")
+
+;;; PROJECT BASECLASS
+;;
+;; Subclass this baseclass if you want your EDE project to also
+;; support saving an extra configuration file of unique data
+;; needed for this project.
+;;
+(defclass ede-project-with-config (ede-project)
+ ((menu :initform nil)
+ (config-file-basename
+ :initform "Config.ede"
+ :allocation :class
+ :type string
+ :documentation
+ "The filename to use for saving the configuration.
+This filename excludes the directory name and is used to
+initialize the :file slot of the persistent baseclass.")
+ (config-class
+ :initform ede-extra-config
+ :allocation :class
+ :type class
+ :documentation
+ "The class of the configuration used by this project.")
+ (config :initform nil
+ :type (or null ede-extra-config-child)
+ :documentation
+ "The configuration object for this project.")
+ )
+ "Baseclass for projects that save a configuration.")
+
+(defclass ede-target-with-config (ede-target)
+ ()
+ "Baseclass for targets of classes that use a config object.")
+
+;;; Rescanning
+
+(cl-defmethod project-rescan ((this ede-project-with-config))
+ "Rescan this generic project from the sources."
+ ;; Force the config to be rescanned.
+ (oset this config nil)
+ ;; Ask if it is safe to load the config from disk.
+ (ede-config-get-configuration this t)
+ )
+
+;;; Project Methods for configuration
+
+(cl-defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask)
+ "Return the configuration for the project PROJ.
+If optional LOADASK is non-nil, then if a project file exists, and if
+the directory isn't on the `safe' list, ask to add it to the safe list."
+ (let ((config (oref proj config)))
+
+ ;; If the request is coming at a time when we want to ask the user,
+ ;; and there already is a configuration, AND the last time we ignored
+ ;; the on-file version we did so automatically (without asking) then
+ ;; in theory there are NO mods to this config, and we should re-ask,
+ ;; and possibly re-load.
+ (when (and loadask config (eq (oref config ignored-file) 'auto))
+ (setq config nil))
+
+ (when (not config)
+ (let* ((top (oref proj :directory))
+ (fname (expand-file-name (oref proj config-file-basename) top))
+ (class (oref proj config-class))
+ (ignore-type nil))
+ (if (and (file-exists-p fname)
+ (or (ede-directory-safe-p top)
+ ;; Only force the load if someone asked.
+ (and loadask (ede-check-project-directory top))))
+ ;; Load in the configuration
+ (setq config (eieio-persistent-read fname class))
+ ;; If someone said not to load stuff from here then
+ ;; pop up a warning.
+ (when (file-exists-p fname)
+ (message "Ignoring EDE config file for now and creating a new one. Use C-c . g to load it.")
+ ;; Set how it was ignored.
+ (if loadask
+ (setq ignore-type 'manual)
+ (setq ignore-type 'auto))
+ )
+ ;; Create a new one.
+ (setq config (make-instance class
+ "Configuration"
+ :file fname))
+ (oset config ignored-file ignore-type)
+
+ ;; Set initial values based on project.
+ (ede-config-setup-configuration proj config))
+ ;; Link things together.
+ (oset proj config config)
+ (oset config project proj)))
+ config))
+
+(cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
+ "Default configuration setup method."
+ nil)
+
+(cl-defmethod ede-commit-project ((proj ede-project-with-config))
+ "Commit any change to PROJ to its file."
+ (let ((config (ede-config-get-configuration proj)))
+ (ede-commit config)))
+
+;;; Customization
+;;
+(cl-defmethod ede-customize ((proj ede-project-with-config))
+ "Customize the EDE project PROJ by actually configuring the config object."
+ (let ((config (ede-config-get-configuration proj t)))
+ (eieio-customize-object config)))
+
+(cl-defmethod ede-customize ((target ede-target-with-config))
+ "Customize the EDE TARGET by actually configuring the config object."
+ ;; Nothing unique for the targets, use the project.
+ (ede-customize-project))
+
+(cl-defmethod eieio-done-customizing ((config ede-extra-config))
+ "Called when EIEIO is done customizing the configuration object.
+We need to go back through the old buffers, and update them with
+the new configuration."
+ (ede-commit config)
+ ;; Loop over all the open buffers, and re-apply.
+ (ede-map-targets
+ (oref config project)
+ (lambda (target)
+ (ede-map-target-buffers
+ target
+ (lambda (b)
+ (with-current-buffer b
+ (ede-apply-target-options)))))))
+
+(cl-defmethod ede-commit ((config ede-extra-config))
+ "Commit all changes to the configuration to disk."
+ ;; So long as the user is trying to safe this config, make sure they can
+ ;; get at it again later.
+ (let ((dir (file-name-directory (oref config file))))
+ (ede-check-project-directory dir))
+
+ (eieio-persistent-save config))
+
+;;; PROJECT MIXINS
+;;
+;; These are project part mixins. Use multiple inheritance for each
+;; piece of these configuration options you would like to have as part
+;; of your project.
+
+;;; PROGRAM
+;; If there is a program that can be run or debugged that is unknown
+;; and needs to be configured.
+(defclass ede-extra-config-program ()
+ ((debug-command :initarg :debug-command
+ :initform "gdb "
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used for debugging this project.")
+ (run-command :initarg :run-command
+ :initform ""
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used to run something related to this project."))
+ "Class to mix into a configuration for debug/run of programs.")
+
+(defclass ede-project-with-config-program ()
+ ()
+ "Class to mix into a project with configuration for programs.")
+
+(defclass ede-target-with-config-program ()
+ ()
+ "Class to mix into a project with configuration for programs.
+This class brings in method overloads for running and debugging
+programs from a project.")
+
+(cl-defmethod project-debug-target ((target ede-target-with-config-program))
+ "Run the current project derived from TARGET in a debugger."
+ (let* ((proj (ede-target-parent target))
+ (config (ede-config-get-configuration proj t))
+ (debug (oref config :debug-command))
+ (cmd (read-from-minibuffer
+ "Debug Command: "
+ debug))
+ (cmdsplit (split-string cmd " " t))
+ ;; @TODO - this depends on the user always typing in something good
+ ;; like "gdb" or "dbx" which also exists as a useful Emacs command.
+ ;; Is there a better way?
+ (cmdsym (intern-soft (car cmdsplit))))
+ (call-interactively cmdsym t)))
+
+(declare-function ede-shell-run-something "ede/shell")
+
+(cl-defmethod project-run-target ((target ede-target-with-config-program))
+ "Run the current project derived from TARGET."
+ (let* ((proj (ede-target-parent target))
+ (config (ede-config-get-configuration proj t))
+ (run (concat "./" (oref config :run-command)))
+ (cmd (read-from-minibuffer "Run (like this): " run)))
+ (ede-shell-run-something target cmd)))
+
+;;; BUILD
+;; If the build style is unknown and needs to be configured.
+(defclass ede-extra-config-build ()
+ ((build-command :initarg :build-command
+ :initform "make -k"
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used for building this project."))
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-build ()
+ ()
+ "Class to mix into a project with configuration for builds.
+This class brings in method overloads for building.")
+
+(defclass ede-target-with-config-build ()
+ ()
+ "Class to mix into a project with configuration for builds.
+This class brings in method overloads for for building.")
+
+(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
+ "Compile the entire current project PROJ.
+Argument COMMAND is the command to use when compiling."
+ (let* ((config (ede-config-get-configuration proj t))
+ (comp (oref config :build-command)))
+ (compile comp)))
+
+(cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
+ "Compile the current target OBJ.
+Argument COMMAND is the command to use for compiling the target."
+ (project-compile-project (ede-current-project) command))
+
+;;; C / C++
+;; Configure includes and preprocessor symbols for C/C++ needed by
+;; Semantic.
+(defclass ede-extra-config-c ()
+ ((c-include-path :initarg :c-include-path
+ :initform nil
+ :type list
+ :custom (repeat (string :tag "Path"))
+ :group c
+ :documentation
+ "The include path used by C/C++ projects.
+The include path is used when searching for symbols.")
+ (c-preprocessor-table :initarg :c-preprocessor-table
+ :initform nil
+ :type list
+ :custom (repeat (cons (string :tag "Macro")
+ (string :tag "Value")))
+ :group c
+ :documentation
+ "Preprocessor Symbols for this project.
+When files within this project are parsed by CEDET, these symbols will be
+used to resolve macro occurrences in source files.
+If you modify this slot, you will need to force your source files to be
+parsed again.")
+ (c-preprocessor-files :initarg :c-preprocessor-files
+ :initform nil
+ :type list
+ :group c
+ :custom (repeat (string :tag "Include File"))
+ :documentation
+ "Files parsed and used to populate preprocessor tables.
+When files within this project are parsed by CEDET, these symbols will be used to
+resolve macro occurrences in source files.
+If you modify this slot, you will need to force your source files to be
+parsed again."))
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-c ()
+ ()
+ "Class to mix into a project for C/C++ support.")
+
+(defclass ede-target-with-config-c ()
+ ()
+ "Class to mix into a project for C/C++ support.
+This target brings in methods used by Semantic to query
+the preprocessor map, and include paths.")
+
+(declare-function semanticdb-file-table-object "semantic/db"
+ (file &optional dontload))
+(declare-function semanticdb-needs-refresh-p "semantic/db" (arg &rest args))
+(declare-function semanticdb-refresh-table "semantic/db" (arg &rest args))
+
+(cl-defmethod ede-preprocessor-map ((this ede-target-with-config-c))
+ "Get the pre-processor map for some generic C code."
+ (require 'semantic/sb)
+ (let* ((proj (ede-target-parent this))
+ (root (ede-project-root proj))
+ (config (ede-config-get-configuration proj))
+ filemap
+ )
+ ;; Preprocessor files
+ (dolist (G (oref config :c-preprocessor-files))
+ (let ((table (semanticdb-file-table-object
+ (ede-expand-filename root G))))
+ (when table
+ (when (semanticdb-needs-refresh-p table)
+ (semanticdb-refresh-table table))
+ (setq filemap (append filemap (oref table lexical-table)))
+ )))
+ ;; The core table
+ (setq filemap (append filemap (oref config :c-preprocessor-table)))
+
+ filemap
+ ))
+
+(cl-defmethod ede-system-include-path ((this ede-target-with-config-c))
+ "Get the system include path used by project THIS."
+ (let* ((proj (ede-target-parent this))
+ (config (ede-config-get-configuration proj)))
+ (oref config c-include-path)))
+
+;;; Java
+;; Configuration needed for programming with Java.
+(defclass ede-extra-config-java ()
+ ()
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-java ()
+ ()
+ "Class to mix into a project to support java.
+This brings in methods to support Semantic querying the
+java class path.")
+
+(defclass ede-target-with-config-java ()
+ ()
+ "Class to mix into a project to support java.")
+
+(cl-defmethod ede-java-classpath ((proj ede-project-with-config-java))
+ "Return the classpath for this project."
+ (oref (ede-config-get-configuration proj) :classpath))
+
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "ede/config"
+;; End:
+
+(provide 'ede/config)
+
+;;; ede/config.el ends here
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index 719289765a3..22e24c8b67f 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -1,6 +1,6 @@
;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -95,7 +95,7 @@
;; Where FILENAME is a file in the root directory of the project.
;; Where MYFCN is a symbol for a function. See:
;;
-;; M-x describe-class RET ede-cpp-root-project RET
+;; M-x describe-function RET ede-cpp-root-project RET
;;
;; for documentation about the locate-fcn extension.
;;
@@ -116,11 +116,6 @@
;; <write your code here, or return nil>
;; )
;;
-;; (defun MY-ROOT-FCN ()
-;; "Return the root directory for `default-directory'"
-;; ;; You might be able to use `ede-cpp-root-project-root'.
-;; )
-;;
;; (defun MY-LOAD (dir)
;; "Load a project of type `cpp-root' for the directory DIR.
;; Return nil if there isn't one."
@@ -128,16 +123,14 @@
;; :locate-fcn 'MYFCN)
;; )
;;
-;; (add-to-list 'ede-project-class-files
-;; (ede-project-autoload "cpp-root"
+;; (ede-add-project-autoload
+;; (ede-project-autoload "cpp-root"
;; :name "CPP ROOT"
;; :file 'ede/cpp-root
;; :proj-file 'MY-FILE-FOR-DIR
-;; :proj-root 'MY-ROOT-FCN
;; :load-type 'MY-LOAD
;; :class-sym 'ede-cpp-root-project
-;; :safe-p t)
-;; t)
+;; :safe-p t))
;;
;;; TODO
;;
@@ -168,91 +161,13 @@
;;; PROJECT CACHE:
;;
-;; cpp-root projects are created in a .emacs or other config file, but
-;; there still needs to be a way for a particular file to be
-;; identified against it. The cache is where we look to map a file
-;; against a project.
-;;
-;; Setting up a simple in-memory cache of active projects allows the
-;; user to re-load their configuration file several times without
-;; messing up the active project set.
+;; cpp-root projects are created in a .emacs or other config file. We
+;; need to cache them so if the user re-loads a lisp file with the
+;; config in it, we can flush out the old one and replace it.
;;
(defvar ede-cpp-root-project-list nil
"List of projects created by option `ede-cpp-root-project'.")
-(defun ede-cpp-root-file-existing (dir)
- "Find a cpp-root project in the list of cpp-root projects.
-DIR is the directory to search from."
- (let ((projs ede-cpp-root-project-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))
-
-;;; PROJECT AUTOLOAD CONFIG
-;;
-;; Each project type registers itself into the project-class list.
-;; This way, each time a file is loaded, EDE can map that file to a
-;; project. This project type checks files against the internal cache
-;; of projects created by the user.
-;;
-;; EDE asks two kinds of questions. One is, does this DIR belong to a
-;; project. If it does, it then asks, what is the ROOT directory to
-;; the project in DIR. This is easy for cpp-root projects, but more
-;; complex for multiply nested projects.
-;;
-;; If EDE finds out that a project exists for DIR, it then loads that
-;; project. The LOAD routine can either create a new project object
-;; (if it needs to load it off disk) or more likely can return an
-;; existing object for the discovered directory. cpp-root always uses
-;; the second case.
-
-(defun ede-cpp-root-project-file-for-dir (&optional dir)
- "Return a full file name to the project file stored in DIR."
- (let ((proj (ede-cpp-root-file-existing dir)))
- (when proj (oref proj :file))))
-
-(defvar ede-cpp-root-count 0
- "Count number of hits to the cpp root thing.
-This is a debugging variable to test various optimizations in file
-lookup in the main EDE logic.")
-
-;;;###autoload
-(defun ede-cpp-root-project-root (&optional dir)
- "Get the root directory for DIR."
- (let ((projfile (ede-cpp-root-project-file-for-dir
- (or dir default-directory))))
- (setq ede-cpp-root-count (1+ ede-cpp-root-count))
- ;(debug)
- (when projfile
- (file-name-directory projfile))))
-
-(defun ede-cpp-root-load (dir &optional rootproj)
- "Return a CPP root object if you created one.
-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."
- ;; Snoop through our master list.
- (ede-cpp-root-file-existing dir))
-
-;;;###autoload
-(ede-add-project-autoload
- (ede-project-autoload "cpp-root"
- :name "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-project
- :new-p nil
- :safe-p t)
- ;; When a user creates one of these, it should override any other project
- ;; type that might happen to be in this directory, so force this to the
- ;; very front.
- 'unique)
;;; CLASSES
;;
@@ -347,7 +262,7 @@ exist, it should return nil."
: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 'compile' function that will be issued in root
+The string will be passed to `compile' function that will be issued in root
directory of project."
)
)
@@ -361,17 +276,18 @@ Each directory needs a project file to control it.")
;; find previous copies of this project, and make sure that one of the
;; objects is deleted.
-(defmethod initialize-instance ((this ede-cpp-root-project)
+(cl-defmethod initialize-instance ((this ede-cpp-root-project)
&rest fields)
"Make sure the :file is fully expanded."
;; Add ourselves to the master list
- (call-next-method)
+ (cl-call-next-method)
(let ((f (expand-file-name (oref this :file))))
;; Remove any previous entries from the main list.
(let ((old (eieio-instance-tracker-find (file-name-directory f)
:directory 'ede-cpp-root-project-list)))
;; This is safe, because :directory isn't filled in till later.
(when (and old (not (eq old this)))
+ (ede-delete-project-from-global-list old)
(delete-instance old)))
;; Basic initialization.
(when (or (not (file-exists-p f))
@@ -381,11 +297,13 @@ Each directory needs a project file to control it.")
(oset this :file f)
(oset this :directory (file-name-directory f))
(ede-project-directory-remove-hash (file-name-directory f))
+ ;; NOTE: We must add to global list here because these classes are not
+ ;; created via the typical loader, but instead via calls from a .emacs
+ ;; file.
(ede-add-project-to-global-list this)
+
(unless (slot-boundp this 'targets)
(oset this :targets nil))
- ;; We need to add ourselves to the master list.
- ;;(setq ede-projects (cons this ede-projects))
))
;;; SUBPROJ Management.
@@ -393,7 +311,7 @@ Each directory needs a project file to control it.")
;; This is a way to allow a subdirectory to point back to the root
;; project, simplifying authoring new single-point projects.
-(defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -403,7 +321,7 @@ Each directory needs a project file to control it.")
;; Creating new targets on a per directory basis is a good way to keep
;; files organized. See ede-emacs for an example with multiple file
;; types.
-(defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets))
@@ -429,13 +347,13 @@ If one doesn't exist, create a new one for this directory."
;;
;; This tools also uses the ede-locate setup for augmented file name
;; lookup using external tools.
-(defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
"Within this project PROJ, find the file NAME.
This knows details about or source tree."
;; The slow part of the original is looping over subprojects.
;; This version has no subprojects, so this will handle some
;; basic cases.
- (let ((ans (call-next-method)))
+ (let ((ans (cl-call-next-method)))
(unless ans
(let* ((lf (oref proj locate-fcn))
(dir (file-name-directory (oref proj file))))
@@ -454,30 +372,30 @@ This knows details about or source tree."
(setq ans tmp))
(setq ip (cdr ip)) ))
;; Else, do the usual.
- (setq ans (call-next-method)))
+ (setq ans (cl-call-next-method)))
)))
;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here?
- (or ans (call-next-method))))
+ (or ans (cl-call-next-method))))
-(defmethod ede-project-root ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root ((this ede-cpp-root-project))
"Return my root."
this)
-(defmethod ede-project-root-directory ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root-directory ((this ede-cpp-root-project))
"Return my root."
- (file-name-directory (oref this file)))
+ (oref this directory))
;;; C/CPP SPECIFIC CODE
;;
;; The following code is specific to setting up header files,
;; include lists, and Preprocessor symbol tables.
-(defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
"Non nil if in PROJ the filename NAME is a header."
(save-match-data
(string-match (oref proj header-match-regexp) name)))
-(defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
+(cl-defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
"For PROJ, translate a user specified FILENAME.
This is for project include paths and spp source files."
;; Step one: Root of this project.
@@ -493,11 +411,11 @@ This is for project include paths and spp source files."
filename))
-(defmethod ede-system-include-path ((this ede-cpp-root-project))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-project))
"Get the system include path used by project THIS."
(oref this system-include-path))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-project))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-project))
"Get the pre-processor map for project THIS."
(require 'semantic/db)
(let ((spp (oref this spp-table))
@@ -527,15 +445,15 @@ This is for project include paths and spp source files."
(oref this spp-files))
spp))
-(defmethod ede-system-include-path ((this ede-cpp-root-target))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-target))
"Get the system include path used by target THIS."
(ede-system-include-path (ede-target-parent this)))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-target))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-target))
"Get the pre-processor map for project THIS."
(ede-preprocessor-map (ede-target-parent this)))
-(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work
@@ -551,13 +469,17 @@ Argument COMMAND is the command to use when compiling."
(let ((default-directory (ede-project-root-directory proj)))
(compile cmd-str)))))
-(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(when (oref obj :project)
(project-compile-project (oref obj :project) command)))
+(cl-defmethod project-rescan ((this ede-cpp-root-project))
+ "Don't rescan this project from the sources."
+ (message "cpp-root has nothing to rescan."))
+
;;; 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/custom.el b/lisp/cedet/ede/custom.el
index f37f8174f73..5b8783fd273 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,6 +1,6 @@
;;; ede/custom.el --- customization of EDE projects.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -61,7 +61,7 @@
"Edit fields of the current target through EIEIO & Custom."
(interactive)
(require 'eieio-custom)
- (if (not (obj-of-class-p ede-object ede-target))
+ (if (not (obj-of-class-p ede-object 'ede-target))
(error "Current file is not part of a target"))
(ede-customize-target ede-object))
@@ -72,15 +72,15 @@
"Edit fields of the current target through EIEIO & Custom.
OBJ is the target object to customize."
(require 'eieio-custom)
- (if (and obj (not (obj-of-class-p obj ede-target)))
+ (if (and obj (not (obj-of-class-p obj 'ede-target)))
(error "No logical target to customize"))
(ede-customize obj))
-(defmethod ede-customize ((proj ede-project))
+(cl-defmethod ede-customize ((proj ede-project))
"Customize the EDE project PROJ."
(eieio-customize-object proj 'default))
-(defmethod ede-customize ((target ede-target))
+(cl-defmethod ede-customize ((target ede-target))
"Customize the EDE TARGET."
(eieio-customize-object target 'default))
@@ -177,7 +177,7 @@ OBJ is the target object to customize."
;;; Customization hooks
;;
;; These hooks are used when finishing up a customization.
-(defmethod eieio-done-customizing ((proj ede-project))
+(cl-defmethod eieio-done-customizing ((proj ede-project))
"Call this when a user finishes customizing PROJ."
(let ((ov eieio-ede-old-variables)
(nv (oref proj local-variables)))
@@ -196,11 +196,11 @@ OBJ is the target object to customize."
;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified
;; changes.
-(defmethod eieio-done-customizing ((target ede-target))
+(cl-defmethod eieio-done-customizing ((target ede-target))
"Call this when a user finishes customizing TARGET."
nil)
-(defmethod ede-commit-project ((proj ede-project))
+(cl-defmethod ede-commit-project ((proj ede-project))
"Commit any change to PROJ to its file."
nil
)
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
new file mode 100644
index 00000000000..9761b9e0828
--- /dev/null
+++ b/lisp/cedet/ede/detect.el
@@ -0,0 +1,210 @@
+;;; ede/detect.el --- EDE project detection and file associations
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Project detection for EDE;
+;;
+;; Detection comes in multiple forms:
+;;
+;; `ede-detect-scan-directory-for-project' -
+;; Scan for a project via the file system.
+;; `ede-detect-directory-for-project' -
+;; Check our file cache for a project. If that fails, use
+;; the scan fcn above.
+
+;;; Code:
+
+(require 'ede/auto) ;; Autoload settings.
+
+(when (or (<= emacs-major-version 23)
+ ;; predicate as name added in Emacs 24.2
+ (and (= emacs-major-version 24)
+ (< emacs-minor-version 2)))
+ (message "Loading CEDET fallback autoload library.")
+ (require 'cedet/dominate
+ (expand-file-name "../../../etc/fallback-libraries/dominate.el"
+ (file-name-directory load-file-name))))
+
+
+;;; BASIC PROJECT SCAN
+;;
+(defun ede--detect-stop-scan-p (dir)
+ "Return non-nil if we need to stop scanning upward in DIR."
+ ;;(let ((stop
+ (file-exists-p (expand-file-name ".ede_stop_scan" dir)))
+;;)
+;;(when stop
+;;(message "Stop Scan at %s" dir))
+;;stop))
+
+(defvar ede--detect-found-project nil
+ "When searching for a project, temporarily save that file.")
+
+(defun ede--detect-ldf-predicate (dir)
+ "Non-nil if DIR contain any known EDE project types."
+ (if (ede--detect-stop-scan-p dir)
+ (throw 'stopscan nil)
+ (let ((types ede-project-class-files))
+ ;; Loop over all types, loading in the first type that we find.
+ (while (and types (not ede--detect-found-project))
+ (if (ede-auto-detect-in-dir (car types) dir)
+ (progn
+ ;; We found one!
+ (setq ede--detect-found-project (car types)))
+ (setq types (cdr types)))
+ )
+ ede--detect-found-project)))
+
+(defun ede--detect-scan-directory-for-project (directory)
+ "Detect an EDE project for the current DIRECTORY by scanning.
+This function ALWAYS scans files and directories and DOES NOT
+use any file caches.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((ede--detect-found-project nil)
+ (root
+ (catch 'stopscan
+ (locate-dominating-file directory
+ 'ede--detect-ldf-predicate))))
+ (when root
+ (cons root ede--detect-found-project))))
+
+;;; Root Only project detect
+;;
+;; For projects that only have a detectable ROOT file, but may in fact
+;; contain a generic file such as a Makefile, we need to do a second scan
+;; to make sure we don't miss-match.
+(defun ede--detect-ldf-rootonly-predicate (dir)
+ "Non-nil if DIR contain any known EDE project types."
+ (if (ede--detect-stop-scan-p dir)
+ (throw 'stopscan nil)
+ (let ((types ede-project-class-files))
+ ;; Loop over all types, loading in the first type that we find.
+ (while (and types (not ede--detect-found-project))
+ (if (and
+ (oref (car types) root-only)
+ (ede-auto-detect-in-dir (car types) dir))
+ (progn
+ ;; We found one!
+ (setq ede--detect-found-project (car types)))
+ (setq types (cdr types)))
+ )
+ ede--detect-found-project)))
+
+(defun ede--detect-scan-directory-for-rootonly-project (directory)
+ "Detect an EDE project for the current DIRECTORY by scanning.
+This function ALWAYS scans files and directories and DOES NOT
+use any file caches.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((ede--detect-found-project nil)
+ (root
+ (catch 'stopscan
+ (locate-dominating-file directory
+ 'ede--detect-ldf-rootonly-predicate))))
+ (when root
+ (cons root ede--detect-found-project))))
+
+
+;;; NESTED PROJECT SCAN
+;;
+;; For projects that can have their dominating file exist in all their
+;; sub-directories as well.
+
+(defvar ede--detect-nomatch-auto nil
+ "An ede autoload that needs to be un-matched.")
+
+(defun ede--detect-ldf-root-predicate (dir)
+ "Non-nil if DIR no longer match `ede--detect-nomatch-auto'."
+ (or (ede--detect-stop-scan-p dir)
+ ;; To know if DIR is at the top, we need to look just above
+ ;; to see if there is a match.
+ (let ((updir (file-name-directory (directory-file-name dir))))
+ (if (equal updir dir)
+ ;; If it didn't change, then obviously this must be the top.
+ t
+ ;; If it is different, check updir for the file.
+ (not (ede-auto-detect-in-dir ede--detect-nomatch-auto updir))))))
+
+(defun ede--detect-scan-directory-for-project-root (directory auto)
+ "If DIRECTORY has already been detected with AUTO, find the root.
+Some projects have their dominating file in all their directories, such
+as Project.ede. In that case we will detect quickly, but then need
+to scan upward to find the topmost occurrence of that file."
+ (let* ((ede--detect-nomatch-auto auto)
+ (root (locate-dominating-file directory
+ 'ede--detect-ldf-root-predicate)))
+ root))
+
+;;; TOP LEVEL SCAN
+;;
+;; This function for combining the above scans.
+(defun ede-detect-directory-for-project (directory)
+ "Detect an EDE project for the current DIRECTORY.
+Scan the filesystem for a project.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((scan (ede--detect-scan-directory-for-project directory))
+ (root (car scan))
+ (auto (cdr scan)))
+ (when scan
+ ;; If what we found is already a root-only project, return it.
+ (if (oref auto root-only)
+ scan
+
+ ;; If what we found is a generic project, check to make sure we aren't
+ ;; in some other kind of root project.
+ (if (oref auto generic-p)
+ (let ((moreroot (ede--detect-scan-directory-for-rootonly-project root)))
+ ;; If we found a rootier project, return that.
+ (if moreroot
+ moreroot
+
+ ;; If we didn't find a root from the generic project, then
+ ;; we need to rescan upward.
+ (cons (ede--detect-scan-directory-for-project-root root auto) auto)))
+
+ ;; Non-generic non-root projects also need to rescan upward.
+ (cons (ede--detect-scan-directory-for-project-root root auto) auto)))
+
+ )))
+
+;;; TEST
+;;
+;; A quick interactive testing fcn.
+(defun ede-detect-qtest ()
+ "Run a quick test for autodetecting on BUFFER."
+ (interactive)
+ (let ((start (current-time))
+ (ans (ede-detect-directory-for-project default-directory))
+ (end (current-time)))
+ (if ans
+ (message "Project found in %d sec @ %s of type %s"
+ (float-time (time-subtract end start))
+ (car ans)
+ (eieio-object-name-string (cdr ans)))
+ (message "No Project found.") )))
+
+
+(provide 'ede/detect)
+
+;;; ede/detect.el ends here
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index b010f5fddfa..836a538e2cd 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,10 +1,10 @@
;;; ede/dired.el --- EDE extensions to dired.
-;; Copyright (C) 1998-2000, 2003, 2009-2013 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2003, 2009-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.4
+;; Old-Version: 0.4
;; Keywords: project, make
;; This file is part of GNU Emacs.
@@ -56,6 +56,7 @@
map)
"Keymap used for ede dired minor mode.")
+;;;###autoload
(define-minor-mode ede-dired-minor-mode
"A minor mode that should only be activated in DIRED buffers.
If ARG is nil or a positive number, force on, if
@@ -84,4 +85,9 @@ negative, force off."
(provide 'ede/dired)
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "ede/dired"
+;; End:
+
;;; ede/dired.el ends here
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index f5a85f4a01b..c3caf98bc61 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,6 +1,6 @@
;;; ede/emacs.el --- Special project for Emacs
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,37 +38,12 @@
(declare-function semanticdb-refresh-table "semantic/db")
;;; Code:
-(defvar ede-emacs-project-list nil
- "List of projects created by option `ede-emacs-project'.")
-
-(defun ede-emacs-file-existing (dir)
- "Find a Emacs project in the list of Emacs projects.
-DIR is the directory to search from."
- (let ((projs ede-emacs-project-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root))
- (file-name-as-directory dir))
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-;;;###autoload
-(defun ede-emacs-project-root (&optional dir)
+;; @TODO - get rid of this. Stuck in loaddefs right now.
+
+(defun ede-emacs-project-root (&optional _dir)
"Get the root directory for DIR."
- (when (not dir) (setq dir default-directory))
- (let ((case-fold-search t)
- (proj (ede-files-find-existing dir ede-emacs-project-list)))
- (if proj
- (ede-up-directory (file-name-directory
- (oref proj :file)))
- ;; No pre-existing project. Let's take a wild-guess if we have
- ;; an Emacs project here.
- (when (string-match "emacs[^/]*" dir)
- (let ((base (substring dir 0 (match-end 0))))
- (when (file-exists-p (expand-file-name "src/emacs.c" base))
- base))))))
+ nil)
(defun ede-emacs-version (dir)
"Find the Emacs version for the Emacs src in DIR.
@@ -80,12 +55,6 @@ Return a tuple of ( EMACSNAME . VERSION )."
(with-current-buffer buff
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
- (or (file-exists-p configure_ac)
- (setq configure_ac "configure.in"))
- ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile")
- (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac)
- (goto-char (point-min))
- ;(re-search-forward "version=\\([0-9.]+\\)")
(cond
;; Maybe XEmacs?
((file-exists-p "version.sh")
@@ -113,51 +82,48 @@ m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
;; Insert other Emacs here...
;; Vaguely recent version of GNU Emacs?
- (t
+ ((or (file-exists-p configure_ac)
+ (file-exists-p (setq configure_ac "configure.in")))
(insert-file-contents configure_ac)
(goto-char (point-min))
- (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)")
+ (re-search-forward "AC_INIT(\\(?:GNU \\)?[eE]macs,\\s-*\\([0-9.]+\\)\\s-*[,)]")
(setq ver (match-string 1))
)
)
;; Return a tuple
(cons emacs ver))))
-(defclass ede-emacs-project (ede-project eieio-instance-tracker)
- ((tracking-symbol :initform 'ede-emacs-project-list)
+(defclass ede-emacs-project (ede-project)
+ (
)
"Project Type for the Emacs source code."
:method-invocation-order :depth-first)
-(defun ede-emacs-load (dir &optional rootproj)
+(defun ede-emacs-load (dir &optional _rootproj)
"Return an Emacs Project object if there is a match.
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-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
- (car vertuple)
- :name (car vertuple)
- :version (cdr vertuple)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "src/emacs.c"
- dir))))
- (ede-add-project-to-global-list proj))))
+ ;; Doesn't already exist, so let's make one.
+ (let* ((vertuple (ede-emacs-version dir)))
+ (ede-emacs-project
+ (car vertuple)
+ :name (car vertuple)
+ :version (cdr vertuple)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "src/emacs.c"
+ dir))))
;;;###autoload
(ede-add-project-autoload
- (ede-project-autoload "emacs"
- :name "EMACS ROOT"
- :file 'ede/emacs
- :proj-file "src/emacs.c"
- :proj-root-dirmatch "emacs[^/]*"
- :proj-root 'ede-emacs-project-root
- :load-type 'ede-emacs-load
- :class-sym 'ede-emacs-project
- :new-p nil
- :safe-p t)
+ (make-instance 'ede-project-autoload
+ :name "EMACS ROOT"
+ :file 'ede/emacs
+ :proj-file "src/emacs.c"
+ :load-type 'ede-emacs-load
+ :class-sym 'ede-emacs-project
+ :new-p nil
+ :safe-p t)
'unique)
(defclass ede-emacs-target-c (ede-target)
@@ -175,26 +141,26 @@ All directories need at least one target.")
"EDE Emacs Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-emacs-project)
- &rest fields)
+(cl-defmethod initialize-instance ((this ede-emacs-project)
+ &rest _fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-emacs-project)
- &optional file)
+(cl-defmethod ede-project-root-directory ((this ede-emacs-project)
+ &optional _file)
"Return the root for THIS Emacs project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-emacs-project))
+(cl-defmethod ede-project-root ((this ede-emacs-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
- dir)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -205,12 +171,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-emacs-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-emacs-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -238,7 +204,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-emacs-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-emacs-target-c))
"Get the pre-processor map for Emacs C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
@@ -287,7 +253,7 @@ All files need the macros from lisp.h!"
(setq dirs (cdr dirs))))
ans))
-(defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Emacs source tree is organized."
(let* ((ext (file-name-extension name))
@@ -303,10 +269,19 @@ Knows about how the Emacs source tree is organized."
'("doc"))
(t nil)))
)
- (if (not dirs) (call-next-method)
+ (if (not dirs) (cl-call-next-method)
(ede-emacs-find-in-directories name dir dirs))
))
+;;; Command Support
+;;
+(cl-defmethod project-rescan ((this ede-emacs-project))
+ "Rescan this Emacs project from the sources."
+ (let ((ver (ede-emacs-version (ede-project-root-directory this))))
+ (oset this name (car ver))
+ (oset this version (cdr ver))
+ ))
+
(provide 'ede/emacs)
;; Local variables:
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 91433add7b0..4ba823adeee 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -1,6 +1,6 @@
;;; ede/files.el --- Associate projects with files and directories.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -41,7 +41,7 @@
(declare-function ede-locate-flush-hash "ede/locate")
(defvar ede--disable-inode nil
- "Set to 't' to simulate systems w/out inode support.")
+ "Set to t to simulate systems w/out inode support.")
;;; Code:
;;;###autoload
@@ -69,57 +69,26 @@ the current EDE project."
;;; Placeholders for ROOT directory scanning on base objects
;;
-(defmethod ede-project-root ((this ede-project-placeholder))
+(cl-defmethod ede-project-root ((this ede-project-placeholder))
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
(oref this rootproject))
-(defmethod ede-project-root-directory ((this ede-project-placeholder)
+(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
&optional file)
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
Optional FILE is the file to test. It is ignored in preference
of the anchor file for the project."
- (file-name-directory (expand-file-name (oref this file))))
+ (let ((root (or (ede-project-root this) this)))
+ (file-name-directory (expand-file-name (oref this file)))))
-(defmethod ede--project-inode ((proj ede-project-placeholder))
- "Get the inode of the directory project PROJ is in."
- (if (slot-boundp proj 'dirinode)
- (oref proj dirinode)
- (oset proj dirinode (ede--inode-for-dir (oref proj :directory)))))
-
-(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
- dir)
- "Find a subproject of PROJ that corresponds to DIR."
- (if ede--disable-inode
- (let ((ans nil))
- ;; Try to find the right project w/out inodes.
- (ede-map-subprojects
- proj
- (lambda (SP)
- (when (not ans)
- (if (string= (file-truename dir) (oref SP :directory))
- (setq ans SP)
- (ede-find-subproject-for-directory SP dir)))))
- ans)
- ;; We can use inodes, so let's try it.
- (let ((ans nil)
- (inode (ede--inode-for-dir dir)))
- (ede-map-subprojects
- proj
- (lambda (SP)
- (when (not ans)
- (if (equal (ede--project-inode SP) inode)
- (setq ans SP)
- (setq ans (ede-find-subproject-for-directory SP dir))))))
- ans)))
+;; Why INODEs?
+;; An inode represents a unique ID that transcends symlinks, hardlinks, etc.
+;; so when we cache an inode in a project, and hash directories to inodes, we
+;; can avoid costly filesystem queries and regex matches.
-;;; DIRECTORY IN OPEN PROJECT
-;;
-;; These routines match some directory name to one of the many pre-existing
-;; open projects. This should avoid hitting the disk, or asking lots of questions
-;; if used throughout the other routines.
(defvar ede-inode-directory-hash (make-hash-table
;; Note on test. Can we compare inodes or something?
:test 'equal)
@@ -147,6 +116,32 @@ of the anchor file for the project."
(ede--put-inode-dir-hash dir (nth 10 fattr))
)))))
+(cl-defmethod ede--project-inode ((proj ede-project-placeholder))
+ "Get the inode of the directory project PROJ is in."
+ (if (slot-boundp proj 'dirinode)
+ (oref proj dirinode)
+ (oset proj dirinode (ede--inode-for-dir (oref proj :directory)))))
+
+(defun ede--inode-get-toplevel-open-project (inode)
+ "Return an already open toplevel project that is managing INODE.
+Does not check subprojects."
+ (when (or (and (numberp inode) (/= inode 0))
+ (consp inode))
+ (let ((all ede-projects)
+ (found nil)
+ )
+ (while (and all (not found))
+ (when (equal inode (ede--project-inode (car all)))
+ (setq found (car all)))
+ (setq all (cdr all)))
+ found)))
+
+;;; DIRECTORY IN OPEN PROJECT
+;;
+;; These routines match some directory name to one of the many pre-existing
+;; open projects. This should avoid hitting the disk, or asking lots of questions
+;; if used throughout the other routines.
+
(defun ede-directory-get-open-project (dir &optional rootreturn)
"Return an already open project that is managing DIR.
Optional ROOTRETURN specifies a symbol to set to the root project.
@@ -156,66 +151,105 @@ If DIR is the root project, then it is the same."
(proj (ede--inode-get-toplevel-open-project inode))
(ans nil))
;; Try file based search.
- (when (not proj)
+ (when (or ede--disable-inode (not proj))
(setq proj (ede-directory-get-toplevel-open-project ft)))
;; Default answer is this project
(setq ans proj)
;; Save.
(when rootreturn (set rootreturn proj))
;; Find subprojects.
- (when (and proj (or ede--disable-inode
- (not (equal inode (ede--project-inode proj)))))
+ (when (and proj (if ede--disable-inode
+ (not (string= ft (expand-file-name (oref proj :directory))))
+ (not (equal inode (ede--project-inode proj)))))
(setq ans (ede-find-subproject-for-directory proj ft)))
ans))
-(defun ede--inode-get-toplevel-open-project (inode)
- "Return an already open toplevel project that is managing INODE.
-Does not check subprojects."
- (when (or (and (numberp inode) (/= inode 0))
- (consp inode))
- (let ((all ede-projects)
- (found nil)
- )
- (while (and all (not found))
- (when (equal inode (ede--project-inode (car all)))
- (setq found (car all)))
- (setq all (cdr all)))
- found)))
-
-(defun ede-directory-get-toplevel-open-project (dir)
- "Return an already open toplevel project that is managing DIR."
+;; Force all users to switch to `ede-directory-get-open-project'
+;; for performance reasons.
+(defun ede-directory-get-toplevel-open-project (dir &optional exact)
+ "Return an already open toplevel project that is managing DIR.
+If optional EXACT is non-nil, only return exact matches for DIR."
(let ((ft (file-name-as-directory (expand-file-name dir)))
(all ede-projects)
- (ans nil))
+ (ans nil)
+ (shortans nil))
(while (and all (not ans))
;; Do the check.
- (let ((pd (oref (car all) :directory))
+ (let ((pd (expand-file-name (oref (car all) :directory)))
)
(cond
;; Exact text match.
((string= pd ft)
(setq ans (car all)))
;; Some sub-directory
- ((string-match (concat "^" (regexp-quote pd)) ft)
- (setq ans (car all)))
+ ((and (not exact) (string-match (concat "^" (regexp-quote pd)) ft))
+ (if (not shortans)
+ (setq shortans (car all))
+ ;; We already have a short answer, so see if pd (the match we found)
+ ;; is longer. If it is longer, then it is more precise.
+ (when (< (length (oref shortans :directory))
+ (length pd))
+ (setq shortans (car all))))
+ )
;; Exact inode match. Useful with symlinks or complex automounters.
- ((let ((pin (ede--project-inode (car all)))
- (inode (ede--inode-for-dir dir)))
- (and (not (eql pin 0)) (equal pin inode)))
+ ((and (not ede--disable-inode)
+ (let ((pin (ede--project-inode (car all)))
+ (inode (ede--inode-for-dir dir)))
+ (and (not (eql pin 0)) (equal pin inode))))
(setq ans (car all)))
;; Subdir via truename - slower by far, but faster than a traditional lookup.
- ((let ((ftn (file-truename ft))
- (ptd (file-truename (oref (car all) :directory))))
- (string-match (concat "^" (regexp-quote ptd)) ftn))
- (setq ans (car all)))
- ))
+ ;; Note that we must resort to truename in order to resolve issues such as
+ ;; cross-symlink projects.
+ ((and (not exact)
+ (let ((ftn (file-truename ft))
+ (ptd (file-truename pd)))
+ (string-match (concat "^" (regexp-quote ptd)) ftn)))
+ (if (not shortans)
+ (setq shortans (car all))
+ ;; We already have a short answer, so see if pd (the match we found)
+ ;; is longer. If it is longer, then it is more precise.
+ (when (< (length (expand-file-name (oref shortans :directory)))
+ (length pd))
+ (setq shortans (car all))))
+ )))
(setq all (cdr all)))
- ans))
+ ;; If we have an exact answer, use that, otherwise use
+ ;; the short answer we found -> ie - we are in a subproject.
+ (or ans shortans)))
+
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
+ dir)
+ "Find a subproject of PROJ that corresponds to DIR."
+ (if ede--disable-inode
+ (let ((ans nil)
+ (fulldir (file-truename dir)))
+ ;; Try to find the right project w/out inodes.
+ (ede-map-subprojects
+ proj
+ (lambda (SP)
+ (when (not ans)
+ (if (string= fulldir (file-truename (oref SP :directory)))
+ (setq ans SP)
+ (ede-find-subproject-for-directory SP dir)))))
+ ans)
+ ;; We can use inodes, so let's try it.
+ (let ((ans nil)
+ (inode (ede--inode-for-dir dir)))
+ (ede-map-subprojects
+ proj
+ (lambda (SP)
+ (when (not ans)
+ (if (equal (ede--project-inode SP) inode)
+ (setq ans SP)
+ (setq ans (ede-find-subproject-for-directory SP dir))))))
+ ans)))
-;;; DIRECTORY-PROJECT-P
+;;; DIRECTORY HASH
;;
-;; For a fresh buffer, or for a path w/ no open buffer, use this
-;; routine to determine if there is a known project type here.
+;; The directory hash matches expanded directory names to already detected
+;; projects. By hashing projects to directories, we can detect projects in
+;; places we have been before much more quickly.
+
(defvar ede-project-directory-hash (make-hash-table
;; Note on test. Can we compare inodes or something?
:test 'equal)
@@ -237,7 +271,7 @@ Do this only when developing new projects that are incorrectly putting
"Reset the directory hash for DIR.
Do this whenever a new project is created, as opposed to loaded."
;; TODO - Use maphash, and delete by regexp, not by dir searching!
-
+ (setq dir (expand-file-name dir))
(when (fboundp 'remhash)
(remhash (file-name-as-directory dir) ede-project-directory-hash)
;; Look for all subdirs of D, and remove them.
@@ -248,102 +282,99 @@ Do this whenever a new project is created, as opposed to loaded."
ede-project-directory-hash))
))
-(defun ede-directory-project-from-hash (dir)
+(defun ede--directory-project-from-hash (dir)
"If there is an already loaded project for DIR, return it from the hash."
(when (fboundp 'gethash)
+ (setq dir (expand-file-name dir))
(gethash dir ede-project-directory-hash nil)))
-(defun ede-directory-project-add-description-to-hash (dir desc)
+(defun ede--directory-project-add-description-to-hash (dir desc)
"Add to the EDE project hash DIR associated with DESC."
(when (fboundp 'puthash)
+ (setq dir (expand-file-name dir))
(puthash dir desc ede-project-directory-hash)
desc))
+;;; DIRECTORY-PROJECT-P, -CONS
+;;
+;; These routines are useful for detecting if a project exists
+;; in a provided directory.
+;;
+;; Note that -P provides less information than -CONS, so use -CONS
+;; instead so that -P can be obsoleted.
(defun ede-directory-project-p (dir &optional force)
- "Return a project description object if DIR has a project.
+ "Return a project description object if DIR is in a project.
Optional argument FORCE means to ignore a hash-hit of 'nomatch.
This depends on an up to date `ede-project-class-files' variable.
Any directory that contains the file .ede-ignore will always
-return nil."
+return nil.
+
+Consider using `ede-directory-project-cons' instead if the next
+question you want to ask is where the root of found project is."
+ ;; @TODO - We used to have a full impl here, but moved it all
+ ;; to ede-directory-project-cons, and now hash contains only
+ ;; the results of detection which includes the root dir.
+ ;; Perhaps we can eventually remove this fcn?
+ (let ((detect (ede-directory-project-cons dir force)))
+ (cdr detect)))
+
+(defun ede-directory-project-cons (dir &optional force)
+ "Return a project CONS (ROOTDIR . AUTOLOAD) for DIR.
+If there is no project in DIR, return nil.
+Optional FORCE means to ignore the hash of known directories."
(when (not (file-exists-p (expand-file-name ".ede-ignore" dir)))
(let* ((dirtest (expand-file-name dir))
- (match (ede-directory-project-from-hash dirtest)))
+ (match (ede--directory-project-from-hash dirtest)))
(cond
((and (eq match 'nomatch) (not force))
nil)
((and match (not (eq match 'nomatch)))
match)
(t
- (let ((types ede-project-class-files)
- (ret nil))
- ;; Loop over all types, loading in the first type that we find.
- (while (and types (not ret))
- (if (ede-dir-to-projectfile (car types) dirtest)
- (progn
- ;; We found one! Require it now since we will need it.
- (require (oref (car types) file))
- (setq ret (car types))))
- (setq types (cdr types)))
- (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch))
- ret))))))
+ ;; First time here? Use the detection code to identify if we have
+ ;; a project here.
+ (let* ((detect (ede-detect-directory-for-project dirtest))
+ (autoloader (cdr detect))) ;; autoloader
+ (when autoloader (require (oref autoloader file)))
+ (ede--directory-project-add-description-to-hash dirtest (or detect 'nomatch))
+ detect)
+ )))))
+
;;; TOPLEVEL
;;
;; These utilities will identify the "toplevel" of a project.
;;
-(defun ede-toplevel-project-or-nil (dir)
- "Starting with DIR, find the toplevel project directory, or return nil.
-nil is returned if the current directory is not a part of a project."
- (let* ((ans (ede-directory-get-toplevel-open-project dir)))
- (if ans
- (oref ans :directory)
- (if (ede-directory-project-p dir)
- (ede-toplevel-project dir)
- nil))))
+;; NOTE: These two -toplevel- functions return a directory even though
+;; the function name implies a project.
(defun ede-toplevel-project (dir)
- "Starting with DIR, find the toplevel project directory."
- (if (and (string= dir default-directory)
+ "Starting with DIR, find the toplevel project directory.
+If DIR is not part of a project, return nil."
+ (let ((ans nil))
+
+ (cond
+ ;; Check if it is cached in the current buffer.
+ ((and (string= dir default-directory)
ede-object-root-project)
;; Try the local buffer cache first.
- (oref ede-object-root-project :directory)
- ;; Otherwise do it the hard way.
- (let* ((thisdir (ede-directory-project-p dir))
- (ans (ede-directory-get-toplevel-open-project dir)))
- (if (and ans ;; We have an answer
- (or (not thisdir) ;; this dir isn't setup
- (and (object-of-class-p ;; Same as class for this dir?
- ans (oref thisdir :class-sym)))
- ))
- (oref ans :directory)
- (let* ((toppath (expand-file-name dir))
- (newpath toppath)
- (proj (ede-directory-project-p dir))
- (ans nil))
- (if proj
- ;; If we already have a project, ask it what the root is.
- (setq ans (ede-project-root-directory proj)))
-
- ;; If PROJ didn't know, or there is no PROJ, then
-
- ;; Loop up to the topmost project, and then load that single
- ;; project, and its sub projects. When we are done, identify the
- ;; sub-project object belonging to file.
- (while (and (not ans) newpath proj)
- (setq toppath newpath
- newpath (ede-up-directory toppath))
- (when newpath
- (setq proj (ede-directory-project-p newpath)))
-
- (when proj
- ;; We can home someone in the middle knows too.
- (setq ans (ede-project-root-directory proj)))
- )
- (or ans toppath))))))
+ (oref ede-object-root-project :directory))
+
+ ;; See if there is an existing project in DIR.
+ ((setq ans (ede-directory-get-toplevel-open-project dir))
+ (oref ans :directory))
+
+ ;; Detect using our file system detector.
+ ((setq ans (ede-detect-directory-for-project dir))
+ (car ans))
+
+ (t nil))))
+
+(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project)
;;; DIRECTORY CONVERSION STUFF
;;
-(defmethod ede-convert-path ((this ede-project) path)
+(cl-defmethod ede-convert-path ((this ede-project) path)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to."
@@ -357,7 +388,7 @@ Argument THIS is the project to convert PATH to."
(substring fptf (match-end 0))
(error "Cannot convert relativize path %s" fp))))))
-(defmethod ede-convert-path ((this ede-target) path &optional project)
+(cl-defmethod ede-convert-path ((this ede-target) path &optional project)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to.
@@ -388,7 +419,7 @@ Get it from the toplevel project. If it doesn't have one, make one."
(oref top locate-obj)
)))
-(defmethod ede-expand-filename ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
@@ -445,7 +476,7 @@ is returned."
ans))
-(defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
@@ -465,7 +496,7 @@ doesn't exist."
;; Return it
found))
-(defmethod ede-expand-filename-local ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-local ((this ede-project) filename)
"Expand filename locally to project THIS with filesystem tests."
(let ((path (ede-project-root-directory this)))
(cond ((file-exists-p (expand-file-name filename path))
@@ -473,7 +504,7 @@ doesn't exist."
((file-exists-p (expand-file-name (concat "include/" filename) path))
(expand-file-name (concat "include/" filename) path)))))
-(defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project."
@@ -489,7 +520,7 @@ by this project."
;; Return it
found))
-(defmethod ede-expand-filename ((this ede-target) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-target) filename &optional force)
"Return a fully qualified file name based on target THIS.
FILENAME should be a filename which occurs in a directory in which THIS works.
Optional argument FORCE forces the default filename to be provided even if it
@@ -509,25 +540,6 @@ 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)
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index fedf0ffc7c6..d3be545a158 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -1,6 +1,6 @@
;;; ede/generic.el --- Base Support for generic build systems
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -74,65 +74,22 @@
;; The ede-generic-target-c-cpp has some example methods setting up
;; the pre-processor map and system include path.
;;
-;; NOTE: It is not necessary to modify ede-generic.el to add any of
+;; NOTE: It is not necessary to modify ede/generic.el to add any of
;; the above described support features.
(require 'eieio-opt)
-(require 'ede)
+(require 'ede/config)
(require 'ede/shell)
(require 'semantic/db)
;;; Code:
;;
;; Start with the configuration system
-(defclass ede-generic-config (eieio-persistent)
- ((extension :initform ".ede")
- (file-header-line :initform ";; EDE Generic Project Configuration")
- (project :initform nil
- :documentation
- "The project this config is bound to.")
- ;; Generic customizations
- (build-command :initarg :build-command
- :initform "make -k"
- :type string
- :custom string
- :group (default build)
- :documentation
- "Command used for building this project.")
- (debug-command :initarg :debug-command
- :initform "gdb "
- :type string
- :custom string
- :group (default build)
- :documentation
- "Command used for debugging this project.")
- (run-command :initarg :run-command
- :initform nil
- :type (or null string)
- :custom string
- :group (default build)
- :documentation
- "Command used to run something related to this project.")
- ;; C target customizations
- (c-include-path :initarg :c-include-path
- :initform nil
- :type list
- :custom (repeat (string :tag "Path"))
- :group c
- :documentation
- "The include path used by C/C++ projects.")
- (c-preprocessor-table :initarg :c-preprocessor-table
- :initform nil
- :type list
- :custom (repeat (cons (string :tag "Macro")
- (string :tag "Value")))
- :group c
- :documentation
- "Preprocessor Symbols for this project.")
- (c-preprocessor-files :initarg :c-preprocessor-files
- :initform nil
- :type list
- :custom (repeat (string :tag "Include File")))
+(defclass ede-generic-config (ede-extra-config
+ ede-extra-config-build
+ ede-extra-config-program
+ ede-extra-config-c)
+ ((file-header-line :initform ";; EDE Generic Project Configuration")
)
"User Configuration object for a generic project.")
@@ -142,23 +99,24 @@ 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."
;; Doesn't already exist, so let's make one.
- (let* ((alobj ede-constructing)
- (this nil))
+ (let* ((alobj ede-constructing))
(when (not alobj) (error "Cannot load generic project without the autoload instance"))
-
- (setq this
- (funcall (oref alobj class-sym)
- (symbol-name (oref alobj class-sym))
- :name (file-name-nondirectory
- (directory-file-name dir))
- :version "1.0"
- :directory (file-name-as-directory dir)
- :file (expand-file-name (oref alobj :proj-file)) ))
- (ede-add-project-to-global-list this)
+ ;;;
+ ;; TODO - find the root dir.
+ (let ((rootdir dir))
+ (funcall (oref alobj class-sym)
+ (symbol-name (oref alobj class-sym))
+ :name (file-name-nondirectory (directory-file-name dir))
+ :version "1.0"
+ :directory (file-name-as-directory rootdir)
+ :file (expand-file-name (oref alobj proj-file)
+ rootdir)))
))
;;; Base Classes for the system
-(defclass ede-generic-target (ede-target)
+(defclass ede-generic-target (ede-target-with-config
+ ede-target-with-config-build
+ ede-target-with-config-program)
((shortname :initform ""
:type string
:allocation :class
@@ -174,59 +132,42 @@ subclasses of this base target will override the default value.")
"Baseclass for all targets belonging to the generic ede system."
:abstract t)
-(defclass ede-generic-project (ede-project)
- ((buildfile :initform ""
+(defclass ede-generic-project (ede-project-with-config
+ ede-project-with-config-build
+ ede-project-with-config-program
+ ede-project-with-config-c
+ ede-project-with-config-java)
+ ((config-class :initform ede-generic-config)
+ (config-file-basename :initform "EDEConfig.el")
+ (buildfile :initform ""
:type string
:allocation :class
:documentation "The file name that identifies a project of this type.
The class allocated value is replace by different sub classes.")
- (config :initform nil
- :type (or null ede-generic-config)
- :documentation
- "The configuration object for this project.")
)
"The baseclass for all generic EDE project types."
:abstract t)
-(defmethod initialize-instance ((this ede-generic-project)
+(cl-defmethod initialize-instance ((this ede-generic-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil))
)
-(defmethod ede-generic-get-configuration ((proj ede-generic-project))
- "Return the configuration for the project PROJ."
- (let ((config (oref proj config)))
- (when (not config)
- (let ((fname (expand-file-name "EDEConfig.el"
- (oref proj :directory))))
- (if (file-exists-p fname)
- ;; Load in the configuration
- (setq config (eieio-persistent-read fname 'ede-generic-config))
- ;; Create a new one.
- (setq config (ede-generic-config
- "Configuration"
- :file fname))
- ;; Set initial values based on project.
- (ede-generic-setup-configuration proj config))
- ;; Link things together.
- (oset proj config config)
- (oset config project proj)))
- config))
-
-(defmethod ede-generic-setup-configuration ((proj ede-generic-project) config)
- "Default configuration setup method."
- nil)
-
-(defmethod ede-commit-project ((proj ede-generic-project))
- "Commit any change to PROJ to its file."
- (let ((config (ede-generic-get-configuration proj)))
- (ede-commit config)))
+(cl-defmethod ede-project-root ((this ede-generic-project))
+ "Return my root."
+ this)
+
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
+ dir)
+ "Return PROJ, for handling all subdirs below DIR."
+ proj)
;;; A list of different targets
-(defclass ede-generic-target-c-cpp (ede-generic-target)
+(defclass ede-generic-target-c-cpp (ede-generic-target
+ ede-target-with-config-c)
((shortname :initform "C/C++")
(extension :initform "\\([ch]\\(pp\\|xx\\|\\+\\+\\)?\\|cc\\|hh\\|CC?\\)"))
"EDE Generic Project target for C and C++ code.
@@ -250,6 +191,13 @@ All directories need at least one target.")
"EDE Generic Project target for texinfo code.
All directories need at least one target.")
+(defclass ede-generic-target-java (ede-generic-target
+ ede-target-with-config-java)
+ ((shortname :initform "Java")
+ (extension :initform "java"))
+ "EDE Generic Project target for texinfo code.
+All directories need at least one target.")
+
;; MISC must always be last since it will always match the file.
(defclass ede-generic-target-misc (ede-generic-target)
((shortname :initform "Misc")
@@ -263,12 +211,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-generic-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-generic-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -282,9 +230,9 @@ If one doesn't exist, create a new one for this directory."
(when ext
(dolist (C classes)
(let* ((classsym (intern (car C)))
- (extreg (oref classsym extension)))
+ (extreg (oref-default classsym extension)))
(when (and (not (string= extreg ""))
- (string-match (concat "^" extreg "$") ext))
+ (string-match (concat "\\`\\(?:" extreg "\\)\\'") ext))
(setq cls classsym)))))
(when (not cls) (setq cls 'ede-generic-target-misc))
;; find a pre-existing matching target
@@ -293,136 +241,41 @@ If one doesn't exist, create a new one for this directory."
(when (not ans)
(setq ans (make-instance
cls
- :name (oref cls shortname)
+ :name (oref-default cls shortname)
:path dir
:source nil))
(object-add-to-list proj :targets ans)
)
ans))
-;;; C/C++ support
-(defmethod ede-preprocessor-map ((this ede-generic-target-c-cpp))
- "Get the pre-processor map for some generic C code."
- (let* ((proj (ede-target-parent this))
- (root (ede-project-root proj))
- (config (ede-generic-get-configuration proj))
- filemap
- )
- ;; Preprocessor files
- (dolist (G (oref config :c-preprocessor-files))
- (let ((table (semanticdb-file-table-object
- (ede-expand-filename root G))))
- (when table
- (when (semanticdb-needs-refresh-p table)
- (semanticdb-refresh-table table))
- (setq filemap (append filemap (oref table lexical-table)))
- )))
- ;; The core table
- (setq filemap (append filemap (oref config :c-preprocessor-table)))
-
- filemap
- ))
-
-(defmethod ede-system-include-path ((this ede-generic-target-c-cpp))
- "Get the system include path used by project THIS."
- (let* ((proj (ede-target-parent this))
- (config (ede-generic-get-configuration proj)))
- (oref config c-include-path)))
-
-;;; Commands
-;;
-(defmethod project-compile-project ((proj ede-generic-project) &optional command)
- "Compile the entire current project PROJ.
-Argument COMMAND is the command to use when compiling."
- (let* ((config (ede-generic-get-configuration proj))
- (comp (oref config :build-command)))
- (compile comp)))
-
-(defmethod project-compile-target ((obj ede-generic-target) &optional command)
- "Compile the current target OBJ.
-Argument COMMAND is the command to use for compiling the target."
- (project-compile-project (ede-current-project) command))
-
-(defmethod project-debug-target ((target ede-generic-target))
- "Run the current project derived from TARGET in a debugger."
- (let* ((proj (ede-target-parent target))
- (config (ede-generic-get-configuration proj))
- (debug (oref config :debug-command))
- (cmd (read-from-minibuffer
- "Debug Command: "
- debug))
- (cmdsplit (split-string cmd " " t))
- ;; @TODO - this depends on the user always typing in something good
- ;; like "gdb" or "dbx" which also exists as a useful Emacs command.
- ;; Is there a better way?
- (cmdsym (intern-soft (car cmdsplit))))
- (call-interactively cmdsym t)))
-
-(defmethod project-run-target ((target ede-generic-target))
- "Run the current project derived from TARGET."
- (require 'ede-shell)
- (let* ((proj (ede-target-parent target))
- (config (ede-generic-get-configuration proj))
- (run (concat "./" (oref config :run-command)))
- (cmd (read-from-minibuffer "Run (like this): " run)))
- (ede-shell-run-something target cmd)))
-
-;;; Customization
-;;
-(defmethod ede-customize ((proj ede-generic-project))
- "Customize the EDE project PROJ."
- (let ((config (ede-generic-get-configuration proj)))
- (eieio-customize-object config)))
-
-(defmethod ede-customize ((target ede-generic-target))
- "Customize the EDE TARGET."
- ;; Nothing unique for the targets, use the project.
- (ede-customize-project))
-
-(defmethod eieio-done-customizing ((config ede-generic-config))
- "Called when EIEIO is done customizing the configuration object.
-We need to go back through the old buffers, and update them with
-the new configuration."
- (ede-commit config)
- ;; Loop over all the open buffers, and re-apply.
- (ede-map-targets
- (oref config project)
- (lambda (target)
- (ede-map-target-buffers
- target
- (lambda (b)
- (with-current-buffer b
- (ede-apply-target-options)))))))
-
-(defmethod ede-commit ((config ede-generic-config))
- "Commit all changes to the configuration to disk."
- (eieio-persistent-save config))
-
;;; Creating Derived Projects:
;;
;; Derived projects need an autoloader so that EDE can find the
;; different projects on disk.
-(defun ede-generic-new-autoloader (internal-name external-name
- projectfile class)
+(defun ede-generic-new-autoloader (_internal-name external-name
+ projectfile class)
"Add a new EDE Autoload instance for identifying a generic project.
-INTERNAL-NAME is a long name that identifies this project type.
-EXTERNAL-NAME is a shorter human readable name to describe the project.
+INTERNAL-NAME is obsolete and ignored.
+EXTERNAL-NAME is a human readable name to describe the project; it
+must be unique among all autoloaded projects.
PROJECTFILE is a file name that identifies a project of this type to EDE, such as
a Makefile, or SConstruct file.
CLASS is the EIEIO class that is used to track this project. It should subclass
-the class `ede-generic-project' project."
+`ede-generic-project'."
(ede-add-project-autoload
- (ede-project-autoload internal-name
- :name external-name
+ (ede-project-autoload :name external-name
:file 'ede/generic
:proj-file projectfile
+ :root-only nil
:load-type 'ede-generic-load
:class-sym class
:new-p nil
- :safe-p nil) ; @todo - could be
- ; safe if we do something
- ; about the loading of the
- ; generic config file.
+ ;; NOTE: This project type is SAFE because it handles
+ ;; the user-query before loading its config file. These
+ ;; project types are useful without the config file so
+ ;; do the safe part until the user creates a saved config
+ ;; file for it.
+ :safe-p t)
;; Generics must go at the end, since more specific types
;; can create Makefiles also.
'generic))
@@ -431,12 +284,33 @@ the class `ede-generic-project' project."
(defun ede-enable-generic-projects ()
"Enable generic project loaders."
(interactive)
- (ede-generic-new-autoloader "generic-makefile" "Make"
+ (ede-generic-new-autoloader "generic-makefile" "Generic Make"
"Makefile" 'ede-generic-makefile-project)
- (ede-generic-new-autoloader "generic-scons" "SCons"
+ (ede-generic-new-autoloader "generic-scons" "Generic SCons"
"SConstruct" 'ede-generic-scons-project)
- (ede-generic-new-autoloader "generic-cmake" "CMake"
+ (ede-generic-new-autoloader "generic-cmake" "Generic CMake"
"CMakeLists" 'ede-generic-cmake-project)
+
+ ;; Super Generic found via revision control tags.
+ (ede-generic-new-autoloader "generic-git" "Generic Git"
+ ".git" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-bzr" "Generic Bazaar"
+ ".bzr" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-hg" "Generic Mercurial"
+ ".hg" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-svn" "Generic Subversions"
+ ".svn" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-cvs" "Generic CVS"
+ "CVS" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-mtn" "Generic Monotone"
+ "_MTN" 'ede-generic-vc-project)
+
+ ;; Take advantage of existing 'projectile' based projects.
+ ;; @TODO - if projectile supports compile commands etc, can we
+ ;; read that out? Howto if projectile is not part of core emacs.
+ (ede-generic-new-autoloader "generic-projectile" "Generic .projectile"
+ ".projectile" 'ede-generic-vc-project)
+
)
@@ -450,7 +324,7 @@ the class `ede-generic-project' project."
)
"Generic Project for makefiles.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
"Setup a configuration for Make."
(oset config build-command "make -k")
(oset config debug-command "gdb ")
@@ -463,7 +337,7 @@ the class `ede-generic-project' project."
)
"Generic Project for scons.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
"Setup a configuration for SCONS."
(oset config build-command "scons")
(oset config debug-command "gdb ")
@@ -476,12 +350,21 @@ the class `ede-generic-project' project."
)
"Generic Project for cmake.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
"Setup a configuration for CMake."
(oset config build-command "cmake")
(oset config debug-command "gdb ")
)
+;;; Generic Version Control System
+(defclass ede-generic-vc-project (ede-generic-project)
+ ()
+ "Generic project found via Version Control files.")
+
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
+ "Setup a configuration for projects identified by revision control."
+ )
+
(provide 'ede/generic)
;; Local variables:
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 728d27e4460..edfa3640bd4 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -1,6 +1,6 @@
;;; ede/linux.el --- Special project for Linux
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -32,6 +32,8 @@
;; * Add texinfo lookup options.
;; * Add website
+(eval-when-compile (require 'cl))
+
(require 'ede)
(require 'ede/make)
@@ -46,6 +48,21 @@
:group 'ede
:version "24.3")
+(defcustom project-linux-build-directory-default 'ask
+ "Build directory."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (const :tag "Same as source directory" same)
+ (const :tag "Ask the user" ask)))
+
+(defcustom project-linux-architecture-default 'ask
+ "Target architecture to assume when not auto-detected."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (string :tag "Architecture name")
+ (const :tag "Ask the user" ask)))
+
+
(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
"*Default command used to compile a target."
:group 'project-linux
@@ -56,37 +73,6 @@
:group 'project-linux
:type 'string)
-(defvar ede-linux-project-list nil
- "List of projects created by option `ede-linux-project'.")
-
-(defun ede-linux-file-existing (dir)
- "Find a Linux project in the list of Linux projects.
-DIR is the directory to search from."
- (let ((projs ede-linux-project-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))
-
-;;;###autoload
-(defun ede-linux-project-root (&optional dir)
- "Get the root directory for DIR."
- (when (not dir) (setq dir default-directory))
- (let ((case-fold-search t)
- (proj (ede-linux-file-existing dir)))
- (if proj
- (ede-up-directory (file-name-directory
- (oref proj :file)))
- ;; No pre-existing project. Let's take a wild-guess if we have
- ;; an Linux project here.
- (when (string-match "linux[^/]*" dir)
- (let ((base (substring dir 0 (match-end 0))))
- (when (file-exists-p (expand-file-name "scripts/ver_linux" base))
- base))))))
-
(defun ede-linux-version (dir)
"Find the Linux version for the Linux src in DIR."
(let ((buff (get-buffer-create " *linux-query*")))
@@ -107,42 +93,131 @@ DIR is the directory to search from."
(kill-buffer buff)
)))))
-(defclass ede-linux-project (ede-project eieio-instance-tracker)
- ((tracking-symbol :initform 'ede-linux-project-list)
- )
+(defclass ede-linux-project (ede-project)
+ ((build-directory :initarg :build-directory
+ :type string
+ :documentation "Build directory.")
+ (architecture :initarg :architecture
+ :type string
+ :documentation "Target architecture.")
+ (include-path :initarg :include-path
+ :type list
+ :documentation "Include directories.
+Contains both common and target architecture-specific directories."))
"Project Type for the Linux source code."
:method-invocation-order :depth-first)
+
+(defun ede-linux--get-build-directory (dir)
+ "Detect build directory for sources in DIR.
+If DIR has not been used as a build directory, fall back to
+`project-linux-build-directory-default'."
+ (or
+ ;; detected build on source directory
+ (and (file-exists-p (expand-file-name ".config" dir)) dir)
+ ;; use configuration
+ (case project-linux-build-directory-default
+ (same dir)
+ (ask (read-directory-name "Select Linux' build directory: " dir)))))
+
+
+(defun ede-linux--get-archs (dir)
+ "Returns a list of architecture names found in DIR."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ archs)
+ (when (file-directory-p archs-dir)
+ (mapc (lambda (elem)
+ (when (and
+ (not (string= elem "."))
+ (not (string= elem ".."))
+ (not (string= elem "x86_64")) ; has no separate sources
+ (file-directory-p
+ (expand-file-name elem archs-dir)))
+ (add-to-list 'archs elem t)))
+ (directory-files archs-dir)))
+ archs))
+
+
+(defun ede-linux--detect-architecture (dir)
+ "Try to auto-detect the architecture as configured in DIR.
+DIR is Linux' build directory. If it cannot be auto-detected,
+returns `project-linux-architecture-default'."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ (archs (ede-linux--get-archs dir))
+ arch found)
+ (or (and
+ archs
+ ;; Look for /arch/<arch>/include/generated
+ (progn
+ (while (and archs (not found))
+ (setq arch (car archs))
+ (when (file-directory-p
+ (expand-file-name (concat arch "/include/generated")
+ archs-dir))
+ (setq found arch))
+ (setq archs (cdr archs)))
+ found))
+ project-linux-architecture-default)))
+
+(defun ede-linux--get-architecture (dir bdir)
+ "Try to auto-detect the architecture as configured in BDIR.
+Uses `ede-linux--detect-architecture' for the auto-detection. If
+the result is `ask', let the user choose from architectures found
+in DIR."
+ (let ((arch (ede-linux--detect-architecture bdir)))
+ (case arch
+ (ask
+ (completing-read "Select target architecture: "
+ (ede-linux--get-archs dir)))
+ (t arch))))
+
+
+(defun ede-linux--include-path (dir bdir arch)
+ "Returns a list with include directories.
+Returned directories might not exist, since they are not created
+until Linux is built for the first time."
+ (map 'list
+ (lambda (elem) (format (concat (car elem) "/" (cdr elem)) arch))
+ ;; XXX: taken from the output of "make V=1"
+ (list (cons dir "arch/%s/include")
+ (cons bdir "arch/%s/include/generated")
+ (cons dir "include")
+ (cons bdir "include")
+ (cons dir "arch/%s/include/uapi")
+ (cons bdir "arch/%s/include/generated/uapi")
+ (cons dir "include/uapi")
+ (cons bdir "include/generated/uapi"))))
+
;;;###autoload
-(defun ede-linux-load (dir &optional rootproj)
+(defun ede-linux-load (dir &optional _rootproj)
"Return an Linux Project object if there is a match.
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-linux-file-existing dir)
- ;; Doesn't already exist, so let's make one.
- (let ((proj (ede-linux-project
- "Linux"
- :name "Linux"
- :version (ede-linux-version dir)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "scripts/ver_linux"
- dir))))
- (ede-add-project-to-global-list proj))
- ))
+ ;; Doesn't already exist, so let's make one.
+ (let* ((bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (include-path (ede-linux--include-path dir bdir arch)))
+ (make-instance 'ede-linux-project
+ :name "Linux"
+ :version (ede-linux-version dir)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "scripts/ver_linux"
+ dir)
+ :build-directory bdir
+ :architecture arch
+ :include-path include-path)))
;;;###autoload
(ede-add-project-autoload
- (ede-project-autoload "linux"
- :name "LINUX ROOT"
- :file 'ede/linux
- :proj-file "scripts/ver_linux"
- :proj-root-dirmatch "linux[^/]*"
- :proj-root 'ede-linux-project-root
- :load-type 'ede-linux-load
- :class-sym 'ede-linux-project
- :new-p nil
- :safe-p t)
+ (make-instance 'ede-project-autoload
+ :name "LINUX ROOT"
+ :file 'ede/linux
+ :proj-file "scripts/ver_linux"
+ :load-type 'ede-linux-load
+ :class-sym 'ede-linux-project
+ :new-p nil
+ :safe-p t)
'unique)
(defclass ede-linux-target-c (ede-target)
@@ -155,26 +230,26 @@ All directories need at least one target.")
"EDE Linux Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-linux-project)
- &rest fields)
+(cl-defmethod initialize-instance ((this ede-linux-project)
+ &rest _fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-linux-project)
- &optional file)
+(cl-defmethod ede-project-root-directory ((this ede-linux-project)
+ &optional _file)
"Return the root for THIS Linux project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-linux-project))
+(cl-defmethod ede-project-root ((this ede-linux-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
- dir)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -185,12 +260,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-linux-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-linux-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -216,7 +291,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-linux-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-linux-target-c))
"Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
@@ -241,25 +316,32 @@ All files need the macros from lisp.h!"
(let ((F (expand-file-name name (expand-file-name subdir root))))
(when (file-exists-p F) F)))
-(defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name))
- (root (ede-project-root proj))
- (dir (ede-project-root-directory root))
- (F (cond
- ((not ext) nil)
- ((string-match "h" ext)
- (or (ede-linux-file-exists-name name dir "")
- (ede-linux-file-exists-name name dir "include"))
- )
- ((string-match "txt" ext)
- (ede-linux-file-exists-name name dir "Documentation"))
- (t nil)))
- )
- (or F (call-next-method))))
-
-(defmethod project-compile-project ((proj ede-linux-project)
+ (root (ede-project-root proj))
+ (dir (ede-project-root-directory root))
+ (bdir (oref proj build-directory))
+ (F (cond
+ ((not ext) nil)
+ ((string-match "h" ext)
+ (let ((dirs (oref proj include-path))
+ found)
+ (while (and dirs (not found))
+ (setq found
+ (or (ede-linux-file-exists-name name bdir (car dirs))
+ (ede-linux-file-exists-name name dir (car dirs))))
+ (setq dirs (cdr dirs)))
+ found))
+ ((string-match "txt" ext)
+ (ede-linux-file-exists-name name dir "Documentation"))
+ (t nil))))
+ (or F (cl-call-next-method))))
+
+;;; Command Support
+;;
+(cl-defmethod project-compile-project ((proj ede-linux-project)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -276,7 +358,7 @@ Argument COMMAND is the command to use when compiling."
(compile command)))
-(defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
+(cl-defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(let* ((proj (ede-target-parent obj))
@@ -295,6 +377,19 @@ Argument COMMAND is the command to use for compiling the target."
(compile command)))
+(cl-defmethod project-rescan ((this ede-linux-project))
+ "Rescan this Linux project from the sources."
+ (let* ((dir (ede-project-root-directory this))
+ (bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (inc (ede-linux--include-path dir bdir arch))
+ (ver (ede-linux-version dir)))
+ (oset this version ver)
+ (oset this :build-directory bdir)
+ (oset this :architecture arch)
+ (oset this :include-path inc)
+ ))
+
(provide 'ede/linux)
;; Local variables:
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index d8b29d3f0be..a076c46513c 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -1,6 +1,6 @@
;;; ede/locate.el --- Locate support
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -110,34 +110,34 @@ based on `ede-locate-setup-options'."
)
"Baseclass for LOCATE feature in EDE.")
-(defmethod initialize-instance ((loc ede-locate-base) &rest fields)
+(cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
"Make sure we have a hash table."
;; Basic setup.
- (call-next-method)
+ (cl-call-next-method)
;; Make sure we have a hash table.
(ede-locate-flush-hash loc)
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-base)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
root)
"Is it ok to use this project type under ROOT."
t)
-(defmethod ede-locate-flush-hash ((loc ede-locate-base))
+(cl-defmethod ede-locate-flush-hash ((loc ede-locate-base))
"For LOC, flush hashtable and start from scratch."
(oset loc hash (make-hash-table :test 'equal)))
-(defmethod ede-locate-file-in-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base)
filestring)
"For LOC, is the file FILESTRING in our hashtable?"
(gethash filestring (oref loc hash)))
-(defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
filestring fullfilename)
"For LOC, add FILESTR to the hash with FULLFILENAME."
(puthash filestring fullfilename (oref loc hash)))
-(defmethod ede-locate-file-in-project ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
@@ -149,7 +149,7 @@ that created this EDE locate object."
(oset loc lastanswer ans)
ans))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
@@ -158,8 +158,8 @@ that created this EDE locate object."
nil
)
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-base) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-base)) root)
"Create or update the database for the current project.
You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S"
@@ -177,13 +177,13 @@ You cannot create projects for the baseclass."
Configure the Emacs `locate-program' variable to also
configure the use of EDE locate.")
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-locate)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
root)
"Is it ok to use this project type under ROOT."
(or (featurep 'locate) (locate-library "locate"))
)
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -220,12 +220,12 @@ that created this EDE locate object."
Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.")
-(defmethod initialize-instance ((loc ede-locate-global)
+(cl-defmethod initialize-instance ((loc ede-locate-global)
&rest slots)
"Make sure that we can use GNU Global."
(require 'cedet-global)
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(cedet-gnu-global-version-check)
(let* ((default-directory (oref loc root))
@@ -235,7 +235,7 @@ variable `cedet-global-command'.")
(oref loc root))))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-global)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-global)
@@ -244,7 +244,7 @@ variable `cedet-global-command'.")
(newroot (cedet-gnu-global-root)))
newroot))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -253,8 +253,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root)))
(cedet-gnu-global-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-global) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root))
@@ -272,11 +272,11 @@ that created this EDE locate object."
Configure EDE's use of IDUtils through the cedet-idutils.el
file name searching variable `cedet-idutils-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-idutils)
+(cl-defmethod initialize-instance ((loc ede-locate-idutils)
&rest slots)
"Make sure that we can use IDUtils."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-idutils)
(cedet-idutils-version-check)
@@ -285,7 +285,7 @@ file name searching variable `cedet-idutils-file-command'.")
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-idutils)
@@ -293,7 +293,7 @@ file name searching variable `cedet-idutils-file-command'.")
(when (cedet-idutils-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -302,8 +302,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root)))
(cedet-idutils-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-idutils) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root))
@@ -321,11 +321,11 @@ that created this EDE locate object."
Configure EDE's use of Cscope through the cedet-cscope.el
file name searching variable `cedet-cscope-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-cscope)
+(cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest slots)
"Make sure that we can use Cscope."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-cscope)
(cedet-cscope-version-check)
@@ -334,7 +334,7 @@ file name searching variable `cedet-cscope-file-command'.")
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-cscope)
@@ -342,7 +342,7 @@ file name searching variable `cedet-cscope-file-command'.")
(when (cedet-cscope-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -351,9 +351,9 @@ that created this EDE locate object."
(require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-cscope) root)
- "Create or update the GNU Global database for the current project."
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-cscope)) root)
+ "Create or update the Cscope database for the current project."
(require 'cedet-cscope)
(cedet-cscope-create/update-database root))
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index dbfdd89e451..6545bb305fa 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,6 +1,6 @@
;;; ede/make.el --- General information about "make"
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index d2425314fc7..e848d45dcb5 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -1,6 +1,6 @@
;;; makefile-edit.el --- Makefile editing/scanning commands.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index a29e3720ea2..664e91da2e9 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -1,6 +1,6 @@
;;; ede/pconf.el --- configure.ac maintenance for EDE
-;;; Copyright (C) 1998-2000, 2005, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -31,16 +31,16 @@
(defvar ede-pconf-create-file-query 'ask
"Controls if queries are made while creating project files.
-A value of 'ask means to always ask the user before creating
-a file, such as AUTHORS. A value of 'never means don't ask, and
+A value of `ask' means to always ask the user before creating
+a file, such as AUTHORS. A value of `never' means don't ask, and
don't do it. A value of nil means to just do it.")
;;; Code:
-(defmethod ede-proj-configure-file ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-file ((this ede-proj-project))
"The configure.ac script used by project THIS."
(ede-expand-filename (ede-toplevel this) "configure.ac" t))
-(defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
+(cl-defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
"For project THIS, test that the file FILE exists, or create it."
(let ((f (ede-expand-filename (ede-toplevel this) file t)))
(when (not (file-exists-p f))
@@ -60,7 +60,7 @@ don't do it. A value of nil means to just do it.")
(error "Quit")))))))
-(defmethod ede-proj-configure-synchronize ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
"Synchronize what we know about project THIS into configure.ac."
(let ((b (find-file-noselect (ede-proj-configure-file this)))
;;(td (file-name-directory (ede-proj-configure-file this)))
@@ -93,14 +93,14 @@ don't do it. A value of nil means to just do it.")
(ede-map-all-subprojects
this
(lambda (sp)
- (ede-map-targets sp 'ede-proj-flush-autoconf)))
+ (ede-map-targets sp #'ede-proj-flush-autoconf)))
(ede-map-all-subprojects
this
(lambda (sp)
- (ede-map-targets this 'ede-proj-tweak-autoconf)))
+ (ede-map-targets this #'ede-proj-tweak-autoconf)))
;; Now save
(save-buffer)
- (setq postcmd "autoreconf -i;")
+ (setq postcmd "autoreconf -f -i;")
;; Verify a bunch of files that are required by automake.
(ede-proj-configure-test-required-file this "AUTHORS")
@@ -149,7 +149,7 @@ don't do it. A value of nil means to just do it.")
))))
-(defmethod ede-proj-configure-recreate ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-recreate ((this ede-proj-project))
"Delete project THIS's configure script and start over."
(if (not (ede-proj-configure-file this))
(error "Could not determine configure.ac for %S" (eieio-object-name this)))
@@ -159,7 +159,7 @@ don't do it. A value of nil means to just do it.")
(if b (kill-buffer b)))
(ede-proj-configure-synchronize this))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
"Tweak the configure file (current buffer) to accommodate THIS."
;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers.
@@ -167,18 +167,21 @@ don't do it. A value of nil means to just do it.")
(mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this))
)
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target))
"Flush the configure file (current buffer) to accommodate THIS.
By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
nil)
-(defmethod ede-proj-configure-add-missing ((this ede-proj-target))
+
+;; @TODO - No-one calls this ???
+(cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
nil)
-(defmethod ede-proj-configure-create-missing ((this ede-proj-target))
+;; @TODO - No-one implements this yet.
+(cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target))
"Add any missing files for THIS by creating them."
nil)
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 0328606b028..b494e27dc31 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,6 +1,6 @@
;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -52,7 +52,7 @@
(declare-function ede-srecode-insert "ede/srecode")
;;; Code:
-(defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS.
MFILENAME is the makefile to generate."
(require 'ede/srecode)
@@ -284,26 +284,26 @@ Change . to _ in the variable name."
(setq name (replace-match "_" nil t name)))
name))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG"))
;;; DEPENDENCY FILE GENERATOR LISTS
;;
-(defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
;;; GENERIC VARIABLES
;;
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
@@ -358,7 +358,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
; ))
)
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
"Insert variables needed by target THIS."
(let ((conf-table (ede-proj-makefile-configuration-variables
this (oref this configuration-default)))
@@ -392,7 +392,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
(insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " "
(file-name-nondirectory (ede-proj-dist-makefile this)) "\n"))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
&optional
moresource)
"Insert the source variables needed by THIS.
@@ -406,7 +406,7 @@ sources variable."
(if moresource
(insert " \\\n " (mapconcat (lambda (a) a) moresource " ") "")))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
@@ -414,18 +414,18 @@ sources variable."
(ede-proj-makefile-insert-source-variables this moresource)
)
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
- (call-next-method)
+ (cl-call-next-method)
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
@@ -449,19 +449,19 @@ sources variable."
(ede-linker-only-once linker
(ede-proj-makefile-insert-variables linker)))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
;;; GARBAGE PATTERNS
;;
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
(let ((mc (ede-map-targets
@@ -476,7 +476,7 @@ These are removed with make clean."
(setq mc (cdr mc)))
(nreverse uniq)))
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
;; Get the source object from THIS, and use the specified garbage.
@@ -490,7 +490,7 @@ These are removed with make clean."
;;; RULES
;;
-(defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
"Insert a rule for the project THIS which should be a subproject."
(insert ".PHONY:" (ede-name this))
(newline)
@@ -501,29 +501,29 @@ These are removed with make clean."
(newline)
)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this inference-rules))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-dist-dependencies this)
)
-(defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
"Insert a SUBDIRS variable for Automake."
(proj-comp-insert-variable-once "SUBDIRS"
(ede-map-subprojects
@@ -531,11 +531,11 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj))
))))
-(defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
-(defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
"Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST."
(let ((junk (ede-proj-makefile-garbage-patterns this))
tmp)
@@ -598,15 +598,16 @@ Argument THIS is the target that should insert stuff."
"\t@echo Makefile is out of date! "
"It needs to be regenerated by EDE.\n"
"\t@echo If you have not modified Project.ede, you can"
- " use 'touch' to update the Makefile time stamp.\n"
+ (format-message
+ " use `touch' to update the Makefile time stamp.\n")
"\t@false\n\n"
"\n\n# End of Makefile\n")))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
"Insert rules needed by THIS target."
nil)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers this)))
@@ -619,7 +620,7 @@ Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-commands this)
)))
-(defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
"Insert the commands needed by target THIS.
For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this))
@@ -627,18 +628,18 @@ For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
"Insert user specified rules needed by THIS target.
This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with
automake."
(mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
"Insert user specified rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules)))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -667,7 +668,7 @@ This allows customization of how these elements appear."
out))))
;; Tags
-(defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
+(cl-defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
"Insert into the current location rules to make recursive TAGS files.
Argument THIS is the project to create tags for.
Argument TARGETS are the targets we should depend on for TAGS."
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 3d708622f05..8aa5477cea5 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,6 +1,6 @@
;;; ede/proj-archive.el --- EDE Generic Project archive support
-;; Copyright (C) 1998-2001, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -43,7 +43,7 @@
:objectextention "")
"Linker object for creating an archive.")
-(defmethod ede-proj-makefile-insert-source-variables :BEFORE
+(cl-defmethod ede-proj-makefile-insert-source-variables :before
((this ede-proj-target-makefile-archive) &optional moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
@@ -52,11 +52,11 @@ Makefile.am generator, so use it to add this important bin program."
(concat "lib" (ede-name this) "_a_LIBRARIES")
(insert (concat "lib" (ede-name this) ".a"))))
-(defmethod ede-proj-makefile-garbage-patterns
+(cl-defmethod ede-proj-makefile-garbage-patterns
((this ede-proj-target-makefile-archive))
"Add archive name to the garbage patterns.
-This makes sure that the archive is removed with 'make clean'."
- (let ((garb (call-next-method)))
+This makes sure that the archive is removed with `make clean'."
+ (let ((garb (cl-call-next-method)))
(append garb (list (concat "lib" (ede-name this) ".a")))))
(provide 'ede/proj-archive)
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index 628416449f5..0e76cda1986 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,6 +1,6 @@
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
-;; Copyright (C) 1998-2000, 2007, 2009-2013 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2007, 2009-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -39,7 +39,7 @@
:sourcepattern "^[A-Z]+$\\|\\.txt$")
"Miscellaneous fields definition.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_AUX"))
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index fa7902e84d1..87eae6cb1c0 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,6 +1,6 @@
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
-;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2013 Free Software
+;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -173,12 +173,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
-(defmethod initialize-instance :AFTER ((this ede-compiler) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
-(defmethod initialize-instance :AFTER ((this ede-linker) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
@@ -218,7 +218,7 @@ This will prevent rules from creating duplicate variables or rules."
(def-edebug-spec ede-pmake-insert-variable-shared (form def-body))
))
-;;; Querys
+;;; Queries
(defun ede-proj-find-compiler (compilers sourcetype)
"Return a compiler from the list COMPILERS that will compile SOURCETYPE."
(while (and compilers
@@ -235,7 +235,7 @@ This will prevent rules from creating duplicate variables or rules."
(car-safe linkers))
;;; Methods:
-(defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
"Tweak the configure file (current buffer) to accommodate THIS."
(mapcar
(lambda (obj)
@@ -247,7 +247,7 @@ This will prevent rules from creating duplicate variables or rules."
)
(oref this autoconf)))
-(defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
@@ -263,7 +263,7 @@ Execute BODY in a location where a value can be placed."
))
(put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
-(defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."
(if (eieio-instance-inheritor-slot-boundp this 'variables)
(with-slots (variables) this
@@ -276,19 +276,19 @@ Execute BODY in a location where a value can be placed."
(insert cd)))))
variables))))
-(defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
+(cl-defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
"Return non-nil if THIS has intermediate object files.
If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
+(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
-(defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
+(cl-defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
targetname sourcefiles)
"Insert an OBJ variable to specify object code to be generated for THIS.
The name of the target is TARGETNAME as a string. SOURCEFILES is the list of
@@ -312,19 +312,19 @@ Not all compilers do this."
sourcefiles)
(insert "\n")))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
"Insert rules needed for THIS compiler object."
(ede-compiler-only-once this
(mapc 'ede-proj-makefile-insert-rules (oref this rules))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object."
(if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\n\n"))
-(defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
"Insert the commands needed to use compiler THIS.
The object creating makefile rules must call this method for the
compiler it decides to use after inserting in the rule."
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index d7720f25681..778d485c44c 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -1,6 +1,6 @@
;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -57,7 +57,7 @@ Each package's directory should also appear in :aux-packages via a package name.
"This target consists of a group of lisp files.
A lisp target may be one general program with many separate lisp files in it.")
-(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
"Insert rules needed by THIS target.
This inserts the PRELOADS target-local variable."
(let ((preloads (oref this pre-load-packages)))
@@ -67,7 +67,7 @@ This inserts the PRELOADS target-local variable."
(mapconcat 'identity preloads " ")))))
(insert "\n"))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -109,7 +109,7 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs with XEmacs.")
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match "\\.elc$" (buffer-file-name buffer))
@@ -121,7 +121,7 @@ Lays claim to all .elc files that match .el files in this target."
;; Is this in our list.
(member fname (oref this auxsource))
)
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;;; Emacs Lisp Compiler
@@ -145,7 +145,7 @@ Lays claim to all .elc files that match .el files in this target."
packages (cdr packages))))
paths))
-(defmethod project-compile-target ((obj ede-proj-target-elisp))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp))
"Compile all sources in a Lisp target OBJ.
Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((proj (ede-target-parent obj))
@@ -173,7 +173,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
@@ -195,12 +195,12 @@ is found, such as a `-version' variable, or the standard header."
(insert version)))))
(setq vs (cdr vs)))
;; The next method will include comments such as "Version:"
- (call-next-method))))
+ (cl-call-next-method))))
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p) '("lisp_LISP" . share))
(t (concat (ede-pmake-varname this) "_LISP"))))
@@ -219,7 +219,7 @@ is found, such as a `-version' variable, or the standard header."
(setq items (cdr items)))))
))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp))
"Insert variables needed by target THIS."
(let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath
@@ -244,9 +244,9 @@ is found, such as a `-version' variable, or the standard header."
)
(error "Don't know how to update load path"))))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
"Tweak the configure file (current buffer) to accommodate THIS."
- (call-next-method)
+ (cl-call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
(enable-local-variables nil))
@@ -255,7 +255,7 @@ is found, such as a `-version' variable, or the standard header."
(save-excursion
(if (file-symlink-p ec)
(progn
- ;; Desymlinkify
+ ;; Change symlinks to copies.
(rename-file ec (concat ec ".tmp"))
(copy-file (concat ec ".tmp") ec)
(delete-file (concat ec ".tmp"))))
@@ -267,9 +267,10 @@ is found, such as a `-version' variable, or the standard header."
(while paths
(ede-proj-elisp-add-path (car paths))
(setq paths (cdr paths))))
- (save-buffer)) )))
+ (save-buffer)
+ (kill-buffer)))))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
"Flush the configure file (current buffer) to accommodate THIS."
;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
@@ -310,14 +311,14 @@ Files do not need to be added to this target.")
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match
(concat (regexp-quote (oref this autoload-file)) "$")
(buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;; Compilers
@@ -337,7 +338,7 @@ Lays claim to all .elc files that match .el files in this target."
)
"Build an autoloads file.")
-(defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler)))
@@ -350,7 +351,7 @@ If the `compiler' slot is empty, get the car of the compilers list."
(setq comp (list (car avail)))))
comp))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
&optional
moresource)
"Insert the source variables needed by THIS.
@@ -358,16 +359,16 @@ Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
nil)
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
"Return the variable name for THIS's sources."
nil) ; "LOADDEFS")
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
"Return a string representing the dependencies for THIS.
Always return an empty string for an autoloads generator."
"")
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp-autoloads))
"Insert variables needed by target THIS."
(ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file)))
@@ -377,7 +378,7 @@ Always return an empty string for an autoloads generator."
" ")))
)
-(defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
"Create or update the autoload target."
(require 'cedet-autogen)
(let ((default-directory (ede-expand-filename obj ".")))
@@ -386,13 +387,13 @@ Always return an empty string for an autoloads generator."
(oref obj autoload-dirs))
))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
nil)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should depend on.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
@@ -401,18 +402,18 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should distribute.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
(insert " " (oref this autoload-file))
)
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
"Tweak the configure file (current buffer) to accommodate THIS."
(error "Autoloads not supported in autoconf yet"))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el
index 10c32040ed4..a5031ae8758 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -1,6 +1,6 @@
;;; ede-proj-info.el --- EDE Generic Project texinfo support
-;;; Copyright (C) 1998-2001, 2004, 2007-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2001, 2004, 2007-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -72,17 +72,17 @@ All other sources should be included independently."))
;;; Makefile generation
;;
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (ede-expand-filename (ede-toplevel) "texinfo.tex")))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_TEXINFOS"))
-(defmethod ede-proj-makefile-insert-source-variables
+(cl-defmethod ede-proj-makefile-insert-source-variables
((this ede-proj-target-makefile-info) &optional moresource)
"Insert the source variables needed by THIS info target.
Optional argument MORESOURCE is a list of additional sources to add to the
@@ -90,7 +90,7 @@ sources variable.
Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode."
(if (not (ede-proj-automake-p))
- (call-next-method)
+ (cl-call-next-method)
(let* ((sv (ede-proj-makefile-sourcevar this))
(src (copy-sequence (oref this source)))
(menu (or (oref this menu) (car src))))
@@ -119,7 +119,7 @@ when working in Automake mode."
(kill-buffer buffer))
info))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
"Return the name of the main target for THIS target."
;; The target should be the main-menu file name translated to .info.
(let* ((source (if (not (string= (oref this mainmenu) ""))
@@ -128,7 +128,7 @@ when working in Automake mode."
(info (ede-makeinfo-find-info-filename source)))
(concat (or info (file-name-sans-extension source)) ".info")))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
@@ -137,7 +137,7 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
@@ -151,7 +151,7 @@ Argument THIS is the target which needs to insert an info file."
; n
; (concat n ".info"))))
-(defmethod object-write ((this ede-proj-target-makefile-info))
+(cl-defmethod object-write ((this ede-proj-target-makefile-info))
"Before committing any change to THIS, make sure the mainmenu is first."
(let ((mm (oref this mainmenu))
(s (oref this source))
@@ -161,9 +161,9 @@ Argument THIS is the target which needs to insert an info file."
;; Make sure that MM is first in the list of items.
(setq nl (cons mm (delq mm s)))
(oset this source nl)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-documentation ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-documentation ((this ede-proj-target-makefile-info))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index badd507d954..c04c9bd78cc 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,6 +1,6 @@
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2001, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -65,11 +65,11 @@ All listed sources are included in the distribution.")
)
"Compile code via a sub-makefile.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_MISC"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-miscelaneous))
"Return a list of files which THIS target depends on."
(with-slots (submakefile) this
@@ -79,7 +79,7 @@ All listed sources are included in the distribution.")
nil)
(t (list submakefile)))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
"Create the make rule needed to create an archive for THIS."
;; DO NOT call the next method. We will never have any compilers,
;; or any dependencies, or stuff like this. This rule will let us
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 895929f5321..34e302d3d2c 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -1,6 +1,6 @@
;;; ede/proj-obj.el --- EDE Generic Project Object code generation support
-;;; Copyright (C) 1998-2000, 2005, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -126,7 +126,7 @@ file.")
(defvar ede-source-c++
(ede-sourcecode "ede-source-c++"
:name "C++"
- :sourcepattern "\\.\\(c\\(pp?\\|c\\|xx\\|++\\)\\|C\\\(PP\\)?\\)$"
+ :sourcepattern "\\.\\(c\\(pp?\\|c\\|xx\\|++\\)\\|C\\(PP\\)?\\)$"
:auxsourcepattern "\\.\\(hpp?\\|hh?\\|hxx\\|H\\)$"
:garbagepattern '("*.o" "*.obj" ".deps/*.P" ".lo"))
"C++ source code definition.")
@@ -275,9 +275,9 @@ No garbage pattern since it creates C or C++ code.")
;;; The EDE object compiler
;;
-(defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(if (eieio-instance-inheritor-slot-boundp this 'dependencyvar)
(with-slots (dependencyvar) this
(insert (car dependencyvar) "=")
@@ -289,30 +289,30 @@ No garbage pattern since it creates C or C++ code.")
;;; EDE Object target type methods
;;
-(defmethod ede-proj-makefile-sourcevar
+(cl-defmethod ede-proj-makefile-sourcevar
((this ede-proj-target-makefile-objectcode))
"Return the variable name for THIS's sources."
(require 'ede/pmake)
(concat (ede-pmake-varname this) "_SOURCES"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-objectcode))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
(append (oref this source) (oref this auxsource)))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies
(oref (ede-target-parent this) automatic-dependencies)))
- (call-next-method)))
+ (cl-call-next-method)))
-(defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves.
(let ((h (oref this auxsource)))
;; Add more logic here when the problem is better understood.
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index c109833b72d..a59317cf99a 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -1,6 +1,6 @@
;;; ede-proj-prog.el --- EDE Generic Project program support
-;; Copyright (C) 1998-2001, 2005, 2008-2013 Free Software Foundation,
+;; Copyright (C) 1998-2001, 2005, 2008-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -62,21 +62,21 @@ specified with ldlibs.")
"Libraries, such as \"m\" or \"Xt\" which this program depends on.
The linker flag \"-l\" is automatically prepended. Do not include a \"lib\"
prefix, or a \".so\" suffix.
-Use the 'ldflags' slot to specify where in-project libraries might be.
+Use the `ldflags' slot to specify where in-project libraries might be.
Note: Currently only used for Automake projects."
)
)
"This target is an executable program.")
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared "bin_PROGRAMS"
(insert (ede-name this)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared
@@ -86,11 +86,11 @@ Note: Currently only used for Automake projects."
(when (oref this ldlibs)
(mapc (lambda (d) (insert " -l" d)) (oref this ldlibs)))
)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(let ((lf (mapconcat 'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this
(if ldlibs
@@ -100,7 +100,7 @@ Note: Currently only used for Automake projects."
(when (and lf (not (string= "" lf)))
(ede-pmake-insert-variable-once "LDDEPS" (insert lf)))))
-(defmethod project-debug-target ((obj ede-proj-target-makefile-program))
+(cl-defmethod project-debug-target ((obj ede-proj-target-makefile-program))
"Debug a program target OBJ."
(let ((tb (get-buffer-create " *padt*"))
(dd (if (not (string= (oref obj path) ""))
@@ -118,7 +118,7 @@ Note: Currently only used for Automake projects."
(funcall ede-debug-program-function cmd))
(kill-buffer tb))))
-(defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
+(cl-defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
"Run a program target OBJ.
Optional COMMAND is the command to run in place of asking the user."
(require 'ede/shell)
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 07330ef7188..5877bb98e6d 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,6 +1,6 @@
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
-;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, scheme
@@ -40,7 +40,7 @@
)
"This target consists of scheme files.")
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index a31e1b3a172..a8edbe8fbdf 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -1,6 +1,6 @@
;;; ede-proj-shared.el --- EDE Generic Project shared library support
-;;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -166,19 +166,19 @@ Use ldlibs to add addition libraries.")
"%.lo: %.c\n"
"\t@echo '$(LTCOMPILE) -c $<'; \\\n"
"\t$(LTCOMPILE) -Wp,-MD,.deps/$(*F).p -c $<\n"
- "\t@-sed -e 's/^\([^:]*\)\.o:/\1.lo \1.o:/' \\\n"
+ "\t@-sed -e 's/^\\([^:]*\\)\\.o:/\\1.lo \\1.o:/' \\\n"
"\t < .deps/$(*F).p > .deps/$(*F).P\n"
"\t@-rm -f .deps/$(*F).p\n\n"))
)
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-shared-object))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig")
(ede-expand-filename (ede-toplevel) "ltmain.sh"))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
@@ -186,23 +186,23 @@ Makefile.am generator, so use it to add this important bin program."
(ede-pmake-insert-variable-shared "lib_LTLIBRARIES"
(insert (concat "lib" (ede-name this) ".la"))))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element."
nil)
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
"Return the name of the main target for THIS target."
;; We need some platform gunk to make the .so change to .sl, or .a,
;; depending on the platform we are going to compile against.
(concat "lib" (ede-name this) ".la"))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
"Return the variable name for THIS's sources."
(if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am)
(concat "lib" (oref this name) "_la_SOURCES")
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'ede/proj-shared)
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 99a5978b005..2bc8c09dbdd 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,6 +1,6 @@
;;; ede/proj.el --- EDE Generic Project file driver
-;; Copyright (C) 1998-2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2003, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -162,12 +162,12 @@ These are the linkers the user can choose from when setting the
:initform t
:type boolean
:custom boolean
- :label "Part of `all:' target"
+ :label "Part of all: target"
:group make
:documentation
- "Non nil means the rule created is part of the all target.
+ "Non nil means the rule created is part of the all: target.
Setting this to nil creates the rule to build this item, but does not
-include it in the ALL`all:' rule.")
+include it in the all: rule.")
(configuration-variables
:initarg :configuration-variables
:initform nil
@@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that
the PROJECT being read in is the root project."
(save-excursion
(let ((ret (eieio-persistent-read (concat project "Project.ede")
- ede-proj-project))
+ 'ede-proj-project))
(subdirs (directory-files project nil "[^.].*" nil)))
(if (not (object-of-class-p ret 'ede-proj-project))
(error "Corrupt project file"))
@@ -310,7 +310,7 @@ the PROJECT being read in is the root project."
(let ((sd (file-name-as-directory
(expand-file-name (car subdirs) project))))
(if (and (file-directory-p sd)
- (ede-directory-project-p sd))
+ (file-exists-p (expand-file-name "Project.ede" sd)))
(oset ret subproj
(cons (ede-proj-load sd (or rootproj ret))
(oref ret subproj))))
@@ -329,27 +329,27 @@ the PROJECT being read in is the root project."
;; Restore the directory slot
(oset project directory cdir))) ))
-(defmethod ede-commit-local-variables ((proj ede-proj-project))
+(cl-defmethod ede-commit-local-variables ((proj ede-proj-project))
"Commit change to local variables in PROJ."
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((proj ede-proj-project))
+(cl-defmethod eieio-done-customizing ((proj ede-proj-project))
"Call this when a user finishes customizing this object.
Argument PROJ is the project to save."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((target ede-proj-target))
+(cl-defmethod eieio-done-customizing ((target ede-proj-target))
"Call this when a user finishes customizing this object.
Argument TARGET is the project we are completing customization on."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save (ede-current-project)))
-(defmethod ede-commit-project ((proj ede-proj-project))
+(cl-defmethod ede-commit-project ((proj ede-proj-project))
"Commit any change to PROJ to its file."
(ede-proj-save proj))
-(defmethod ede-buffer-mine ((this ede-proj-project) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-project) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((f (ede-convert-path this (buffer-file-name buffer))))
(or (string= (file-name-nondirectory (oref this file)) f)
@@ -360,9 +360,9 @@ Argument TARGET is the project we are completing customization on."
(member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README"))
)))
-(defmethod ede-buffer-mine ((this ede-proj-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
- (or (call-next-method)
+ (or (cl-call-next-method)
(ede-target-buffer-in-sourcelist this buffer (oref this auxsource))))
@@ -371,7 +371,7 @@ Argument TARGET is the project we are completing customization on."
(defvar ede-proj-target-history nil
"History when querying for a target type.")
-(defmethod project-new-target ((this ede-proj-project)
+(cl-defmethod project-new-target ((this ede-proj-project)
&optional name type autoadd)
"Create a new target in THIS based on the current buffer."
(let* ((name (or name (read-string "Name: " "")))
@@ -409,7 +409,7 @@ Argument TARGET is the project we are completing customization on."
;; And save
(ede-proj-save this)))
-(defmethod project-new-target-custom ((this ede-proj-project))
+(cl-defmethod project-new-target-custom ((this ede-proj-project))
"Create a new target in THIS for custom."
(let* ((name (read-string "Name: " ""))
(type (completing-read "Type: " ede-proj-target-alist
@@ -418,7 +418,7 @@ Argument TARGET is the project we are completing customization on."
:path (ede-convert-path this default-directory)
:source nil)))
-(defmethod project-delete-target ((this ede-proj-target))
+(cl-defmethod project-delete-target ((this ede-proj-target))
"Delete the current target THIS from its parent project."
(let ((p (ede-current-project))
(ts (oref this source)))
@@ -439,7 +439,7 @@ Argument TARGET is the project we are completing customization on."
(oset p targets (delq this (oref p targets)))
(ede-proj-save (ede-current-project))))
-(defmethod project-add-file ((this ede-proj-target) file)
+(cl-defmethod project-add-file ((this ede-proj-target) file)
"Add to target THIS the current buffer represented as FILE."
(let ((file (ede-convert-path this file))
(src (ede-target-sourcecode this)))
@@ -454,7 +454,7 @@ Argument TARGET is the project we are completing customization on."
(t (error "`project-add-file(ede-target)' source mismatch error")))
(ede-proj-save))))
-(defmethod project-remove-file ((target ede-proj-target) file)
+(cl-defmethod project-remove-file ((target ede-proj-target) file)
"For TARGET, remove FILE.
FILE must be massaged by `ede-convert-path'."
;; Speedy delete should be safe.
@@ -462,11 +462,11 @@ FILE must be massaged by `ede-convert-path'."
(object-remove-from-list target 'auxsource (ede-convert-path target file))
(ede-proj-save))
-(defmethod project-update-version ((this ede-proj-project))
+(cl-defmethod project-update-version ((this ede-proj-project))
"The :version of project THIS has changed."
(ede-proj-save))
-(defmethod project-make-dist ((this ede-proj-project))
+(cl-defmethod project-make-dist ((this ede-proj-project))
"Build a distribution for the project based on THIS target."
(let ((pm (ede-proj-dist-makefile this))
(df (project-dist-files this)))
@@ -479,14 +479,14 @@ FILE must be massaged by `ede-convert-path'."
(file-name-directory pm))))
(compile (concat ede-make-command " -f " pm " dist"))))
-(defmethod project-dist-files ((this ede-proj-project))
+(cl-defmethod project-dist-files ((this ede-proj-project))
"Return a list of files that constitutes a distribution of THIS project."
(list
;; Note to self, keep this first for the above fn to check against.
(concat (oref this name) "-" (oref this version) ".tar.gz")
))
-(defmethod project-compile-project ((proj ede-proj-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-proj-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj))
@@ -499,12 +499,12 @@ Argument COMMAND is the command to use when compiling."
;;; Target type specific compilations/debug
;;
-(defmethod project-compile-target ((obj ede-proj-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-proj-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
-(defmethod project-compile-target ((obj ede-proj-target-makefile)
+(cl-defmethod project-compile-target ((obj ede-proj-target-makefile)
&optional command)
"Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use."
@@ -512,21 +512,21 @@ Optional argument COMMAND is the s the alternate command to use."
(compile (concat ede-make-command " -f " (oref obj makefile) " "
(ede-proj-makefile-target-name obj))))
-(defmethod project-debug-target ((obj ede-proj-target))
+(cl-defmethod project-debug-target ((obj ede-proj-target))
"Run the current project target OBJ in a debugger."
(error "Debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-proj-target))
+(cl-defmethod project-run-target ((obj ede-proj-target))
"Run the current project target OBJ."
(error "Run-target not supported by %s" (eieio-object-name obj)))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target))
"Return the name of the main target for THIS target."
(ede-name this))
;;; Compiler and source code generators
;;
-(defmethod ede-want-file-auxiliary-p ((this ede-target) file)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -534,7 +534,7 @@ Optional argument COMMAND is the s the alternate command to use."
(setq src (cdr src)))
src))
-(defmethod ede-proj-compilers ((obj ede-proj-target))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, concoct one on a first match found
basis for any given type from the `availablecompilers' slot.
@@ -570,7 +570,7 @@ You may need to add support for this type of file."
;; Return the discovered compilers.
comp)))
-(defmethod ede-proj-linkers ((obj ede-proj-target))
+(cl-defmethod ede-proj-linkers ((obj ede-proj-target))
"List of linkers being used by OBJ.
If the `linker' slot is empty, concoct one on a first match found
basis for any given type from the `availablelinkers' slot.
@@ -624,7 +624,7 @@ Converts all symbols into the objects to be used."
"Return non-nil if the current project PROJ is automake mode."
(eq (ede-proj-makefile-type proj) 'Makefile))
-(defmethod ede-proj-dist-makefile ((this ede-proj-project))
+(cl-defmethod ede-proj-dist-makefile ((this ede-proj-project))
"Return the name of the Makefile with the DIST target in it for THIS."
(cond ((eq (oref this makefile-type) 'Makefile.am)
(concat (file-name-directory (oref this file))
@@ -651,7 +651,7 @@ Converts all symbols into the objects to be used."
(interactive)
(ede-proj-setup-buildenvironment (ede-current-project) t))
-(defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS if needed.
MFILENAME is the makefile to generate."
;; For now, pass through until dirty is implemented.
@@ -660,7 +660,7 @@ MFILENAME is the makefile to generate."
(file-newer-than-file-p (oref this file) mfilename))
(ede-proj-makefile-create this mfilename)))
-(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
+(cl-defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
&optional force)
"Setup the build environment for project THIS.
Handles the Makefile, or a Makefile.am configure.ac combination.
@@ -686,11 +686,14 @@ Optional argument FORCE will force items to be regenerated."
;;; Lower level overloads
;;
-(defmethod project-rescan ((this ede-proj-project))
+(cl-defmethod project-rescan ((this ede-proj-project))
"Rescan the EDE proj project THIS."
(let ((root (or (ede-project-root this) this))
)
- (setq ede-projects (delq root ede-projects))
+ ;; @TODO - VERIFY THE BELOW WORKS
+ (ede-project-directory-remove-hash
+ (file-name-directory (ede-project-root-directory root)))
+ (ede-delete-project-from-global-list root)
;; NOTE : parent function double-checks that this dir was
;; already in memory once.
(ede-load-project-file (ede-project-root-directory root))
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 459959e220d..48bec3c49d8 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,10 +1,10 @@
;;; project-am.el --- A project management scheme based on automake files.
-;; Copyright (C) 1998-2000, 2003, 2005, 2007-2013 Free Software
+;; Copyright (C) 1998-2000, 2003, 2005, 2007-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.0.3
+;; Old-Version: 0.0.3
;; Keywords: project, make
;; This file is part of GNU Emacs.
@@ -194,7 +194,7 @@ other meta-variable based on this name.")
"Encode one makefile.")
;;; Code:
-(defmethod project-add-file ((ot project-am-target))
+(cl-defmethod project-add-file ((ot project-am-target))
"Add the current buffer into a project.
OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target")
@@ -221,7 +221,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer))
(setq ede-object ot)))
-(defmethod project-remove-file ((ot project-am-target) fnnd)
+(cl-defmethod project-remove-file ((ot project-am-target) fnnd)
"Remove the current buffer from any project targets."
(ede-with-projectfile ot
(makefile-move-to-macro (project-am-macro ot))
@@ -232,7 +232,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer))
(setq ede-object nil))
-(defmethod project-edit-file-target ((obj project-am-target))
+(cl-defmethod project-edit-file-target ((obj project-am-target))
"Edit the target associated w/ this file."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
@@ -240,7 +240,7 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(defmethod project-new-target ((proj project-am-makefile)
+(cl-defmethod project-new-target ((proj project-am-makefile)
&optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
@@ -300,7 +300,7 @@ buffer being in order to provide a smart default target type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(defmethod project-compile-project ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-project ((obj project-am-target) &optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@@ -324,7 +324,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -349,7 +349,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-target ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-target ((obj project-am-target) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@@ -378,7 +378,7 @@ Argument COMMAND is the command to use for compiling the target."
;; We better be in the right place when compiling a specific target.
(compile command))
-(defmethod project-debug-target ((obj project-am-objectcode))
+(cl-defmethod project-debug-target ((obj project-am-objectcode))
"Run the current project target in a debugger."
(let ((tb (get-buffer-create " *padt*"))
(dd (oref obj path))
@@ -397,7 +397,7 @@ Argument COMMAND is the command to use for compiling the target."
(declare-function ede-shell-run-something "ede/shell")
-(defmethod project-run-target ((obj project-am-objectcode))
+(cl-defmethod project-run-target ((obj project-am-objectcode))
"Run the current project target in comint buffer."
(require 'ede/shell)
(let ((tb (get-buffer-create " *padt*"))
@@ -409,11 +409,11 @@ Argument COMMAND is the command to use for compiling the target."
(setq default-directory dd)
(setq cmd (read-from-minibuffer
"Run (like this): "
- (concat (ede-target-name obj))))
+ (concat "./" (ede-target-name obj))))
(ede-shell-run-something obj cmd))
(kill-buffer tb))))
-(defmethod project-make-dist ((this project-am-target))
+(cl-defmethod project-make-dist ((this project-am-target))
"Run the current project in the debugger."
(require 'compile)
(if (not project-am-compile-project-command)
@@ -428,12 +428,8 @@ Argument COMMAND is the command to use for compiling the target."
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
Optional ROOTPROJ is the root EDE project."
- (let* ((ede-constructing t)
- (amo (object-assoc (expand-file-name "Makefile.am" directory)
- 'file ede-projects)))
- (when (not amo)
- (setq amo (project-am-load-makefile directory)))
- amo))
+ ;; Just jump into creating the project from the Makefiles.
+ (project-am-load-makefile directory))
(defun project-am-find-topmost-level (dir)
"Find the topmost automakefile starting with DIR."
@@ -504,7 +500,7 @@ This is used when subprojects are made in named subdirectories."
ampf))))
;;; Methods:
-(defmethod project-targets-for-file ((proj project-am-makefile))
+(cl-defmethod project-targets-for-file ((proj project-am-makefile))
"Return a list of targets the project PROJ."
(oref proj targets))
@@ -616,7 +612,7 @@ Strip out duplicates, and recurse on variables."
subdirs)
)
-(defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
+(cl-defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
"Rescan the makefile for all targets and sub targets."
(project-am-with-makefile-current (file-name-directory (oref this file))
;;(message "Scanning %s..." (oref this file))
@@ -696,7 +692,7 @@ Strip out duplicates, and recurse on variables."
)))
-(defmethod project-rescan ((this project-am-program))
+(cl-defmethod project-rescan ((this project-am-program))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
@@ -704,66 +700,66 @@ Strip out duplicates, and recurse on variables."
(oset this :ldadd (makefile-macro-file-list
(concat (oref this :name) "_LDADD"))))
-(defmethod project-rescan ((this project-am-lib))
+(cl-defmethod project-rescan ((this project-am-lib))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c")))))
-(defmethod project-rescan ((this project-am-texinfo))
+(cl-defmethod project-rescan ((this project-am-texinfo))
"Rescan object THIS."
(oset this :include (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-man))
+(cl-defmethod project-rescan ((this project-am-man))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-lisp))
+(cl-defmethod project-rescan ((this project-am-lisp))
"Rescan the lisp sources."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-header))
+(cl-defmethod project-rescan ((this project-am-header))
"Rescan the Header sources for object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-built-src))
+(cl-defmethod project-rescan ((this project-am-built-src))
"Rescan built sources for object THIS."
(oset this :source (makefile-macro-file-list "BUILT_SOURCES")))
-(defmethod project-rescan ((this project-am-extra-dist))
+(cl-defmethod project-rescan ((this project-am-extra-dist))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list "EXTRA_DIST")))
-(defmethod project-am-macro ((this project-am-objectcode))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-objectcode))
+ "Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES"))
-(defmethod project-am-macro ((this project-am-header-noinst))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-noinst))
+ "Return the default macro to `edit' for this object."
"noinst_HEADERS")
-(defmethod project-am-macro ((this project-am-header-inst))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-inst))
+ "Return the default macro to `edit' for this object."
"include_HEADERS")
-(defmethod project-am-macro ((this project-am-header-pkg))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-pkg))
+ "Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
-(defmethod project-am-macro ((this project-am-header-chk))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-chk))
+ "Return the default macro to `edit' for this object."
"check_HEADERS")
-(defmethod project-am-macro ((this project-am-texinfo))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-texinfo))
+ "Return the default macro to `edit' for this object type."
(concat (file-name-sans-extension (oref this :name)) "_TEXINFOS"))
-(defmethod project-am-macro ((this project-am-man))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-man))
+ "Return the default macro to `edit' for this object type."
(oref this :name))
-(defmethod project-am-macro ((this project-am-lisp))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-lisp))
+ "Return the default macro to `edit' for this object."
"lisp_LISP")
(defun project-am-buffer-object (amf buffer)
@@ -785,7 +781,7 @@ nil means that this buffer belongs to no-one."
sobj (cdr sobj)))
obj))))
-(defmethod ede-buffer-mine ((this project-am-makefile) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-makefile) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this :file) efn)
@@ -800,42 +796,42 @@ nil means that this buffer belongs to no-one."
ans)
)))
-(defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((bfn (file-relative-name (buffer-file-name buffer)
(oref this :path))))
(or (string= (oref this :name) bfn)
(member bfn (oref this :include)))))
-(defmethod ede-buffer-mine ((this project-am-man) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-man) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(string= (oref this :name)
(file-relative-name (buffer-file-name buffer) (oref this :path))))
-(defmethod ede-buffer-mine ((this project-am-lisp) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-lisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod project-am-subtree ((ampf project-am-makefile) subdir)
+(cl-defmethod project-am-subtree ((ampf project-am-makefile) subdir)
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
-(defmethod project-compile-target-command ((this project-am-objectcode))
+(cl-defmethod project-compile-target-command ((this project-am-objectcode))
"Default target to use when compiling an object code target."
(oref this :name))
-(defmethod project-compile-target-command ((this project-am-texinfo))
+(cl-defmethod project-compile-target-command ((this project-am-texinfo))
"Default target t- use when compiling a texinfo file."
(let ((n (oref this :name)))
(if (string-match "\\.texi?\\(nfo\\)?" n)
@@ -857,17 +853,17 @@ Argument FILE is the file to extract the end directory name from."
(defun project-am-preferred-target-type (file)
"For FILE, return the preferred type for that file."
(cond ((string-match "\\.texi?\\(nfo\\)$" file)
- project-am-texinfo)
+ 'project-am-texinfo)
((string-match "\\.[0-9]$" file)
- project-am-man)
+ 'project-am-man)
((string-match "\\.el$" file)
- project-am-lisp)
+ 'project-am-lisp)
(t
- project-am-program)))
+ 'project-am-program)))
-(defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
(let ((s (oref this source))
(found nil))
(while (and s (not found))
@@ -877,7 +873,7 @@ Argument FILE is the file to extract the end directory name from."
(setq s (cdr s)))
found)))
-(defmethod ede-documentation ((this project-am-texinfo))
+(cl-defmethod ede-documentation ((this project-am-texinfo))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -1001,12 +997,12 @@ Calculates the info with `project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index 94846e35742..bdb5d302287 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -1,6 +1,6 @@
;;; ede/shell.el --- A shell controlled by EDE.
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -33,7 +33,7 @@
(declare-function comint-send-input "comint")
-(defmethod ede-shell-run-something ((target ede-target) command)
+(cl-defmethod ede-shell-run-something ((target ede-target) command)
"Create a shell to run stuff for TARGET.
COMMAND is a text string representing the thing to be run."
(let* ((buff (ede-shell-buffer target))
@@ -42,10 +42,15 @@ COMMAND is a text string representing the thing to be run."
;; Show the new buffer.
(when (not (get-buffer-window buff))
(switch-to-buffer-other-window buff t))
- ;; Force a shell into the buffer.
- (shell buff)
- (while (eq (point-min) (point))
- (accept-process-output))
+ ;; Force a shell into the buffer, but only if the buffer
+ ;; doesn't already have a shell in it.
+ ;; Newer versions of `shell' pop the window forward.
+ (set-buffer buff)
+ (when (not (eq major-mode 'shell-mode))
+ (shell buff)
+ ;; Make sure the shell has started.
+ (while (eq (point-min) (point))
+ (accept-process-output)))
;; Change the default directory
(if (not (string= (file-name-as-directory (expand-file-name default-directory))
(file-name-as-directory (expand-file-name dd))))
@@ -67,7 +72,7 @@ COMMAND is a text string representing the thing to be run."
(comint-send-input)
)
-(defmethod ede-shell-buffer ((target ede-target))
+(cl-defmethod ede-shell-buffer ((target ede-target))
"Get the buffer for running shell commands for TARGET."
(let ((name (ede-name target)))
(get-buffer-create (format "*EDE Shell %s*" name))))
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index c1f72d48080..3c6cb0c2c28 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -1,6 +1,6 @@
;;; ede/simple.el --- Overlay an EDE structure on an existing project
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -102,7 +102,7 @@ All directories need at least one target.")
"EDE Simple project class.
Each directory needs a project file to control it.")
-(defmethod ede-commit-project ((proj ede-simple-project))
+(cl-defmethod ede-commit-project ((proj ede-simple-project))
"Commit any change to PROJ to its file."
(when (not (file-exists-p ede-simple-save-directory))
(if (y-or-n-p (concat ede-simple-save-directory
@@ -111,7 +111,7 @@ Each directory needs a project file to control it.")
(error "No save directory for new project")))
(eieio-persistent-save proj))
-(defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index 7b675587f81..d7d27679623 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -1,6 +1,6 @@
;; ede/source.el --- EDE source code object
-;; Copyright (C) 2000, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -72,7 +72,7 @@ that they are willing to use.")
;;; Methods
;;
-(defmethod initialize-instance :AFTER ((this ede-sourcecode) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(let ((lst ede-sourcecode-list))
@@ -85,45 +85,45 @@ that they are willing to use.")
;; Add to the beginning of the list.
(setq ede-sourcecode-list (cons this ede-sourcecode-list)))))
-(defmethod ede-want-file-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-p ((this ede-sourcecode) filename)
"Return non-nil if sourcecode definition THIS will take FILENAME."
(or (ede-want-file-source-p this filename)
(ede-want-file-auxiliary-p this filename)))
-(defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(string-match (oref this sourcepattern) filename)))
-(defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(and (slot-boundp this 'auxsourcepattern)
(oref this auxsourcepattern)
(string-match (oref this auxsourcepattern) filename))))
-(defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any source files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-source-p this (pop filenames))))
found))
-(defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any aux files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-auxiliary-p this (pop filenames))))
found))
-(defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-p this (pop filenames))))
found))
-(defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
+(cl-defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
"Return a list of file names of header files for THIS with FILENAME.
Used to guess header files, but uses the auxsource regular expression."
(let ((dn (file-name-directory filename))
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index 0f3c96b1a7d..46c097ab725 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,6 +1,6 @@
;;; ede/speedbar.el --- Speedbar viewing of EDE projects
-;; Copyright (C) 1998-2001, 2003, 2005, 2007-2013 Free Software
+;; Copyright (C) 1998-2001, 2003, 2005, 2007-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects."
(let ((obj (eieio-speedbar-find-nearest-object)))
(if (not (eieio-object-p obj))
nil
- (cond ((obj-of-class-p obj ede-project)
+ (cond ((obj-of-class-p obj 'ede-project)
(project-compile-project obj))
- ((obj-of-class-p obj ede-target)
+ ((obj-of-class-p obj 'ede-target)
(project-compile-target obj))
(t (error "Error in speedbar structure"))))))
@@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects."
(let ((obj (eieio-speedbar-find-nearest-object)))
(if (not (eieio-object-p obj))
(error "Error in speedbar or ede structure")
- (if (obj-of-class-p obj ede-target)
+ (if (obj-of-class-p obj 'ede-target)
(setq obj (ede-target-parent obj)))
- (if (obj-of-class-p obj ede-project)
+ (if (obj-of-class-p obj 'ede-project)
obj
(error "Error in speedbar or ede structure")))))
@@ -181,13 +181,13 @@ Argument DIR is the directory from which to derive the list of objects."
(setq depth (1- depth)))
(speedbar-line-token))))
-(defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(file-name-directory (oref obj file))
)
-(defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj)))
@@ -201,42 +201,42 @@ Optional DEPTH is the depth we start at."
(concat (eieio-speedbar-derive-line-path proj)
(ede-find-nearest-file-line)))))))
-(defmethod eieio-speedbar-description ((obj ede-project))
+(cl-defmethod eieio-speedbar-description ((obj ede-project))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-description ((obj ede-target))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-child-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-child-description ((obj ede-target))
"Provide a speedbar description for a plain-child of OBJ.
A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-helper)
(speedbar-item-info-tag-helper)))
-(defmethod eieio-speedbar-object-buttonname ((object ede-project))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-project))
"Return a string to use as a speedbar button for OBJECT."
(if (ede-parent-project object)
(ede-name object)
(concat (ede-name object) " " (oref object version))))
-(defmethod eieio-speedbar-object-buttonname ((object ede-target))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-target))
"Return a string to use as a speedbar button for OBJECT."
(ede-name object))
-(defmethod eieio-speedbar-object-children ((this ede-project))
+(cl-defmethod eieio-speedbar-object-children ((this ede-project))
"Return the list of speedbar display children for THIS."
(condition-case nil
(with-slots (subproj targets) this
(append subproj targets))
(error nil)))
-(defmethod eieio-speedbar-object-children ((this ede-target))
+(cl-defmethod eieio-speedbar-object-children ((this ede-target))
"Return the list of speedbar display children for THIS."
(oref this source))
-(defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
"Create a speedbar tag line for a child of THIS.
It has depth DEPTH."
(with-slots (source) this
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index a7a4dc53dd9..3af0372d467 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,6 +1,6 @@
;;; ede/srecode.el --- EDE utilities on top of SRecoder
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index 00a03f037a6..b78d95cf62b 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,6 +1,6 @@
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
-;; Copyright (C) 2001-2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, vc
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index 71a79a1b706..dbbf46fd01c 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -1,6 +1,6 @@
;;; ede/util.el --- EDE utilities
-;; Copyright (C) 2000, 2005, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -46,19 +46,19 @@ Argument NEWVERSION is the version number to use in the current project."
(project-update-version ede-object)
(ede-update-version-in-source ede-object newversion))))
-(defmethod project-update-version ((ot ede-project))
+(cl-defmethod project-update-version ((ot ede-project))
"The :version of the project OT has been updated.
Handle saving, or other detail."
(error "project-update-version not supported by %s" (eieio-object-name ot)))
-(defmethod ede-update-version-in-source ((this ede-project) version)
+(cl-defmethod ede-update-version-in-source ((this ede-project) version)
"Change occurrences of a version string in sources.
In project THIS, cycle over all targets to give them a chance to set
their sources to VERSION."
(ede-map-targets this (lambda (targ)
(ede-update-version-in-source targ version))))
-(defmethod ede-update-version-in-source ((this ede-target) version)
+(cl-defmethod ede-update-version-in-source ((this ede-target) version)
"In sources for THIS, change version numbers to VERSION."
(if (and (slot-boundp this 'versionsource)
(oref this versionsource))
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index 533d959f6b7..9d07b67e894 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -1,6 +1,6 @@
;;; inversion.el --- When you need something in version XX.XX
-;;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
@@ -230,8 +230,8 @@ string. INCOMPATIBLE-VERSION can be nil.
RESERVED arguments are kept for a later use.
Return:
- nil if everything is ok.
-- 'outdated if VERSION is less than MINIMUM.
-- 'incompatible if VERSION is not backward compatible with MINIMUM.
+- `outdated' if VERSION is less than MINIMUM.
+- `incompatible' if VERSION is not backward compatible with MINIMUM.
- t if the check failed."
(let ((code (if (stringp version)
(inversion-decode-version version)
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 7c75e3f9f39..b5995ffa397 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities
;;
-;; Copyright (C) 2004-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -48,6 +48,13 @@
(eval-when-compile (require 'cl))
+(require 'find-func)
+;; For find-function-regexp-alist. It is tempting to replace this
+;; ‘require’ by (defvar find-function-regexp-alist) and
+;; with-eval-after-load, but model-local.el is typically loaded when a
+;; semantic autoload is invoked, and something in semantic loads
+;; find-func.el before mode-local.el, so the eval-after-load is lost.
+
;;; Misc utilities
;;
(defun mode-local-map-file-buffers (function &optional predicate buffers)
@@ -597,7 +604,7 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'."
;;
(defun overload-docstring-extension (overload)
"Return the doc string that augments the description of OVERLOAD."
- (let ((doc "\n\This function can be overloaded\
+ (let ((doc "\nThis function can be overloaded\
with `define-mode-local-override'.")
(sym (overload-obsoleted-by overload)))
(when sym
@@ -625,13 +632,137 @@ SYMBOL is a function that can be overridden."
;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
)))
+(defun describe-mode-local-overload (symbol)
+ "For `help-fns-describe-function-functions'; add overloads for SYMBOL."
+ (when (get symbol 'mode-local-overload)
+ (let ((default (or (intern-soft (format "%s-default" (symbol-name symbol)))
+ symbol))
+ (override (with-current-buffer describe-function-orig-buffer
+ (fetch-overload symbol)))
+ modes)
+
+ (insert (overload-docstring-extension symbol) "\n\n")
+ (insert (format-message "default function: `%s'\n" default))
+ (if override
+ (insert (format-message "\noverride in buffer `%s': `%s'\n"
+ describe-function-orig-buffer override))
+ (insert (format-message "\nno override in buffer `%s'\n"
+ describe-function-orig-buffer)))
+
+ (mapatoms
+ (lambda (sym) (when (get sym 'mode-local-symbol-table) (push sym modes)))
+ obarray)
+
+ (dolist (mode modes)
+ (let* ((major-mode mode)
+ (override (fetch-overload symbol)))
+
+ (when override
+ (insert (format-message "\noverride in mode `%s': `%s'\n"
+ major-mode override))
+ )))
+ )))
+
+(add-hook 'help-fns-describe-function-functions 'describe-mode-local-overload)
+
+(declare-function xref-item-location "xref" (xref))
+
+(defun xref-mode-local--override-present (sym xrefs)
+ "Return non-nil if SYM is in XREFS."
+ (let (result)
+ (while (and (null result)
+ xrefs)
+ (when (equal sym (car (xref-elisp-location-symbol (xref-item-location (pop xrefs)))))
+ (setq result t)))
+ result))
+
+(defun xref-mode-local-overload (symbol)
+ "For `elisp-xref-find-def-functions'; add overloads for SYMBOL."
+ ;; Current buffer is the buffer where xref-find-definitions was invoked.
+ (when (get symbol 'mode-local-overload)
+ (let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol)))
+ (default (intern-soft (format "%s-default" (symbol-name symbol))))
+ (default-file (when default (find-lisp-object-file-name default (symbol-function default))))
+ modes
+ xrefs)
+
+ (mapatoms
+ (lambda (sym) (when (get sym 'mode-local-symbol-table) (push sym modes)))
+ obarray)
+
+ ;; mode-local-overrides are inherited from parent modes; we
+ ;; don't want to list the same function twice. So order ‘modes’
+ ;; with parents first, and check for duplicates.
+
+ (setq modes
+ (sort modes
+ (lambda (a b)
+ (not (equal b (get a 'mode-local-parent)))))) ;; a is not a child, or not a child of b
+
+ (dolist (mode modes)
+ (let* ((major-mode mode)
+ (override (fetch-overload symbol))
+ (override-file (when override (find-lisp-object-file-name override (symbol-function override)))))
+
+ (when (and override override-file)
+ (let ((meta-name (cons override major-mode))
+ ;; For the declaration:
+ ;;
+ ;;(define-mode-local-override xref-elisp-foo c-mode
+ ;;
+ ;; The override symbol name is
+ ;; "xref-elisp-foo-c-mode". The summary should match
+ ;; the declaration, so strip the mode from the
+ ;; symbol name.
+ (summary (format elisp--xref-format-extra
+ 'define-mode-local-override
+ (substring (symbol-name override) 0 (- (1+ (length (symbol-name major-mode)))))
+ major-mode)))
+
+ (unless (xref-mode-local--override-present override xrefs)
+ (push (elisp--xref-make-xref
+ 'define-mode-local-override meta-name override-file summary)
+ xrefs))))))
+
+ ;; %s-default is interned whether it is a separate function or
+ ;; not, so we have to check that here.
+ (when (and (functionp default) default-file)
+ (push (elisp--xref-make-xref nil default default-file) xrefs))
+
+ (when symbol-file
+ (push (elisp--xref-make-xref 'define-overloadable-function symbol symbol-file) xrefs))
+
+ xrefs)))
+
+(add-hook 'elisp-xref-find-def-functions 'xref-mode-local-overload)
+
+(defconst xref-mode-local-find-overloadable-regexp
+ "(\\(\\(define-overloadable-function\\)\\|\\(define-overload\\)\\) +%s"
+ "Regexp used by `xref-find-definitions' when searching for a
+ mode-local overloadable function definition.")
+
+(defun xref-mode-local-find-override (meta-name)
+ "Function used by `xref-find-definitions' when searching for an
+ override of a mode-local overloadable function.
+META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
+ (let* ((override (car meta-name))
+ (mode (cdr meta-name))
+ (regexp (format "(define-mode-local-override +%s +%s"
+ (substring (symbol-name override) 0 (- (1+ (length (symbol-name mode)))))
+ mode)))
+ (re-search-forward regexp nil t)
+ ))
+
+(add-to-list 'find-function-regexp-alist '(define-overloadable-function . xref-mode-local-find-overloadable-regexp))
+(add-to-list 'find-function-regexp-alist (cons 'define-mode-local-override #'xref-mode-local-find-override))
+
;; Help for mode-local bindings.
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."
(let ((value (symbol-value symbol)))
- (princ (format "\n `%s' value is\n " symbol))
+ (princ (format-message "\n `%s' value is\n " symbol))
(if (and value (symbolp value))
- (princ (format "`%s'" value))
+ (princ (format-message "`%s'" value))
(let ((pt (point)))
(pp value)
(save-excursion
@@ -689,7 +820,7 @@ SYMBOL is a function that can be overridden."
)
((symbolp buffer-or-mode)
(setq mode buffer-or-mode)
- (princ (format "`%s'\n" buffer-or-mode))
+ (princ (format-message "`%s'\n" buffer-or-mode))
)
((signal 'wrong-type-argument
(list 'buffer-or-mode buffer-or-mode))))
@@ -699,7 +830,7 @@ SYMBOL is a function that can be overridden."
(while mode
(setq table (get mode 'mode-local-symbol-table))
(when table
- (princ (format "\n- From `%s'\n" mode))
+ (princ (format-message "\n- From `%s'\n" mode))
(mode-local-print-bindings table))
(setq mode (get-mode-local-parent mode)))))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 268beed8b1a..dea73a06e2a 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
;;; pulse.el --- Pulsing Overlays
-;;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 1.0
@@ -121,7 +121,7 @@ http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
:group 'pulse
:type 'number)
(defcustom pulse-delay .03
- "Delay between face lightening iterations, as used by `sit-for'."
+ "Delay between face lightening iterations."
:group 'pulse
:type 'number)
@@ -131,58 +131,55 @@ Return t if there is more drift to do, nil if completed."
(if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
nil
(let* ((frame (color-values (face-background 'default)))
- (start (color-values (face-background
- (get 'pulse-highlight-face
- :startface))))
- (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
- (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
- (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
- (it (get 'pulse-highlight-face :iteration))
- )
- (set-face-background 'pulse-highlight-face
- (pulse-color-values-to-hex
- (list
- (+ (nth 0 start) (* (nth 0 frac) it))
- (+ (nth 1 start) (* (nth 1 frac) it))
- (+ (nth 2 start) (* (nth 2 frac) it)))))
- (put 'pulse-highlight-face :iteration (1+ it))
- (if (>= (1+ it) pulse-iterations)
- nil
- t))))
+ (pulse-background (face-background
+ (get 'pulse-highlight-face
+ :startface)
+ nil t)));; can be nil
+ (when pulse-background
+ (let* ((start (color-values pulse-background))
+ (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
+ (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
+ (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
+ (it (get 'pulse-highlight-face :iteration))
+ )
+ (set-face-background 'pulse-highlight-face
+ (pulse-color-values-to-hex
+ (list
+ (+ (nth 0 start) (* (nth 0 frac) it))
+ (+ (nth 1 start) (* (nth 1 frac) it))
+ (+ (nth 2 start) (* (nth 2 frac) it)))))
+ (put 'pulse-highlight-face :iteration (1+ it))
+ (if (>= (1+ it) pulse-iterations)
+ nil
+ t)))
+ )))
(defun pulse-reset-face (&optional face)
"Reset the pulse highlighting FACE."
(set-face-background 'pulse-highlight-face
(if face
- (face-background face)
+ (face-background face nil t)
(face-background 'pulse-highlight-start-face)
))
(put 'pulse-highlight-face :startface (or face
'pulse-highlight-start-face))
(put 'pulse-highlight-face :iteration 0))
-(defun pulse (&optional face)
- "Pulse the colors on our highlight face.
-If optional FACE is provided, reset the face to FACE color,
-instead of `pulse-highlight-start-face'.
-Be sure to call `pulse-reset-face' after calling pulse."
- (unwind-protect
- (progn
- (pulse-reset-face face)
- (while (and (pulse-lighten-highlight)
- (sit-for pulse-delay))
- nil))))
-
;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
"The current pulsing overlay.")
+(defvar pulse-momentary-timer nil
+ "The current pulsing timer.")
+
(defun pulse-momentary-highlight-overlay (o &optional face)
"Pulse the overlay O, unhighlighting before next command.
-Optional argument FACE specifies the fact to do the highlighting."
+Optional argument FACE specifies the face to do the highlighting."
+ ;; We don't support simultaneous highlightings.
+ (pulse-momentary-unhighlight)
(overlay-put o 'original-face (overlay-get o 'face))
- (add-to-list 'pulse-momentary-overlay o)
+ (setq pulse-momentary-overlay o)
(if (eq pulse-flag 'never)
nil
(if (or (not pulse-flag) (not (pulse-available-p)))
@@ -191,53 +188,63 @@ Optional argument FACE specifies the fact to do the highlighting."
(overlay-put o 'face (or face 'pulse-highlight-start-face))
(add-hook 'pre-command-hook
'pulse-momentary-unhighlight))
- ;; pulse it.
- (unwind-protect
- (progn
- (overlay-put o 'face 'pulse-highlight-face)
- ;; The pulse function puts FACE onto 'pulse-highlight-face.
- ;; Thus above we put our face on the overlay, but pulse
- ;; with a reference face needed for the color.
- (pulse face))
- (pulse-momentary-unhighlight)))))
+ ;; Pulse it.
+ (overlay-put o 'face 'pulse-highlight-face)
+ ;; The pulse function puts FACE onto 'pulse-highlight-face.
+ ;; Thus above we put our face on the overlay, but pulse
+ ;; with a reference face needed for the color.
+ (pulse-reset-face face)
+ (setq pulse-momentary-timer
+ (run-with-timer 0 pulse-delay #'pulse-tick
+ (time-add (current-time)
+ (* pulse-delay pulse-iterations)))))))
+
+(defun pulse-tick (stop-time)
+ (if (time-less-p (current-time) stop-time)
+ (pulse-lighten-highlight)
+ (pulse-momentary-unhighlight)))
(defun pulse-momentary-unhighlight ()
"Unhighlight a line recently highlighted."
- ;; If someone passes in an overlay, then pulse-momentary-overlay
- ;; will still be nil, and won't need modifying.
(when pulse-momentary-overlay
;; clear the starting face
- (mapc
- (lambda (ol)
- (overlay-put ol 'face (overlay-get ol 'original-face))
- (overlay-put ol 'original-face nil)
- ;; Clear the overlay if it needs deleting.
- (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
- pulse-momentary-overlay)
+ (let ((ol pulse-momentary-overlay))
+ (overlay-put ol 'face (overlay-get ol 'original-face))
+ (overlay-put ol 'original-face nil)
+ ;; Clear the overlay if it needs deleting.
+ (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
;; Clear the variable.
- (setq pulse-momentary-overlay nil))
+ (setq pulse-momentary-overlay nil)
- ;; Reset the pulsing face.
- (pulse-reset-face)
+ ;; Reset the pulsing face.
+ (pulse-reset-face))
+
+ ;; Cancel the timer.
+ (when pulse-momentary-timer
+ (cancel-timer pulse-momentary-timer))
;; Remove this hook.
(remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
+;;;###autoload
(defun pulse-momentary-highlight-one-line (point &optional face)
"Highlight the line around POINT, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
- (let ((start (point-at-bol))
- (end (save-excursion
- (end-of-line)
- (when (not (eobp))
- (forward-char 1))
- (point))))
- (pulse-momentary-highlight-region start end face)))
-
+ (save-excursion
+ (goto-char point)
+ (let ((start (point-at-bol))
+ (end (save-excursion
+ (end-of-line)
+ (when (not (eobp))
+ (forward-char 1))
+ (point))))
+ (pulse-momentary-highlight-region start end face))))
+
+;;;###autoload
(defun pulse-momentary-highlight-region (start end &optional face)
"Highlight between START and END, unhighlighting before next command.
-Optional argument FACE specifies the fact to do the highlighting."
+Optional argument FACE specifies the face to do the highlighting."
(let ((o (make-overlay start end)))
;; Mark it for deletion
(overlay-put o 'pulse-delete t)
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 909902a71fe..290cd907beb 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,6 +1,6 @@
;;; semantic.el --- Semantic buffer evaluator.
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax tools
@@ -311,14 +311,6 @@ a parse of the buffer.")
(semantic-varalias-obsolete 'semantic-init-db-hooks
'semantic-init-db-hook "23.2")
-(defvar semantic-new-buffer-fcn-was-run nil
- "Non-nil after `semantic-new-buffer-fcn' has been executed.")
-(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
-
-(defsubst semantic-active-p ()
- "Return non-nil if the current buffer was set up for parsing."
- semantic-new-buffer-fcn-was-run)
-
(defsubst semantic-error-if-unparsed ()
"Raise an error if current buffer was not parsed by Semantic."
(unless semantic-new-buffer-fcn-was-run
@@ -390,7 +382,7 @@ Arguments START and END bound the time being calculated."
(defun bovinate (&optional clear)
"Parse the current buffer. Show output in a temp buffer.
Optional argument CLEAR will clear the cache before parsing.
-If CLEAR is negative, it will do a full reparse, and also not display
+If CLEAR is negative, it will do a full reparse, and also display
the output buffer."
(interactive "P")
(if clear (semantic-clear-toplevel-cache))
@@ -400,7 +392,8 @@ the output buffer."
(end (current-time)))
(message "Retrieving tags took %.2f seconds."
(semantic-elapsed-time start end))
- (when (or (null clear) (not (listp clear)))
+ (when (or (null clear) (not (listp clear))
+ (and (numberp clear) (< 0 clear)))
(pop-to-buffer "*Parser Output*")
(require 'pp)
(erase-buffer)
@@ -580,6 +573,7 @@ string."
;; The best way to call the parser from programs is via
;; `semantic-fetch-tags'. This, in turn, uses other internal
;; API functions which plug-in parsers can take advantage of.
+(defvar semantic-parser-warnings)
(defun semantic-fetch-tags ()
"Fetch semantic tags from the current buffer.
@@ -609,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache."
(garbage-collect)
(cond
-;;;; Try the incremental parser to do a fast update.
- ((semantic-parse-tree-needs-update-p)
- (setq res (semantic-parse-changes))
- (if (semantic-parse-tree-needs-rebuild-p)
- ;; If the partial reparse fails, jump to a full reparse.
- (semantic-fetch-tags)
- ;; Clear the cache of unmatched syntax tokens
- ;;
- ;; NOTE TO SELF:
- ;;
- ;; Move this into the incremental parser. This is a bug.
- ;;
- (semantic-clear-unmatched-syntax-cache)
- (run-hook-with-args ;; Let hooks know the updated tags
- 'semantic-after-partial-cache-change-hook res))
- (setq semantic--completion-cache nil))
-
-;;;; Parse the whole system.
- ((semantic-parse-tree-needs-rebuild-p)
- ;; Use Emacs's built-in progress-reporter (only interactive).
- (if noninteractive
- (setq res (semantic-parse-region (point-min) (point-max)))
- (let ((semantic--progress-reporter
- (and (>= (point-max) semantic-minimum-working-buffer-size)
- (eq semantic-working-type 'percent)
- (make-progress-reporter
- (semantic-parser-working-message (buffer-name))
- 0 100))))
- (setq res (semantic-parse-region (point-min) (point-max)))
- (if semantic--progress-reporter
- (progress-reporter-done semantic--progress-reporter))))
-
- ;; Clear the caches when we see there were no errors.
- ;; But preserve the unmatched syntax cache and warnings!
- (let (semantic-unmatched-syntax-cache
- semantic-unmatched-syntax-cache-check
- semantic-parser-warnings)
- (semantic-clear-toplevel-cache))
- ;; Set up the new overlays
- (semantic--tag-link-list-to-buffer res)
- ;; Set up the cache with the new results
- (semantic--set-buffer-cache res)
- ))))
+ ;; Try the incremental parser to do a fast update.
+ ((semantic-parse-tree-needs-update-p)
+ (setq res (semantic-parse-changes))
+ (if (semantic-parse-tree-needs-rebuild-p)
+ ;; If the partial reparse fails, jump to a full reparse.
+ (semantic-fetch-tags)
+ ;; Clear the cache of unmatched syntax tokens
+ ;;
+ ;; NOTE TO SELF:
+ ;;
+ ;; Move this into the incremental parser. This is a bug.
+ ;;
+ (semantic-clear-unmatched-syntax-cache)
+ (run-hook-with-args ;; Let hooks know the updated tags
+ 'semantic-after-partial-cache-change-hook res))
+ (setq semantic--completion-cache nil))
+
+ ;; Parse the whole system.
+ ((semantic-parse-tree-needs-rebuild-p)
+ ;; Use Emacs's built-in progress-reporter (only interactive).
+ (if noninteractive
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (let ((semantic--progress-reporter
+ (and (>= (point-max) semantic-minimum-working-buffer-size)
+ (eq semantic-working-type 'percent)
+ (make-progress-reporter
+ (semantic-parser-working-message (buffer-name))
+ 0 100))))
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (if semantic--progress-reporter
+ (progress-reporter-done semantic--progress-reporter))))
+
+ ;; Clear the caches when we see there were no errors.
+ ;; But preserve the unmatched syntax cache and warnings!
+ (let (semantic-unmatched-syntax-cache
+ semantic-unmatched-syntax-cache-check
+ semantic-parser-warnings)
+ (semantic-clear-toplevel-cache))
+ ;; Set up the new overlays
+ (semantic--tag-link-list-to-buffer res)
+ ;; Set up the cache with the new results
+ (semantic--set-buffer-cache res)
+ ))))
;; Always return the current parse tree.
semantic--buffer-cache)
@@ -775,8 +769,8 @@ This function returns semantic tags without overlays."
(eq semantic-working-type 'percent)
(progress-reporter-update
semantic--progress-reporter
- (/ (* 100 (semantic-lex-token-start (car stream)))
- (point-max))))))
+ (floor (* 100.0 (semantic-lex-token-start (car stream)))
+ (point-max))))))
result))
;;; Parsing Warnings:
@@ -1134,8 +1128,16 @@ Semantic mode.
;; Add semantic-ia-complete-symbol to
;; completion-at-point-functions, so that it is run from
;; M-TAB.
+ ;;
+ ;; Note: The first entry added is the last entry run, so the
+ ;; most specific entry should be last.
+ (add-hook 'completion-at-point-functions
+ 'semantic-analyze-nolongprefix-completion-at-point-function)
+ (add-hook 'completion-at-point-functions
+ 'semantic-analyze-notc-completion-at-point-function)
(add-hook 'completion-at-point-functions
- 'semantic-completion-at-point-function)
+ 'semantic-analyze-completion-at-point-function)
+
(if global-ede-mode
(define-key cedet-menu-map [cedet-menu-separator] '("--")))
(dolist (b (buffer-list))
@@ -1147,7 +1149,12 @@ Semantic mode.
;; Semantic can be re-activated cleanly.
(remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
(remove-hook 'completion-at-point-functions
- 'semantic-completion-at-point-function)
+ 'semantic-analyze-completion-at-point-function)
+ (remove-hook 'completion-at-point-functions
+ 'semantic-analyze-notc-completion-at-point-function)
+ (remove-hook 'completion-at-point-functions
+ 'semantic-analyze-nolongprefix-completion-at-point-function)
+
(remove-hook 'after-change-functions
'semantic-change-function)
(define-key cedet-menu-map [cedet-menu-separator] nil)
@@ -1163,8 +1170,56 @@ Semantic mode.
;; re-activated.
(setq semantic-new-buffer-fcn-was-run nil)))
-(defun semantic-completion-at-point-function ()
- 'semantic-ia-complete-symbol)
+;;; Completion At Point functions
+(defun semantic-analyze-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions'.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions ctxt)))
+
+ ;; The return from this is either:
+ ;; nil - not applicable here.
+ ;; A list: (START END COLLECTION . PROPS)
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
+
+(defun semantic-analyze-notc-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions',
+but with the 'no-tc option passed in, which means constraints based
+on what is being assigned to are ignored.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions ctxt 'no-tc)))
+
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
+
+(defun semantic-analyze-nolongprefix-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions',
+but with the 'no-tc and 'no-longprefix option passed in, which means
+constraints resulting in a long multi-symbol dereference are ignored.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions
+ ctxt 'no-tc 'no-longprefix)))
+
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
;;; Autoload some functions that are not in semantic/loaddefs
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index 000193d4a55..fe888f57767 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,6 +1,6 @@
;;; semantic/analyze.el --- Analyze semantic tags against local context
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -168,7 +168,7 @@ of the parent function.")
;;
;; Simple methods against the context classes.
;;
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze."
@@ -189,17 +189,17 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
)
desired-type))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-functionarg))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (oref context argument))))
+ (cl-call-next-method context (car (oref context argument))))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-assignment))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (reverse (oref context assignee)))))
+ (cl-call-next-method context (car (reverse (oref context assignee)))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context))
"Return a tag from CONTEXT that would be most interesting to a user."
(let ((prefix (reverse (oref context :prefix))))
@@ -209,15 +209,15 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; Return the found tag, or nil.
(car prefix)))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-functionarg))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :function))))
+ (or (cl-call-next-method) (car-safe (oref context :function))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-assignment))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :assignee))))
+ (or (cl-call-next-method) (car-safe (oref context :assignee))))
;;; ANALYSIS
;;
@@ -226,8 +226,8 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; by an application that doesn't need to calculate the full
;; context.
-(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
- scope typereturn throwsym)
+(define-overloadable-function semantic-analyze-find-tag-sequence
+ (sequence &optional scope typereturn throwsym &rest flags)
"Attempt to find all tags in SEQUENCE.
Optional argument LOCALVAR is the list of local variables to use when
finding the details on the first element of SEQUENCE in case
@@ -237,53 +237,67 @@ scoped. These are not local variables, but symbols available in a structure
which doesn't need to be dereferenced.
Optional argument TYPERETURN is a symbol in which the types of all found
will be stored. If nil, that data is thrown away.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.")
-(defun semantic-analyze-find-tag-sequence-default (sequence &optional
- scope typereturn
- throwsym)
+(defun semantic-analyze-find-tag-sequence-default
+ ;; Note: overloadable fcn uses &rest, but it is a list already, so we don't need
+ ;; to do that in the -default.
+ (sequence &optional scope typereturn throwsym flags)
"Attempt to find all tags in SEQUENCE.
SCOPE are extra tags which are in scope.
TYPERETURN is a symbol in which to place a list of tag classes that
are found in SEQUENCE.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.
+This function knows of flags:
+ `mustbeclassvariable'"
(let ((s sequence) ; copy of the sequence
(tmp nil) ; tmp find variable
(tag nil) ; tag return list
(tagtype nil) ; tag types return list
(fname nil)
(miniscope (when scope (clone scope)))
+ (tagclass (if (memq 'mustbeclassvariable flags)
+ 'variable nil))
)
;; First order check. Is this wholly contained in the typecache?
(setq tmp (semanticdb-typecache-find sequence))
- (if tmp
- (progn
+ (when tmp
+ (if (or (not tagclass) (semantic-tag-of-class-p tmp tagclass))
;; We are effectively done...
- (setq s nil)
- (setq tag (list tmp)))
-
- ;; For the first entry, it better be a variable, but it might
- ;; be in the local context too.
- ;; NOTE: Don't forget c++ namespace foo::bar.
- (setq tmp (or
- ;; Is this tag within our scope. Scopes can sometimes
- ;; shadow other things, so it goes first.
- (and scope (semantic-scope-find (car s) nil scope))
- ;; Find the tag out there... somewhere, but not in scope
- (semantic-analyze-find-tag (car s))
- ))
-
- (if (and (listp tmp) (semantic-tag-p (car tmp)))
- (setq tmp (semantic-analyze-select-best-tag tmp)))
- (if (not (semantic-tag-p tmp))
- (if throwsym
- (throw throwsym "Cannot find definition")
- (error "Cannot find definition for \"%s\"" (car s))))
- (setq s (cdr s))
- (setq tag (cons tmp tag)) ; tag is nil here...
- (setq fname (semantic-tag-file-name tmp))
- )
+ (setq s nil
+ tag (list tmp))
+ ;; tagclass doesn't match, so fail this.
+ (setq tmp nil)))
+
+ (unless tmp
+ ;; For tag class filtering, only apply the filter if the first entry
+ ;; is also the only entry.
+ (let ((lftagclass (if (= (length s) 1) tagclass)))
+
+ ;; For the first entry, it better be a variable, but it might
+ ;; be in the local context too.
+ ;; NOTE: Don't forget c++ namespace foo::bar.
+ (setq tmp (or
+ ;; Is this tag within our scope. Scopes can sometimes
+ ;; shadow other things, so it goes first.
+ (and scope (semantic-scope-find (car s) lftagclass scope))
+ ;; Find the tag out there... somewhere, but not in scope
+ (semantic-analyze-find-tag (car s) lftagclass)
+ ))
+
+ (if (and (listp tmp) (semantic-tag-p (car tmp)))
+ (setq tmp (semantic-analyze-select-best-tag tmp lftagclass)))
+ (if (not (semantic-tag-p tmp))
+ (if throwsym
+ (throw throwsym "Cannot find definition")
+ (error "Cannot find definition for \"%s\"" (car s))))
+ (setq s (cdr s))
+ (setq tag (cons tmp tag)) ; tag is nil here...
+ (setq fname (semantic-tag-file-name tmp))
+ ))
;; For the middle entries
(while s
@@ -295,18 +309,10 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
;; In some cases the found TMP is a type,
;; and we can use it directly.
(cond ((semantic-tag-of-class-p tmp 'type)
- ;; update the miniscope when we need to analyze types directly.
- (when miniscope
- (let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
- tagtype))))
- (oset miniscope fullscope rawscope)))
- ;; Now analyze the type to remove metatypes.
(or (semantic-analyze-type tmp miniscope)
tmp))
(t
- (semantic-analyze-tag-type tmp scope))))
+ (semantic-analyze-tag-type tmp miniscope))))
(typefile
(when tmptype
(semantic-tag-file-name tmptype)))
@@ -336,6 +342,11 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
(semantic--tag-put-property tmp :filename fname))
(setq tag (cons tmp tag))
(setq tagtype (cons tmptype tagtype))
+ (when miniscope
+ (let ((rawscope
+ (apply 'append
+ (mapcar 'semantic-tag-type-members tagtype))))
+ (oset miniscope fullscope rawscope)))
)
(setq s (cdr s)))
@@ -385,7 +396,8 @@ searches use the same arguments."
;; Search in the typecache. First entries in a sequence are
;; often there.
(setq retlist (semanticdb-typecache-find name))
- (if retlist
+ (if (and retlist (or (not tagclass)
+ (semantic-tag-of-class-p retlist 'tagclass)))
retlist
(semantic-analyze-select-best-tag
(semanticdb-strip-find-results
@@ -650,7 +662,7 @@ Returns an object based on symbol `semantic-analyze-context'."
;; We have some sort of an assignment
(condition-case err
(setq asstag (semantic-analyze-find-tag-sequence
- assign scope))
+ assign scope nil nil 'mustbeclassvariable))
(error (semantic-analyze-push-error err)
nil)))
@@ -697,7 +709,7 @@ Returns nil if no alias was found."
(when (eq (semantic-tag-get-attribute (car taglist) :kind) 'alias)
(let ((tagname
(semantic-analyze-split-name
- (semantic-tag-name
+ (semantic-tag-name
(car (semantic-tag-get-attribute (car taglist) :members))))))
(append (if (listp tagname)
tagname
@@ -731,7 +743,7 @@ Optional argument CTXT is the context to show."
;;
(declare-function pulse-momentary-highlight-region "pulse")
-(defmethod semantic-analyze-pulse ((context semantic-analyze-context))
+(cl-defmethod semantic-analyze-pulse ((context semantic-analyze-context))
"Pulse the region that CONTEXT affects."
(require 'pulse)
(with-current-buffer (oref context :buffer)
@@ -749,24 +761,28 @@ Some useful functions are found in `semantic-format-tag-functions'."
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
+ ;; If there is no sequence, at least show the field as being empty.
+ (unless sequence (princ prefix) (princ "<none>\n"))
+
+ ;; Display the sequence column aligned.
(while sequence
- (princ prefix)
- (cond
- ((semantic-tag-p (car sequence))
- (princ (funcall semantic-analyze-summary-function
- (car sequence))))
- ((stringp (car sequence))
- (princ "\"")
- (princ (semantic--format-colorize-text (car sequence) 'variable))
- (princ "\""))
- (t
- (princ (format "'%S" (car sequence)))))
- (princ "\n")
- (setq sequence (cdr sequence))
- (setq prefix (make-string (length prefix) ? ))
- ))
-
-(defmethod semantic-analyze-show ((context semantic-analyze-context))
+ (princ prefix)
+ (cond
+ ((semantic-tag-p (car sequence))
+ (princ (funcall semantic-analyze-summary-function
+ (car sequence))))
+ ((stringp (car sequence))
+ (princ "\"")
+ (princ (semantic--format-colorize-text (car sequence) 'variable))
+ (princ "\""))
+ (t
+ (princ (format "'%S" (car sequence)))))
+ (princ "\n")
+ (setq sequence (cdr sequence))
+ (setq prefix (make-string (length prefix) ? ))
+ ))
+
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
(semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
@@ -780,19 +796,19 @@ Use BUFF as a source of override methods."
(semantic-analyze-show (oref context scope)))
)
-(defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context function) "Function: ")
(princ "Argument Index: ")
(princ (oref context index))
(princ "\n")
(semantic-analyze-princ-sequence (oref context argument) "Argument: ")
- (call-next-method))
+ (cl-call-next-method))
(defun semantic-analyze-pop-to-context (context)
"Display CONTEXT in a temporary buffer.
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 7e225d04683..680a0ae65bd 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/complete.el --- Smart Completions
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -112,8 +112,9 @@ in a buffer."
Argument CONTEXT is an object specifying the locally derived context.
The optional argument FLAGS changes which return options are returned.
FLAGS can be any number of:
- 'no-tc - do not apply data-type constraint.
- 'no-unique - do not apply unique by name filtering."
+ `no-tc' - do not apply data-type constraint.
+ `no-longprefix' - ignore long multi-symbol prefixes.
+ `no-unique' - do not apply unique by name filtering."
(let* ((a context)
(desired-type (semantic-analyze-type-constraint a))
(desired-class (oref a prefixclass))
@@ -127,9 +128,16 @@ FLAGS can be any number of:
(c nil)
(any nil)
(do-typeconstraint (not (memq 'no-tc flags)))
+ (do-longprefix (not (memq 'no-longprefix flags)))
(do-unique (not (memq 'no-unique flags)))
)
+ (when (not do-longprefix)
+ ;; If we are not doing the long prefix, shorten all the key
+ ;; elements.
+ (setq prefix (list (car (reverse prefix)))
+ prefixtypes nil))
+
;; Calculate what our prefix string is so that we can
;; find all our matching text.
(setq completetext (car (reverse prefix)))
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 65bcfd709e5..76a6cc2f9b2 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/debug.el --- Debug the analyzer
-;;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -405,7 +405,8 @@ or implementing a version specific to ")
(princ "\n\nInclude Path Summary:")
(when edeobj
- (princ "\n\nThis file's project include search is handled by the EDE object:\n")
+ (princ (substitute-command-keys
+ "\n\nThis file's project include search is handled by the EDE object:\n"))
(princ " Buffer Target: ")
(princ (object-print edeobj))
(princ "\n")
@@ -463,12 +464,12 @@ or implementing a version specific to ")
(princ "\nYou can fix the include path for ")
(princ (symbol-name (oref table major-mode)))
- (princ " by using this function:
+ (princ (substitute-command-keys " by using this function:
-M-x semantic-customize-system-include-path RET
+\\[semantic-customize-system-include-path]
which customizes the mode specific variable for the mode-local
-variable `semantic-dependency-system-include-path'.")
+variable `semantic-dependency-system-include-path'."))
)
(princ "\n No unknown includes.\n"))
@@ -512,7 +513,7 @@ Optional argument CLASSCONSTRAINT says to output to tags of that class."
)
(defun semantic-analyzer-debug-global-miss-text (name-in)
- "Use 'princ' to show text describing not finding symbol NAME-IN.
+ "Use `princ' to show text describing not finding symbol NAME-IN.
NAME is the name of the unfound symbol."
(let ((name (cond ((stringp name-in)
name-in)
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index 7512b7ca15a..4b105c1e5b4 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/fcn.el --- Analyzer support functions.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 93dd710a67d..3047dab5280 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/refs.el --- Analysis of the references between tags.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -100,7 +100,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
;;
;; These accessor methods will calculate the useful bits from the context, and cache values
;; into the context.
-(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
"Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
@@ -109,7 +109,7 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
)
(semanticdb-find-result-mapc
(lambda (T DB)
- "Examine T in the database DB, and sont it."
+ "Examine T in the database DB, and sort it."
(let* ((ans (semanticdb-normalize-one-tag DB T))
(aT (cdr ans))
(aDB (car ans))
@@ -118,13 +118,14 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT impl))))
allhits)
impl))
-(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
"Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
@@ -141,7 +142,8 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT proto))))
allhits)
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index af7e3f66507..ef28fb9205f 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -1,6 +1,6 @@
;;; semantic/bovine.el --- LL Parser/Analyzer core.
-;; Copyright (C) 1999-2004, 2006-2007, 2009-2013 Free Software
+;; Copyright (C) 1999-2004, 2006-2007, 2009-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el
deleted file mode 100644
index af3724a32c8..00000000000
--- a/lisp/cedet/semantic/bovine/c-by.el
+++ /dev/null
@@ -1,2224 +0,0 @@
-;;; semantic/bovine/c-by.el --- Generated parser support file
-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/c.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-c-reconstitute-token "semantic/bovine/c"
- (tokenpart declmods typedecl))
-(declare-function semantic-c-reconstitute-template "semantic/bovine/c"
- (tag specifier))
-(declare-function semantic-expand-c-tag "semantic/bovine/c" (tag))
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst semantic-c-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("extern" . EXTERN)
- ("static" . STATIC)
- ("const" . CONST)
- ("volatile" . VOLATILE)
- ("register" . REGISTER)
- ("signed" . SIGNED)
- ("unsigned" . UNSIGNED)
- ("inline" . INLINE)
- ("virtual" . VIRTUAL)
- ("mutable" . MUTABLE)
- ("explicit" . EXPLICIT)
- ("struct" . STRUCT)
- ("union" . UNION)
- ("enum" . ENUM)
- ("typedef" . TYPEDEF)
- ("class" . CLASS)
- ("typename" . TYPENAME)
- ("namespace" . NAMESPACE)
- ("using" . USING)
- ("new" . NEW)
- ("delete" . DELETE)
- ("template" . TEMPLATE)
- ("throw" . THROW)
- ("reentrant" . REENTRANT)
- ("try" . TRY)
- ("catch" . CATCH)
- ("operator" . OPERATOR)
- ("public" . PUBLIC)
- ("private" . PRIVATE)
- ("protected" . PROTECTED)
- ("friend" . FRIEND)
- ("if" . IF)
- ("else" . ELSE)
- ("do" . DO)
- ("while" . WHILE)
- ("for" . FOR)
- ("switch" . SWITCH)
- ("case" . CASE)
- ("default" . DEFAULT)
- ("return" . RETURN)
- ("break" . BREAK)
- ("continue" . CONTINUE)
- ("sizeof" . SIZEOF)
- ("void" . VOID)
- ("char" . CHAR)
- ("wchar_t" . WCHAR)
- ("short" . SHORT)
- ("int" . INT)
- ("long" . LONG)
- ("float" . FLOAT)
- ("double" . DOUBLE)
- ("bool" . BOOL)
- ("_P" . UNDERP)
- ("__P" . UNDERUNDERP))
- '(("__P" summary "Common macro to eliminate prototype compatibility on some compilers")
- ("_P" summary "Common macro to eliminate prototype compatibility on some compilers")
- ("bool" summary "Primitive boolean type")
- ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
- ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
- ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
- ("int" summary "Integral Primitive Type: (-2147483648 to 2147483647)")
- ("short" summary "Integral Primitive Type: (-32768 to 32767)")
- ("wchar_t" summary "Wide Character Type")
- ("char" summary "Integral Character Type: (0 to 256)")
- ("void" summary "Built in typeless type: void")
- ("sizeof" summary "Compile time macro: sizeof(<type or variable>) // size in bytes")
- ("continue" summary "Non-local continue within a loop (for, do/while): continue;")
- ("break" summary "Non-local exit within a loop or switch (for, do/while, switch): break;")
- ("return" summary "return <value>;")
- ("default" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("case" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("switch" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("for" summary "for(<init>; <condition>; <increment>) { code }")
- ("while" summary "do { code } while (<condition>); or while (<condition>) { code };")
- ("do" summary " do { code } while (<condition>);")
- ("else" summary "if (<condition>) { code } [ else { code } ]")
- ("if" summary "if (<condition>) { code } [ else { code } ]")
- ("friend" summary "friend class <CLASSNAME>")
- ("catch" summary "try { <body> } catch { <catch code> }")
- ("try" summary "try { <body> } catch { <catch code> }")
- ("reentrant" summary "<type> <methoddef> (<method args>) reentrant ...")
- ("throw" summary "<type> <methoddef> (<method args>) throw (<exception>) ...")
- ("template" summary "template <class TYPE ...> TYPE_OR_FUNCTION")
- ("delete" summary "delete <object>;")
- ("new" summary "new <classname>();")
- ("using" summary "using <namespace>;")
- ("namespace" summary "Namespace Declaration: namespace <name> { ... };")
- ("typename" summary "typename is used to handle a qualified name as a typename;")
- ("class" summary "Class Declaration: class <name>[:parents] { ... };")
- ("typedef" summary "Arbitrary Type Declaration: typedef <typedeclaration> <name>;")
- ("enum" summary "Enumeration Type Declaration: enum [name] { ... };")
- ("union" summary "Union Type Declaration: union [name] { ... };")
- ("struct" summary "Structure Type Declaration: struct [name] { ... };")
- ("explicit" summary "Forbids implicit type conversion: explicit <constructor>")
- ("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...")
- ("virtual" summary "Method Modifier: virtual <type> <name>(...) ...")
- ("inline" summary "Function Modifier: inline <return type> <name>(...) {...};")
- ("unsigned" summary "Numeric Type Modifier: unsigned <numeric type> <name> ...")
- ("signed" summary "Numeric Type Modifier: signed <numeric type> <name> ...")
- ("register" summary "Declaration Modifier: register <type> <name> ...")
- ("volatile" summary "Declaration Modifier: volatile <type> <name> ...")
- ("const" summary "Declaration Modifier: const <type> <name> ...")
- ("static" summary "Declaration Modifier: static <type> <name> ...")
- ("extern" summary "Declaration Modifier: extern <type> <name> ...")))
- "Table of language keywords.")
-
-(defconst semantic-c-by--token-table
- (semantic-lex-make-type-table
- '(("semantic-list"
- (BRACKETS . "\\[\\]")
- (PARENS . "()")
- (VOID_BLCK . "^(void)$")
- (BRACE_BLCK . "^{")
- (PAREN_BLCK . "^(")
- (BRACK_BLCK . "\\[.*\\]$"))
- ("close-paren"
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACE . "{")
- (LPAREN . "("))
- ("symbol"
- (RESTRICT . "\\<\\(__\\)?restrict\\>"))
- ("number"
- (ZERO . "^0$"))
- ("string"
- (CPP . "\"C\\+\\+\"")
- (C . "\"C\""))
- ("punctuation"
- (OR . "\\`[|]\\'")
- (HAT . "\\`\\^\\'")
- (MOD . "\\`[%]\\'")
- (TILDE . "\\`[~]\\'")
- (COMA . "\\`[,]\\'")
- (GREATER . "\\`[>]\\'")
- (LESS . "\\`[<]\\'")
- (EQUAL . "\\`[=]\\'")
- (BANG . "\\`[!]\\'")
- (MINUS . "\\`[-]\\'")
- (PLUS . "\\`[+]\\'")
- (DIVIDE . "\\`[/]\\'")
- (AMPERSAND . "\\`[&]\\'")
- (STAR . "\\`[*]\\'")
- (SEMICOLON . "\\`[;]\\'")
- (COLON . "\\`[:]\\'")
- (PERIOD . "\\`[.]\\'")
- (HASH . "\\`[#]\\'")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-c-by--parse-table
- `(
- (bovine-toplevel
- (declaration)
- ) ;; end bovine-toplevel
-
- (bovine-inner-scope
- (codeblock)
- ) ;; end bovine-inner-scope
-
- (declaration
- (macro)
- (type)
- (define)
- (var-or-fun)
- (extern-c)
- (template)
- (using)
- ) ;; end declaration
-
- (codeblock
- (define)
- (codeblock-var-or-fun)
- (type)
- (using)
- ) ;; end codeblock
-
- (extern-c-contents
- (open-paren
- ,(semantic-lambda
- (list nil))
- )
- (declaration)
- (close-paren
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end extern-c-contents
-
- (extern-c
- (EXTERN
- string
- "\"C\""
- semantic-list
- ,(semantic-lambda
- (semantic-tag
- "C"
- 'extern :members
- (semantic-parse-region
- (car
- (nth 2 vals))
- (cdr
- (nth 2 vals))
- 'extern-c-contents
- 1)))
- )
- (EXTERN
- string
- "\"C\\+\\+\""
- semantic-list
- ,(semantic-lambda
- (semantic-tag
- "C"
- 'extern :members
- (semantic-parse-region
- (car
- (nth 2 vals))
- (cdr
- (nth 2 vals))
- 'extern-c-contents
- 1)))
- )
- (EXTERN
- string
- "\"C\""
- ,(semantic-lambda
- (list nil))
- )
- (EXTERN
- string
- "\"C\\+\\+\""
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end extern-c
-
- (macro
- (spp-macro-def
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil nil :constant-flag t))
- )
- (spp-system-include
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 0 vals) t))
- )
- (spp-include
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 0 vals) nil))
- )
- ) ;; end macro
-
- (define
- (spp-macro-def
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil nil :constant-flag t))
- )
- (spp-macro-undef
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end define
-
- (unionparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'classsubparts
- 1))
- )
- ) ;; end unionparts
-
- (opt-symbol
- (symbol)
- ( ;;EMPTY
- )
- ) ;; end opt-symbol
-
- (classsubparts
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (class-protection
- opt-symbol
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 0 vals))
- 'label))
- )
- (var-or-fun)
- (FRIEND
- func-decl
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 1 vals))
- 'friend))
- )
- (FRIEND
- CLASS
- symbol
- ,(semantic-lambda
- (semantic-tag
- (nth 2 vals)
- 'friend))
- )
- (type)
- (define)
- (template)
- ( ;;EMPTY
- )
- ) ;; end classsubparts
-
- (opt-class-parents
- (punctuation
- "\\`[:]\\'"
- class-parents
- opt-template-specifier
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-class-parents
-
- (one-class-parent
- (opt-class-protection
- opt-class-declmods
- namespace-symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- "class" nil nil :protection
- (car
- (nth 0 vals))))
- )
- (opt-class-declmods
- opt-class-protection
- namespace-symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- "class" nil nil :protection
- (car
- (nth 1 vals))))
- )
- ) ;; end one-class-parent
-
- (class-parents
- (one-class-parent
- punctuation
- "\\`[,]\\'"
- class-parents
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (one-class-parent
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end class-parents
-
- (opt-class-declmods
- (class-declmods
- opt-class-declmods
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-class-declmods
-
- (class-declmods
- (VIRTUAL)
- ) ;; end class-declmods
-
- (class-protection
- (PUBLIC)
- (PRIVATE)
- (PROTECTED)
- ) ;; end class-protection
-
- (opt-class-protection
- (class-protection
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- "unspecified"))
- )
- ) ;; end opt-class-protection
-
- (namespaceparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'namespacesubparts
- 1))
- )
- ) ;; end namespaceparts
-
- (namespacesubparts
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (type)
- (var-or-fun)
- (define)
- (class-protection
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 0 vals))
- 'label))
- )
- (template)
- (using)
- (spp-include
- ,(semantic-lambda
- (semantic-tag
- (nth 0 vals)
- 'include :inside-ns t))
- )
- ( ;;EMPTY
- )
- ) ;; end namespacesubparts
-
- (enumparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'enumsubparts
- 1))
- )
- ) ;; end enumparts
-
- (enumsubparts
- (symbol
- opt-assign
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals)
- "int"
- (car
- (nth 1 vals)) :constant-flag t))
- )
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (punctuation
- "\\`[,]\\'"
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end enumsubparts
-
- (opt-name
- (symbol)
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- ""))
- )
- ) ;; end opt-name
-
- (typesimple
- (struct-or-class
- opt-class
- opt-name
- opt-template-specifier
- opt-class-parents
- semantic-list
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (car
- (nth 0 vals))
- (let
- (
- (semantic-c-classname
- (cons
- (car
- (nth 2 vals))
- (car
- (nth 0 vals)))))
- (semantic-parse-region
- (car
- (nth 5 vals))
- (cdr
- (nth 5 vals))
- 'classsubparts
- 1))
- (nth 4 vals) :template-specifier
- (nth 3 vals) :parent
- (car
- (nth 1 vals))))
- )
- (struct-or-class
- opt-class
- opt-name
- opt-template-specifier
- opt-class-parents
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (car
- (nth 0 vals)) nil
- (nth 4 vals) :template-specifier
- (nth 3 vals) :prototype t :parent
- (car
- (nth 1 vals))))
- )
- (UNION
- opt-class
- opt-name
- unionparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (nth 0 vals)
- (nth 3 vals) nil :parent
- (car
- (nth 1 vals))))
- )
- (ENUM
- opt-class
- opt-name
- enumparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (nth 0 vals)
- (nth 3 vals) nil :parent
- (car
- (nth 1 vals))))
- )
- (TYPEDEF
- declmods
- typeformbase
- cv-declmods
- typedef-symbol-list
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 4 vals)
- (nth 0 vals) nil
- (list
- (nth 2 vals))))
- )
- ) ;; end typesimple
-
- (typedef-symbol-list
- (typedefname
- punctuation
- "\\`[,]\\'"
- typedef-symbol-list
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (typedefname
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end typedef-symbol-list
-
- (typedefname
- (opt-stars
- symbol
- opt-bits
- opt-array
- ,(semantic-lambda
- (list
- (nth 0 vals)
- (nth 1 vals)))
- )
- ) ;; end typedefname
-
- (struct-or-class
- (STRUCT)
- (CLASS)
- ) ;; end struct-or-class
-
- (type
- (typesimple
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (nth 0 vals))
- )
- (NAMESPACE
- symbol
- namespaceparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals)
- (nth 2 vals) nil))
- )
- (NAMESPACE
- namespaceparts
- ,(semantic-lambda
- (semantic-tag-new-type
- "unnamed"
- (nth 0 vals)
- (nth 1 vals) nil))
- )
- (NAMESPACE
- symbol
- punctuation
- "\\`[=]\\'"
- typeformbase
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals)
- (list
- (semantic-tag-new-type
- (car
- (nth 3 vals))
- (nth 0 vals) nil nil)) nil :kind
- 'alias))
- )
- ) ;; end type
-
- (using
- (USING
- usingname
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 1 vals))
- 'using :type
- (nth 1 vals)))
- )
- ) ;; end using
-
- (usingname
- (typeformbase
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 0 vals))
- "class" nil nil :prototype t))
- )
- (NAMESPACE
- typeformbase
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 1 vals))
- "namespace" nil nil :prototype t))
- )
- ) ;; end usingname
-
- (template
- (TEMPLATE
- template-specifier
- opt-friend
- template-definition
- ,(semantic-lambda
- (semantic-c-reconstitute-template
- (nth 3 vals)
- (nth 1 vals)))
- )
- ) ;; end template
-
- (opt-friend
- (FRIEND)
- ( ;;EMPTY
- )
- ) ;; end opt-friend
-
- (opt-template-specifier
- (template-specifier
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-template-specifier
-
- (template-specifier
- (punctuation
- "\\`[<]\\'"
- template-specifier-types
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (nth 1 vals))
- )
- ) ;; end template-specifier
-
- (template-specifier-types
- (template-var
- template-specifier-type-list
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- )
- ) ;; end template-specifier-types
-
- (template-specifier-type-list
- (punctuation
- "\\`[,]\\'"
- template-specifier-types
- ,(semantic-lambda
- (nth 1 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end template-specifier-type-list
-
- (template-var
- (template-type
- opt-template-equal
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))))
- )
- (string
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (number
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (opt-stars
- opt-ref
- namespace-symbol
- ,(semantic-lambda
- (nth 2 vals))
- )
- (semantic-list
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (SIZEOF
- semantic-list
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end template-var
-
- (opt-template-equal
- (punctuation
- "\\`[=]\\'"
- symbol
- punctuation
- "\\`[<]\\'"
- template-specifier-types
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- (punctuation
- "\\`[=]\\'"
- symbol
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-template-equal
-
- (template-type
- (CLASS
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "class" nil nil))
- )
- (STRUCT
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "struct" nil nil))
- )
- (TYPENAME
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "class" nil nil))
- )
- (declmods
- typeformbase
- cv-declmods
- opt-stars
- opt-ref
- variablearg-opt-name
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 1 vals)) nil nil nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) :reference
- (car
- (nth 4 vals)) :pointer
- (car
- (nth 3 vals))))
- )
- ) ;; end template-type
-
- (template-definition
- (type
- ,(semantic-lambda
- (nth 0 vals))
- )
- (var-or-fun
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end template-definition
-
- (opt-stars
- (punctuation
- "\\`[*]\\'"
- opt-starmod
- opt-stars
- ,(semantic-lambda
- (list
- (1+
- (car
- (nth 2 vals)))))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- 0))
- )
- ) ;; end opt-stars
-
- (opt-starmod
- (STARMOD
- opt-starmod
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-starmod
-
- (STARMOD
- (CONST)
- ) ;; end STARMOD
-
- (declmods
- (DECLMOD
- declmods
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- (DECLMOD
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end declmods
-
- (DECLMOD
- (EXTERN)
- (STATIC)
- (CVDECLMOD)
- (INLINE)
- (REGISTER)
- (FRIEND)
- (TYPENAME)
- (METADECLMOD)
- (VIRTUAL)
- ) ;; end DECLMOD
-
- (metadeclmod
- (METADECLMOD
- ,(semantic-lambda)
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end metadeclmod
-
- (CVDECLMOD
- (CONST)
- (VOLATILE)
- ) ;; end CVDECLMOD
-
- (cv-declmods
- (CVDECLMOD
- cv-declmods
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- (CVDECLMOD
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end cv-declmods
-
- (METADECLMOD
- (VIRTUAL)
- (MUTABLE)
- ) ;; end METADECLMOD
-
- (opt-ref
- (punctuation
- "\\`[&]\\'"
- ,(semantic-lambda
- (list
- 1))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- 0))
- )
- ) ;; end opt-ref
-
- (typeformbase
- (typesimple
- ,(semantic-lambda
- (nth 0 vals))
- )
- (STRUCT
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (UNION
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (ENUM
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (builtintype
- ,(semantic-lambda
- (nth 0 vals))
- )
- (symbol
- template-specifier
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 0 vals)
- "class" nil nil :template-specifier
- (nth 1 vals)))
- )
- (namespace-symbol-for-typeformbase
- opt-template-specifier
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 0 vals))
- "class" nil nil :template-specifier
- (nth 1 vals)))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end typeformbase
-
- (signedmod
- (UNSIGNED)
- (SIGNED)
- ) ;; end signedmod
-
- (builtintype-types
- (VOID)
- (CHAR)
- (WCHAR)
- (SHORT
- INT
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (SHORT)
- (INT)
- (LONG
- INT
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (FLOAT)
- (DOUBLE)
- (BOOL)
- (LONG
- DOUBLE
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (LONG
- LONG
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (LONG)
- ) ;; end builtintype-types
-
- (builtintype
- (signedmod
- builtintype-types
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- " "
- (car
- (nth 1 vals)))))
- )
- (builtintype-types
- ,(semantic-lambda
- (nth 0 vals))
- )
- (signedmod
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- " int")))
- )
- ) ;; end builtintype
-
- (codeblock-var-or-fun
- (declmods
- typeformbase
- declmods
- opt-ref
- var-or-func-decl
- ,(semantic-lambda
- (semantic-c-reconstitute-token
- (nth 4 vals)
- (nth 0 vals)
- (nth 1 vals)))
- )
- ) ;; end codeblock-var-or-fun
-
- (var-or-fun
- (codeblock-var-or-fun
- ,(semantic-lambda
- (nth 0 vals))
- )
- (declmods
- var-or-func-decl
- ,(semantic-lambda
- (semantic-c-reconstitute-token
- (nth 1 vals)
- (nth 0 vals) nil))
- )
- ) ;; end var-or-fun
-
- (var-or-func-decl
- (func-decl
- ,(semantic-lambda
- (nth 0 vals))
- )
- (var-decl
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end var-or-func-decl
-
- (func-decl
- (opt-stars
- opt-class
- opt-destructor
- functionname
- opt-template-specifier
- opt-under-p
- arg-list
- opt-post-fcn-modifiers
- opt-throw
- opt-initializers
- fun-or-proto-end
- ,(semantic-lambda
- (nth 3 vals)
- (list
- 'function
- (nth 1 vals)
- (nth 2 vals)
- (nth 6 vals)
- (nth 8 vals)
- (nth 7 vals))
- (nth 0 vals)
- (nth 10 vals)
- (list
- (nth 4 vals))
- (nth 9 vals))
- )
- (opt-stars
- opt-class
- opt-destructor
- functionname
- opt-template-specifier
- opt-under-p
- opt-post-fcn-modifiers
- opt-throw
- opt-initializers
- fun-try-end
- ,(semantic-lambda
- (nth 3 vals)
- (list
- 'function
- (nth 1 vals)
- (nth 2 vals) nil
- (nth 7 vals)
- (nth 6 vals))
- (nth 0 vals)
- (nth 9 vals)
- (list
- (nth 4 vals))
- (nth 8 vals))
- )
- ) ;; end func-decl
-
- (var-decl
- (varnamelist
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list
- (nth 0 vals)
- 'variable))
- )
- ) ;; end var-decl
-
- (opt-under-p
- (UNDERP
- ,(semantic-lambda
- (list nil))
- )
- (UNDERUNDERP
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-under-p
-
- (opt-initializers
- (punctuation
- "\\`[:]\\'"
- namespace-symbol
- semantic-list
- opt-initializers)
- (punctuation
- "\\`[,]\\'"
- namespace-symbol
- semantic-list
- opt-initializers)
- ( ;;EMPTY
- )
- ) ;; end opt-initializers
-
- (opt-post-fcn-modifiers
- (post-fcn-modifiers
- opt-post-fcn-modifiers
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-post-fcn-modifiers
-
- (post-fcn-modifiers
- (REENTRANT)
- (CONST)
- ) ;; end post-fcn-modifiers
-
- (opt-throw
- (THROW
- semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 1 vals))
- (cdr
- (nth 1 vals))
- 'throw-exception-list))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-throw
-
- (throw-exception-list
- (namespace-symbol
- punctuation
- "\\`[,]\\'"
- throw-exception-list
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 2 vals)))
- )
- (namespace-symbol
- close-paren
- ")"
- ,(semantic-lambda
- (nth 0 vals))
- )
- (symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (open-paren
- "("
- throw-exception-list
- ,(semantic-lambda
- (nth 1 vals))
- )
- (close-paren
- ")"
- ,(semantic-lambda)
- )
- ) ;; end throw-exception-list
-
- (opt-bits
- (punctuation
- "\\`[:]\\'"
- number
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-bits
-
- (opt-array
- (semantic-list
- "\\[.*\\]$"
- opt-array
- ,(semantic-lambda
- (list
- (cons
- 1
- (car
- (nth 1 vals)))))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-array
-
- (opt-assign
- (punctuation
- "\\`[=]\\'"
- expression
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-assign
-
- (opt-restrict
- (symbol
- "\\<\\(__\\)?restrict\\>")
- ( ;;EMPTY
- )
- ) ;; end opt-restrict
-
- (varname
- (opt-stars
- opt-restrict
- namespace-symbol
- opt-bits
- opt-array
- ,(semantic-lambda
- (nth 2 vals)
- (nth 0 vals)
- (nth 3 vals)
- (nth 4 vals))
- )
- ) ;; end varname
-
- (variablearg
- (declmods
- typeformbase
- cv-declmods
- opt-ref
- variablearg-opt-name
- ,(semantic-lambda
- (semantic-tag-new-variable
- (list
- (nth 4 vals))
- (nth 1 vals) nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) :reference
- (car
- (nth 3 vals))))
- )
- ) ;; end variablearg
-
- (variablearg-opt-name
- (varname
- ,(semantic-lambda
- (nth 0 vals))
- )
- (opt-stars
- ,(semantic-lambda
- (list
- "")
- (nth 0 vals)
- (list nil nil nil))
- )
- ) ;; end variablearg-opt-name
-
- (varname-opt-initializer
- (semantic-list)
- (opt-assign)
- ( ;;EMPTY
- )
- ) ;; end varname-opt-initializer
-
- (varnamelist
- (opt-ref
- varname
- varname-opt-initializer
- punctuation
- "\\`[,]\\'"
- varnamelist
- ,(semantic-lambda
- (cons
- (nth 1 vals)
- (nth 4 vals)))
- )
- (opt-ref
- varname
- varname-opt-initializer
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end varnamelist
-
- (namespace-symbol
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-symbol
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 4 vals)))))
- )
- (symbol
- opt-template-specifier
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-symbol
-
- (namespace-symbol-for-typeformbase
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-symbol-for-typeformbase
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 4 vals)))))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-symbol-for-typeformbase
-
- (namespace-opt-class
- (symbol
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-opt-class
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 3 vals)))))
- )
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-opt-class
-
- (opt-class
- (namespace-opt-class
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-class
-
- (opt-destructor
- (punctuation
- "\\`[~]\\'"
- ,(semantic-lambda
- (list t))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-destructor
-
- (arg-list
- (semantic-list
- "^("
- knr-arguments
- ,(semantic-lambda
- (nth 1 vals))
- )
- (semantic-list
- "^("
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'arg-sub-list
- 1))
- )
- (semantic-list
- "^(void)$"
- ,(semantic-lambda)
- )
- ) ;; end arg-list
-
- (knr-varnamelist
- (varname
- punctuation
- "\\`[,]\\'"
- knr-varnamelist
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (varname
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end knr-varnamelist
-
- (knr-one-variable-decl
- (declmods
- typeformbase
- cv-declmods
- knr-varnamelist
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nreverse
- (nth 3 vals))
- (nth 1 vals) nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (nth 2 vals))))
- )
- ) ;; end knr-one-variable-decl
-
- (knr-arguments
- (knr-one-variable-decl
- punctuation
- "\\`[;]\\'"
- knr-arguments
- ,(semantic-lambda
- (append
- (semantic-expand-c-tag
- (nth 0 vals))
- (nth 2 vals)))
- )
- (knr-one-variable-decl
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-expand-c-tag
- (nth 0 vals)))
- )
- ) ;; end knr-arguments
-
- (arg-sub-list
- (variablearg
- ,(semantic-lambda
- (nth 0 vals))
- )
- (punctuation
- "\\`[.]\\'"
- punctuation
- "\\`[.]\\'"
- punctuation
- "\\`[.]\\'"
- close-paren
- ")"
- ,(semantic-lambda
- (semantic-tag-new-variable
- "..."
- "vararg" nil))
- )
- (punctuation
- "\\`[,]\\'"
- ,(semantic-lambda
- (list nil))
- )
- (open-paren
- "("
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- ")"
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end arg-sub-list
-
- (operatorsym
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "<<="))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- ">>="))
- )
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[<]\\'"
- ,(semantic-lambda
- (list
- "<<"))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- ">>"))
- )
- (punctuation
- "\\`[=]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "=="))
- )
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "<="))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- ">="))
- )
- (punctuation
- "\\`[!]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "!="))
- )
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "+="))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "-="))
- )
- (punctuation
- "\\`[*]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "*="))
- )
- (punctuation
- "\\`[/]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "/="))
- )
- (punctuation
- "\\`[%]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "%="))
- )
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "&="))
- )
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "|="))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[*]\\'"
- ,(semantic-lambda
- (list
- "->*"))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- "->"))
- )
- (semantic-list
- "()"
- ,(semantic-lambda
- (list
- "()"))
- )
- (semantic-list
- "\\[\\]"
- ,(semantic-lambda
- (list
- "[]"))
- )
- (punctuation
- "\\`[<]\\'")
- (punctuation
- "\\`[>]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[+]\\'"
- ,(semantic-lambda
- (list
- "++"))
- )
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[-]\\'"
- ,(semantic-lambda
- (list
- "--"))
- )
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[&]\\'"
- ,(semantic-lambda
- (list
- "&&"))
- )
- (punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[|]\\'"
- ,(semantic-lambda
- (list
- "||"))
- )
- (punctuation
- "\\`[|]\\'")
- (punctuation
- "\\`[/]\\'")
- (punctuation
- "\\`[=]\\'")
- (punctuation
- "\\`[!]\\'")
- (punctuation
- "\\`[~]\\'")
- (punctuation
- "\\`[%]\\'")
- (punctuation
- "\\`[,]\\'")
- (punctuation
- "\\`\\^\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "^="))
- )
- (punctuation
- "\\`\\^\\'")
- ) ;; end operatorsym
-
- (functionname
- (OPERATOR
- operatorsym
- ,(semantic-lambda
- (nth 1 vals))
- )
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'function-pointer))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end functionname
-
- (function-pointer
- (open-paren
- "("
- punctuation
- "\\`[*]\\'"
- symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (concat
- "*"
- (nth 2 vals))))
- )
- (open-paren
- "("
- symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end function-pointer
-
- (fun-or-proto-end
- (punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list t))
- )
- (semantic-list
- ,(semantic-lambda
- (list nil))
- )
- (punctuation
- "\\`[=]\\'"
- number
- "^0$"
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list ':pure-virtual-flag))
- )
- (fun-try-end
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end fun-or-proto-end
-
- (fun-try-end
- (TRY
- opt-initializers
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end fun-try-end
-
- (fun-try-several-catches
- (CATCH
- semantic-list
- "^("
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda)
- )
- (CATCH
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda)
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end fun-try-several-catches
-
- (type-cast
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'type-cast-list))
- )
- ) ;; end type-cast
-
- (type-cast-list
- (open-paren
- typeformbase
- close-paren)
- ) ;; end type-cast-list
-
- (opt-stuff-after-symbol
- (semantic-list
- "^(")
- (semantic-list
- "\\[.*\\]$")
- ( ;;EMPTY
- )
- ) ;; end opt-stuff-after-symbol
-
- (multi-stage-dereference
- (namespace-symbol
- opt-stuff-after-symbol
- punctuation
- "\\`[.]\\'"
- multi-stage-dereference)
- (namespace-symbol
- opt-stuff-after-symbol
- punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- multi-stage-dereference)
- (namespace-symbol
- opt-stuff-after-symbol)
- ) ;; end multi-stage-dereference
-
- (string-seq
- (string
- string-seq
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- (car
- (nth 1 vals)))))
- )
- (string
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end string-seq
-
- (expr-start
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[&]\\'")
- ) ;; end expr-start
-
- (expr-binop
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[/]\\'")
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[|]\\'")
- (punctuation
- "\\`[|]\\'")
- ) ;; end expr-binop
-
- (expression
- (unaryexpression
- expr-binop
- unaryexpression
- ,(semantic-lambda
- (list
- (identity start)
- (identity end)))
- )
- (unaryexpression
- ,(semantic-lambda
- (list
- (identity start)
- (identity end)))
- )
- ) ;; end expression
-
- (unaryexpression
- (number)
- (multi-stage-dereference)
- (NEW
- multi-stage-dereference)
- (NEW
- builtintype-types
- semantic-list)
- (namespace-symbol)
- (string-seq)
- (type-cast
- expression)
- (semantic-list
- expression)
- (semantic-list)
- (expr-start
- expression)
- ) ;; end unaryexpression
- )
- "Parser table.")
-
-(defun semantic-c-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-c-by--parse-table
- semantic-debug-parser-source "c.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-c-by--keyword-table
- semantic-equivalent-major-modes '(c-mode c++-mode)
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/c-by)
-
-;;; semantic/bovine/c-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 3c991ea8555..1c25c7b0808 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/c.el --- Semantic details for C
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -27,6 +27,7 @@
(require 'semantic)
(require 'semantic/analyze)
+(require 'semantic/analyze/refs)
(require 'semantic/bovine)
(require 'semantic/bovine/gcc)
(require 'semantic/idle)
@@ -224,7 +225,7 @@ to store your global macros in a more natural way."
)
(defcustom semantic-c-member-of-autocast 't
- "Non-nil means classes with a '->' operator will cast to its return type.
+ "Non-nil means classes with a `->' operator will cast to its return type.
For Examples:
@@ -269,7 +270,7 @@ Return the defined symbol as a special spp lex token."
(if (looking-back "/\\*.*" beginning-of-define)
(progn
(goto-char (match-beginning 0))
- (1- (point)))
+ (point))
(point)))))
)
@@ -497,13 +498,19 @@ code to parse."
(parsedtokelist
(condition-case nil
;; This is imperfect, so always assume on error.
- (hif-canonicalize)
+ (hif-canonicalize hif-ifx-regexp)
(error nil))))
- (let ((eval-form (eval parsedtokelist)))
+ (let ((eval-form (condition-case err
+ (eval parsedtokelist)
+ (error
+ (semantic-push-parser-warning
+ (format "Hideif forms produced an error. Assuming false.\n%S" err)
+ (point) (1+ (point)))
+ nil))))
(if (or (not eval-form)
(and (numberp eval-form)
- (equal eval-form 0)));; ifdefline resulted in false
+ (equal eval-form 0)));; ifdef line resulted in false
;; The if indicates to skip this preprocessor section
(let ((pt nil))
@@ -812,7 +819,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro."
;; semantic-lex-spp-replace-or-symbol-or-keyword
semantic-lex-symbol-or-keyword
semantic-lex-charquote
- semantic-lex-paren-or-list
+ semantic-lex-spp-paren-or-list
semantic-lex-close-paren
semantic-lex-ignore-comments
semantic-lex-punctuation
@@ -1042,8 +1049,8 @@ now.
return-list))
(defun semantic-expand-c-extern-C (tag)
- "Expand TAG containing an 'extern \"C\"' statement.
-This will return all members of TAG with 'extern \"C\"' added to
+ "Expand TAG containing an `extern \"C\"' statement.
+This will return all members of TAG with `extern \"C\"' added to
the typemodifiers attribute."
(when (eq (semantic-tag-class tag) 'extern)
(let* ((mb (semantic-tag-get-attribute tag :members))
@@ -1058,7 +1065,7 @@ the typemodifiers attribute."
(defun semantic-expand-c-complex-type (tag)
"Check if TAG has a full :type with a name on its own.
If so, extract it, and replace it with a reference to that type.
-Thus, 'struct A { int a; } B;' will create 2 toplevel tags, one
+Thus, `struct A { int a; } B;' will create 2 toplevel tags, one
is type A, and the other variable B where the :type of B is just
a type tag A that is a prototype, and the actual struct info of A
is its own toplevel tag. This function will return (cons A B)."
@@ -1118,7 +1125,8 @@ is its own toplevel tag. This function will return (cons A B)."
(semantic-tag-new-variable
(car cur) ;name
ty ;type
- (if default
+ (if (and default
+ (listp (cdr default)))
(buffer-substring-no-properties
(car default) (car (cdr default))))
:constant-flag (semantic-tag-variable-constant-p tag)
@@ -1173,11 +1181,7 @@ is its own toplevel tag. This function will return (cons A B)."
(nth 1 (car names)) ; name
"typedef"
(semantic-tag-type-members tag)
- ;; parent is just the name of what
- ;; is passed down as a tag.
- (list
- (semantic-tag-name
- (semantic-tag-type-superclasses tag)))
+ nil
:pointer
(let ((stars (car (car (car names)))))
(if (= stars 0) nil stars))
@@ -1227,6 +1231,45 @@ or \"struct\".")
name
(delete "" ans))))
+(define-mode-local-override semantic-analyze-tag-references c-mode (tag &optional db)
+ "Analyze the references for TAG.
+Returns a class with information about TAG.
+
+Optional argument DB is a database. It will be used to help
+locate TAG.
+
+Use `semantic-analyze-current-tag' to debug this fcn."
+ (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag)))
+ (let ((allhits nil)
+ (scope nil)
+ (refs nil))
+ (save-excursion
+ (semantic-go-to-tag tag db)
+ (setq scope (semantic-calculate-scope))
+
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t))
+
+ (when (or (zerop (semanticdb-find-result-length allhits))
+ (and (= (semanticdb-find-result-length allhits) 1)
+ (eq (car (semanticdb-find-result-nth allhits 0)) tag)))
+ ;; It found nothing or only itself - not good enough. As a
+ ;; last resort, let's remove all namespaces from the scope and
+ ;; search again.
+ (oset scope parents
+ (let ((parents (oref scope parents))
+ newparents)
+ (dolist (cur parents)
+ (unless (string= (semantic-tag-type cur) "namespace")
+ (push cur newparents)))
+ (reverse newparents)))
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
+
+ (setq refs (semantic-analyze-references (semantic-tag-name tag)
+ :tag tag
+ :tagdb db
+ :scope scope
+ :rawsearchdata allhits)))))
+
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
This is so we don't have to match the same starting text several times.
@@ -1258,7 +1301,8 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
(nth 10 tokenpart) ; initializers
)
(not (car (nth 3 tokenpart)))))
- (fcnpointer (string-match "^\\*" (car tokenpart)))
+ (fcnpointer (and (> (length (car tokenpart)) 0)
+ (= (aref (car tokenpart) 0) ?*)))
(fnname (if fcnpointer
(substring (car tokenpart) 1)
(car tokenpart)))
@@ -1266,70 +1310,80 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
nil
t))
)
- (if fcnpointer
- ;; Function pointers are really variables.
- (semantic-tag-new-variable
- fnname
- typedecl
- nil
- ;; It is a function pointer
- :functionpointer-flag t
- )
- ;; The function
- (semantic-tag-new-function
- fnname
- (or typedecl ;type
- (cond ((car (nth 3 tokenpart) )
- "void") ; Destructors have no return?
- (constructor
- ;; Constructors return an object.
- (semantic-tag-new-type
- ;; name
- (or (car semantic-c-classname)
- (let ((split (semantic-analyze-split-name-c-mode
- (car (nth 2 tokenpart)))))
- (if (stringp split) split
- (car (last split)))))
- ;; type
- (or (cdr semantic-c-classname)
- "class")
- ;; members
- nil
- ;; parents
- nil
- ))
- (t "int")))
- (nth 4 tokenpart) ;arglist
- :constant-flag (if (member "const" declmods) t nil)
- :typemodifiers (delete "const" declmods)
- :parent (car (nth 2 tokenpart))
- :destructor-flag (if (car (nth 3 tokenpart) ) t)
- :constructor-flag (if constructor t)
- :pointer (nth 7 tokenpart)
- :operator-flag operator
- ;; Even though it is "throw" in C++, we use
- ;; `throws' as a common name for things that toss
- ;; exceptions about.
- :throws (nth 5 tokenpart)
- ;; Reentrant is a C++ thingy. Add it here
- :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
- ;; A function post-const is funky. Try stuff
- :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
- ;; prototypes are functions w/ no body
- :prototype-flag (if (nth 8 tokenpart) t)
- ;; Pure virtual
- :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
- ;; Template specifier.
- :template-specifier (nth 9 tokenpart)
- )))
- )
- ))
+ ;; The function
+ (semantic-tag-new-function
+ fnname
+ (or typedecl ;type
+ (cond ((car (nth 3 tokenpart) )
+ "void") ; Destructors have no return?
+ (constructor
+ ;; Constructors return an object.
+ (semantic-tag-new-type
+ ;; name
+ (or (car semantic-c-classname)
+ (let ((split (semantic-analyze-split-name-c-mode
+ (car (nth 2 tokenpart)))))
+ (if (stringp split) split
+ (car (last split)))))
+ ;; type
+ (or (cdr semantic-c-classname)
+ "class")
+ ;; members
+ nil
+ ;; parents
+ nil
+ ))
+ (t "int")))
+ ;; Argument list can contain things like function pointers
+ (semantic-c-reconstitute-function-arglist (nth 4 tokenpart))
+ :constant-flag (if (member "const" declmods) t nil)
+ :typemodifiers (delete "const" declmods)
+ :parent (car (nth 2 tokenpart))
+ :destructor-flag (if (car (nth 3 tokenpart) ) t)
+ :constructor-flag (if constructor t)
+ :function-pointer fcnpointer
+ :pointer (nth 7 tokenpart)
+ :operator-flag operator
+ ;; Even though it is "throw" in C++, we use
+ ;; `throws' as a common name for things that toss
+ ;; exceptions about.
+ :throws (nth 5 tokenpart)
+ ;; Reentrant is a C++ thingy. Add it here
+ :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
+ ;; A function post-const is funky. Try stuff
+ :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
+ ;; prototypes are functions w/ no body
+ :prototype-flag (if (nth 8 tokenpart) t)
+ ;; Pure virtual
+ :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
+ ;; Template specifier.
+ :template-specifier (nth 9 tokenpart))))))
(defun semantic-c-reconstitute-template (tag specifier)
"Reconstitute the token TAG with the template SPECIFIER."
(semantic-tag-put-attribute tag :template (or specifier ""))
tag)
+(defun semantic-c-reconstitute-function-arglist (arglist)
+ "Reconstitute the argument list of a function.
+This currently only checks if the function expects a function
+pointer as argument."
+ (let (result)
+ (dolist (arg arglist)
+ ;; Names starting with a '*' denote a function pointer
+ (if (and (> (length (semantic-tag-name arg)) 0)
+ (= (aref (semantic-tag-name arg) 0) ?*))
+ (setq result
+ (append result
+ (list
+ (semantic-tag-new-function
+ (substring (semantic-tag-name arg) 1)
+ (semantic-tag-type arg)
+ (cadr (semantic-tag-attributes arg))
+ :function-pointer t))))
+ (setq result (append result (list arg)))))
+ result))
+
;;; Override methods & Variables
;;
@@ -1338,7 +1392,7 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
"Convert TAG to a string that is the print name for TAG.
Optional PARENT and COLOR are ignored."
(let ((name (semantic-format-tag-name-default tag parent color))
- (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
+ (fnptr (semantic-tag-get-attribute tag :function-pointer))
)
(if (not fnptr)
name
@@ -1546,7 +1600,7 @@ Optional PARENT and COLOR as specified with
"Return non-nil if TAG is considered abstract.
PARENT is tag's parent.
In C, a method is abstract if it is `virtual', which is already
-handled. A class is abstract iff its destructor is virtual."
+handled. A class is abstract only if its destructor is virtual."
(cond
((eq (semantic-tag-class tag) 'type)
(require 'semantic/find)
@@ -1602,7 +1656,7 @@ SPEC-LIST is the template specifier of the datatype instantiated."
(defun semantic-c--template-name-1 (spec-list)
"Return a string used to compute template class name.
-Based on SPEC-LIST, for ref<Foo,Bar> it will return 'Foo,Bar'."
+Based on SPEC-LIST, for ref<Foo,Bar> it will return `Foo,Bar'."
(when (car spec-list)
(let* ((endpart (semantic-c--template-name-1 (cdr spec-list)))
(separator (and endpart ",")))
@@ -1611,7 +1665,7 @@ Based on SPEC-LIST, for ref<Foo,Bar> it will return 'Foo,Bar'."
(defun semantic-c--template-name (type spec-list)
"Return a template class name for TYPE based on SPEC-LIST.
For a type `ref' with a template specifier of (Foo Bar) it will
-return 'ref<Foo,Bar>'."
+return `ref<Foo,Bar>'."
(concat (semantic-tag-name type)
"<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
@@ -1639,7 +1693,7 @@ instantiated as specified in TYPE-DECLARATION."
;;; Patch here by "Raf" for instantiating templates.
(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
"Dereference through the `->' operator of TYPE.
-Uses the return type of the '->' operator if it is contained in TYPE.
+Uses the return type of the `->' operator if it is contained in TYPE.
SCOPE is the current local scope to perform searches in.
TYPE-DECLARATION is passed through."
(if semantic-c-member-of-autocast
@@ -1655,8 +1709,8 @@ TYPE-DECLARATION is passed through."
;; tests 5 and following.
(defun semantic-c-dereference-namespace (type scope &optional type-declaration)
- "Dereference namespace which might hold an 'alias' for TYPE.
-Such an alias can be created through 'using' statements in a
+ "Dereference namespace which might hold an `alias' for TYPE.
+Such an alias can be created through `using' statements in a
namespace declaration. This function checks the namespaces in
SCOPE for such statements."
(let ((scopetypes (oref scope scopetypes))
@@ -1772,7 +1826,7 @@ or nil if it cannot be found."
(define-mode-local-override semantic-analyze-dereference-metatype
c-mode (type scope &optional type-declaration)
"Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
-Handle typedef, template instantiation, and '->' operator."
+Handle typedef, template instantiation, and `->' operator."
(let* ((dereferencer-list '(semantic-c-dereference-typedef
semantic-c-dereference-template
semantic-c-dereference-member-of
@@ -1823,31 +1877,31 @@ DO NOT return the list of tags encompassing point."
(let ((idx 0)
(len (semanticdb-find-result-length tmp)))
(while (< idx len)
- (setq tagreturn (cons (semantic-tag-type (car (semanticdb-find-result-nth tmp idx))) tagreturn))
- (setq idx (1+ idx)))
- )
- ;; Use the encompassed types around point to also look for using statements.
- ;;(setq tagreturn (cons "bread_name" tagreturn))
- (while (cdr tagsaroundpoint) ; don't search the last one
- (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
- (dolist (T tmp)
- (setq tagreturn (cons (semantic-tag-type T) tagreturn))
- )
- (setq tagsaroundpoint (cdr tagsaroundpoint))
- )
- ;; If in a function...
- (when (and (semantic-tag-of-class-p (car tagsaroundpoint) 'function)
- ;; ...search for using statements in the local scope...
- (setq tmp (semantic-find-tags-by-class
- 'using
- (semantic-get-local-variables))))
- ;; ... and add them.
- (setq tagreturn
- (append tagreturn
- (mapcar 'semantic-tag-type tmp))))
+ (setq tagreturn
+ (append tagreturn (list (semantic-tag-type
+ (car (semanticdb-find-result-nth tmp idx))))))
+ (setq idx (1+ idx))))
+ ;; Use the encompassed types around point to also look for using
+ ;; statements. If we deal with types, search inside members; for
+ ;; functions, we have to call `semantic-get-local-variables' to
+ ;; parse inside the function's body.
+ (dolist (cur tagsaroundpoint)
+ (cond
+ ((and (eq (semantic-tag-class cur) 'type)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-tag-components (car tagsaroundpoint)))))
+ (dolist (T tmp)
+ (setq tagreturn (cons (semantic-tag-type T) tagreturn))))
+ ((and (semantic-tag-of-class-p (car (last tagsaroundpoint)) 'function)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-get-local-variables))))
+ (setq tagreturn
+ (append tagreturn
+ (mapcar 'semantic-tag-type tmp))))))
;; Return the stuff
- tagreturn
- ))
+ tagreturn))
(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point)
"Return the list of using tag types in scope of POINT."
@@ -2122,7 +2176,8 @@ actually in their parent which is not accessible.")
(princ "\n\nInclude Path Summary:\n")
(when (and (boundp 'ede-object) ede-object)
- (princ "\n This file's project include is handled by:\n")
+ (princ (substitute-command-keys
+ "\n This file's project include is handled by:\n"))
(let ((objs (if (listp ede-object)
ede-object
(list ede-object))))
@@ -2140,14 +2195,16 @@ actually in their parent which is not accessible.")
)
(when semantic-dependency-include-path
- (princ "\n This file's generic include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's generic include path is:\n"))
(dolist (dir semantic-dependency-include-path)
(princ " ")
(princ dir)
(princ "\n")))
(when semantic-dependency-system-include-path
- (princ "\n This file's system include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's system include path is:\n"))
(dolist (dir semantic-dependency-system-include-path)
(princ " ")
(princ dir)
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
index 3fc5479f856..8aebcd64eb2 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/debug.el --- Debugger support for bovinator
-;; Copyright (C) 2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -83,7 +83,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
(let* ((nonterm (oref frame nonterm))
(pb (oref semantic-debug-current-interface parser-buffer))
@@ -102,7 +102,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
(oref frame lextoken))
))
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
(message "%S" (oref frame collection))
)
@@ -125,12 +125,12 @@ Argument CONDITION is the thrown error condition."
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
"Highlight a frame from an action."
;; How do I get the location of the action in the source buffer?
)
-(defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
"Display info about the error thrown."
(message "Error: %S" (oref frame condition)))
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index c6f1ceb0f94..1b223d287b2 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 7beb8ff3203..1d3f7730f35 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -86,13 +86,11 @@ to give to the program."
(let ((chars (append line nil)))
(when (= 32 (nth 0 chars))
(let ((path (substring line 1)))
- (when (file-accessible-directory-p path)
- (when (if (memq system-type '(windows-nt))
- (/= ?/ (nth 1 chars))
- (= ?/ (nth 1 chars)))
- (add-to-list 'inc-path
- (expand-file-name (substring line 1))
- t)))))))))
+ (when (and (file-accessible-directory-p path)
+ (file-name-absolute-p path))
+ (add-to-list 'inc-path
+ (expand-file-name path)
+ t))))))))
inc-path))
@@ -139,9 +137,9 @@ to give to the program."
"The GCC setup data.
This is setup by `semantic-gcc-setup'.
This is an alist, and should include keys of:
- 'version - the version of gcc
- '--host - the host symbol (used in include directories)
- '--prefix - where GCC was installed.
+ `version' - the version of gcc
+ `--host' - the host symbol (used in include directories)
+ `--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
;;;###autoload
@@ -166,8 +164,9 @@ It should also include other symbols GCC was compiled with.")
(host (or (cdr (assoc 'target fields))
(cdr (assoc '--target fields))
(cdr (assoc '--host fields))))
- (prefix (cdr (assoc '--prefix fields)))
+ ;; (prefix (cdr (assoc '--prefix fields)))
;; gcc output supplied paths
+ ;; FIXME: Where are `c-include-path' and `c++-include-path' used?
(c-include-path (semantic-gcc-get-include-paths "c"))
(c++-include-path (semantic-gcc-get-include-paths "c++"))
(gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
@@ -210,7 +209,8 @@ It should also include other symbols GCC was compiled with.")
(semantic-add-system-include D 'c-mode))
(dolist (D (semantic-gcc-get-include-paths "c++"))
(semantic-add-system-include D 'c++-mode)
- (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h"))))
+ (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")
+ (concat D "/features.h"))))
(dolist (cur cppconfig)
;; Presumably there will be only one of these files in the try-paths list...
(when (file-readable-p cur)
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 0133ee72b18..ebe2fd1d82e 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
;;
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -395,16 +395,33 @@ manual."
(insert ")\n")
(buffer-string))))
+(defun bovine-grammar-calculate-source-on-path ()
+ "Calculate the location of the source for current buffer.
+The source directory is relative to some root in the load path."
+ (condition-case nil
+ (let* ((dir (nreverse (split-string (buffer-file-name) "/")))
+ (newdir (car dir)))
+ (setq dir (cdr dir))
+ ;; Keep trying the file name until it is on the path.
+ (while (and (not (locate-library newdir)) dir)
+ (setq newdir (concat (car dir) "/" newdir)
+ dir (cdr dir)))
+ (if (not dir)
+ (buffer-name)
+ newdir))
+ (error (buffer-name))))
+
(defun bovine-grammar-setupcode-builder ()
"Return the text of the setup code."
(format
"(setq semantic--parse-table %s\n\
semantic-debug-parser-source %S\n\
semantic-debug-parser-class 'semantic-bovine-debug-parser
+ semantic-debug-parser-debugger-source 'semantic/bovine/debug
semantic-flex-keywords-obarray %s\n\
%s)"
(semantic-grammar-parsetable)
- (buffer-name)
+ (bovine-grammar-calculate-source-on-path)
(semantic-grammar-keywordtable)
(let ((mode (semantic-grammar-languagemode)))
;; Is there more than one major mode?
@@ -443,34 +460,39 @@ Menu items are appended to the common grammar menu.")
)
"Semantic grammar macros used in bovine grammars.")
-(defun bovine-make-parsers ()
- "Generate Emacs' built-in Bovine-based parser files."
- (interactive)
- (semantic-mode 1)
- ;; Loop through each .by file in current directory, and run
- ;; `semantic-grammar-batch-build-one-package' to build the grammar.
- (dolist (f (directory-files default-directory nil "\\.by\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- lang filename copyright-end)
- (when (and packagename
- (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
- (setq lang (match-string 1 packagename))
- (setq filename (concat lang "-by.el"))
- (with-temp-buffer
- (insert-file-contents filename)
- (setq buffer-file-name (expand-file-name filename))
- ;; Fix copyright header:
- (goto-char (point-min))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert ";; This file is part of GNU Emacs.
+(defun bovine--make-parser-1 (infile &optional outdir)
+ (if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
+ ;; It would be nicer to use a temp-buffer rather than find-file-noselect.
+ ;; The only thing stopping us is bovine-grammar-setupcode-builder's
+ ;; use of (buffer-name). Perhaps that could be changed to
+ ;; (file-name-nondirectory (buffer-file-name)) ?
+;; (with-temp-buffer
+;; (insert-file-contents infile)
+;; (bovine-grammar-mode)
+;; (setq buffer-file-name (expand-file-name infile))
+;; (if outdir (setq default-directory outdir))
+ (let ((packagename
+ ;; This is with-demoted-errors.
+ (condition-case err
+ (with-current-buffer (find-file-noselect infile)
+ (if outdir (setq default-directory outdir))
+ (semantic-grammar-create-package nil t))
+ (error (message "%s" (error-message-string err)) nil)))
+ lang filename copyright-end)
+ (when (and packagename
+ (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
+ (setq lang (match-string 1 packagename))
+ (setq filename (expand-file-name (concat lang "-by.el") outdir))
+ (with-temp-file filename
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert ";; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -488,18 +510,50 @@ Menu items are appended to the common grammar menu.")
;;; Commentary:
;;
;; This file was generated from admin/grammars/"
- lang ".by.
+ lang ".by.
;;; Code:
")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (delete-trailing-whitespace)
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (save-buffer))))))
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (delete-trailing-whitespace)
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)))))
+
+(defun bovine-make-parsers ()
+ "Generate Emacs's built-in Bovine-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .by file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.by\\'"))
+ (bovine--make-parser-1 f)))
+
+
+(defun bovine-batch-make-parser (&optional infile outdir)
+ "Generate a Bovine parser from input INFILE, writing to OUTDIR.
+This is mainly intended for use in batch mode:
+
+emacs -batch -l semantic/bovine/grammar -f bovine-make-parser-batch \\
+ [-dir output-dir | -o output-file] file.by
+
+If -o is supplied, only the directory part is used."
+ (semantic-mode 1)
+ (when (and noninteractive (not infile))
+ (let (arg)
+ (while command-line-args-left
+ (setq arg (pop command-line-args-left))
+ (cond ((string-equal arg "-dir")
+ (setq outdir (pop command-line-args-left)))
+ ((string-equal arg "-o")
+ (setq outdir (file-name-directory (pop command-line-args-left))))
+ (t (setq infile arg))))))
+ (or infile (error "No input file specified"))
+ (or (file-readable-p infile)
+ (error "Input file `%s' not readable" infile))
+ (bovine--make-parser-1 infile outdir))
(provide 'semantic/bovine/grammar)
diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el
deleted file mode 100644
index b94cfa44aac..00000000000
--- a/lisp/cedet/semantic/bovine/make-by.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;;; semantic/bovine/make-by.el --- Generated parser support file
-
-;; Copyright (C) 1999-2004, 2008-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/make.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst semantic-make-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("if" . IF)
- ("ifdef" . IFDEF)
- ("ifndef" . IFNDEF)
- ("ifeq" . IFEQ)
- ("ifneq" . IFNEQ)
- ("else" . ELSE)
- ("endif" . ENDIF)
- ("include" . INCLUDE))
- '(("include" summary "Macro: include filename1 filename2 ...")
- ("ifneq" summary "Conditional: ifneq (expression) ... else ... endif")
- ("ifeq" summary "Conditional: ifeq (expression) ... else ... endif")
- ("ifndef" summary "Conditional: ifndef (expression) ... else ... endif")
- ("ifdef" summary "Conditional: ifdef (expression) ... else ... endif")
- ("endif" summary "Conditional: if (expression) ... else ... endif")
- ("else" summary "Conditional: if (expression) ... else ... endif")
- ("if" summary "Conditional: if (expression) ... else ... endif")))
- "Table of language keywords.")
-
-(defconst semantic-make-by--token-table
- (semantic-lex-make-type-table
- '(("punctuation"
- (BACKSLASH . "\\`[\\]\\'")
- (DOLLAR . "\\`[$]\\'")
- (EQUAL . "\\`[=]\\'")
- (PLUS . "\\`[+]\\'")
- (COLON . "\\`[:]\\'")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-make-by--parse-table
- `(
- (bovine-toplevel
- (Makefile)
- ) ;; end bovine-toplevel
-
- (Makefile
- (bol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (bol
- variable
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- rule
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- conditional
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- include
- ,(semantic-lambda
- (nth 1 vals))
- )
- (whitespace
- ,(semantic-lambda
- (list nil))
- )
- (newline
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end Makefile
-
- (variable
- (symbol
- opt-whitespace
- equals
- opt-whitespace
- element-list
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil
- (nth 4 vals)))
- )
- ) ;; end variable
-
- (rule
- (targets
- opt-whitespace
- colons
- opt-whitespace
- element-list
- commands
- ,(semantic-lambda
- (semantic-tag-new-function
- (nth 0 vals) nil
- (nth 4 vals)))
- )
- ) ;; end rule
-
- (targets
- (target
- opt-whitespace
- targets
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))
- (car
- (nth 2 vals))))
- )
- (target
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))))
- )
- ) ;; end targets
-
- (target
- (sub-target
- target
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- (car
- (nth 2 vals)))))
- )
- (sub-target
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))))
- )
- ) ;; end target
-
- (sub-target
- (symbol)
- (string)
- (varref)
- ) ;; end sub-target
-
- (conditional
- (IF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFDEF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFNDEF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFEQ
- some-whitespace
- expression
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFNEQ
- some-whitespace
- expression
- newline
- ,(semantic-lambda
- (list nil))
- )
- (ELSE
- newline
- ,(semantic-lambda
- (list nil))
- )
- (ENDIF
- newline
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end conditional
-
- (expression
- (semantic-list)
- ) ;; end expression
-
- (include
- (INCLUDE
- some-whitespace
- element-list
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 2 vals) nil))
- )
- ) ;; end include
-
- (equals
- (punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- ) ;; end equals
-
- (colons
- (punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[:]\\'"
- ,(semantic-lambda)
- )
- ) ;; end colons
-
- (element-list
- (elements
- newline
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end element-list
-
- (elements
- (element
- some-whitespace
- elements
- ,(semantic-lambda
- (nth 0 vals)
- (nth 2 vals))
- )
- (element
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- )
- ) ;; end elements
-
- (element
- (sub-element
- element
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- (car
- (nth 1 vals)))))
- )
- ( ;;EMPTY
- )
- ) ;; end element
-
- (sub-element
- (symbol)
- (string)
- (punctuation)
- (semantic-list
- ,(semantic-lambda
- (list
- (buffer-substring-no-properties
- (identity start)
- (identity end))))
- )
- ) ;; end sub-element
-
- (varref
- (punctuation
- "\\`[$]\\'"
- semantic-list
- ,(semantic-lambda
- (list
- (buffer-substring-no-properties
- (identity start)
- (identity end))))
- )
- ) ;; end varref
-
- (commands
- (bol
- shell-command
- newline
- commands
- ,(semantic-lambda
- (list
- (nth 0 vals))
- (nth 1 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end commands
-
- (opt-whitespace
- (some-whitespace
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-whitespace
-
- (some-whitespace
- (whitespace
- some-whitespace
- ,(semantic-lambda
- (list nil))
- )
- (whitespace
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end some-whitespace
- )
- "Parser table.")
-
-(defun semantic-make-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-make-by--parse-table
- semantic-debug-parser-source "make.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-make-by--keyword-table
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/make-by)
-
-;;; semantic/bovine/make-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 8ed94174f62..c001a4dab5f 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/make.el --- Makefile parsing rules.
-;; Copyright (C) 2000-2004, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2004, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -178,9 +178,8 @@ This is the same as a regular prototype."
makefile-mode (context)
"Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
- (save-excursion
- (require 'semantic/analyze/complete)
- (set-buffer (oref context buffer))
+ (require 'semantic/analyze/complete)
+ (with-current-buffer (oref context buffer)
(let* ((normal (semantic-analyze-possible-completions-default context))
(classes (oref context :prefixclass))
(filetags nil))
diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el
deleted file mode 100644
index 261607c84d1..00000000000
--- a/lisp/cedet/semantic/bovine/scm-by.el
+++ /dev/null
@@ -1,196 +0,0 @@
-;;; semantic/bovine/scm-by.el --- Generated parser support file
-
-;; Copyright (C) 2001, 2003, 2009-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/scm.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst semantic-scm-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("define" . DEFINE)
- ("define-module" . DEFINE-MODULE)
- ("load" . LOAD))
- '(("load" summary "Function: (load \"filename\")")
- ("define-module" summary "Function: (define-module (name arg1 ...)) ")
- ("define" summary "Function: (define symbol expression)")))
- "Table of language keywords.")
-
-(defconst semantic-scm-by--token-table
- (semantic-lex-make-type-table
- '(("close-paren"
- (CLOSEPAREN . ")"))
- ("open-paren"
- (OPENPAREN . "(")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-scm-by--parse-table
- `(
- (bovine-toplevel
- (scheme)
- ) ;; end bovine-toplevel
-
- (scheme
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'scheme-list))
- )
- ) ;; end scheme
-
- (scheme-list
- (open-paren
- "("
- scheme-in-list
- close-paren
- ")"
- ,(semantic-lambda
- (nth 1 vals))
- )
- ) ;; end scheme-list
-
- (scheme-in-list
- (DEFINE
- symbol
- expression
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 1 vals) nil
- (nth 2 vals)))
- )
- (DEFINE
- name-args
- opt-doc
- sequence
- ,(semantic-lambda
- (semantic-tag-new-function
- (car
- (nth 1 vals)) nil
- (cdr
- (nth 1 vals))))
- )
- (DEFINE-MODULE
- name-args
- ,(semantic-lambda
- (semantic-tag-new-package
- (nth
- (length
- (nth 1 vals))
- (nth 1 vals)) nil))
- )
- (LOAD
- string
- ,(semantic-lambda
- (semantic-tag-new-include
- (file-name-nondirectory
- (read
- (nth 1 vals)))
- (read
- (nth 1 vals))))
- )
- (symbol
- ,(semantic-lambda
- (semantic-tag-new-code
- (nth 0 vals) nil))
- )
- ) ;; end scheme-in-list
-
- (name-args
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'name-arg-expand))
- )
- ) ;; end name-args
-
- (name-arg-expand
- (open-paren
- name-arg-expand
- ,(semantic-lambda
- (nth 1 vals))
- )
- (symbol
- name-arg-expand
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end name-arg-expand
-
- (opt-doc
- (string)
- ( ;;EMPTY
- )
- ) ;; end opt-doc
-
- (sequence
- (expression
- sequence)
- (expression)
- ) ;; end sequence
-
- (expression
- (symbol)
- (semantic-list)
- (string)
- (number)
- ) ;; end expression
- )
- "Parser table.")
-
-(defun semantic-scm-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-scm-by--parse-table
- semantic-debug-parser-source "scheme.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-scm-by--keyword-table
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/scm-by)
-
-;;; semantic/bovine/scm-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 2a0425f43d2..745731c6485 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
-;;; Copyright (C) 2001-2004, 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001-2004, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -69,8 +69,8 @@ Attempts a simple prototype for calling or using TAG."
;; Note: Analyzer from Henry S. Thompson
(define-lex-regex-analyzer semantic-lex-scheme-symbol
"Detect and create symbol and keyword tokens."
- "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)+\\)"
- ;; (message (format "symbol: %s" (match-string 0)))
+ "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)"
+ ;; (message "symbol: %s" (match-string 0))
(semantic-lex-push-token
(semantic-lex-token
(or (semantic-lex-keyword-p (match-string 0)) 'symbol)
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
index 1a546cdf7ab..51d9e7d8957 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -1,6 +1,6 @@
;;; semantic/chart.el --- Utilities for use with semantic tag tables
-;; Copyright (C) 1999-2001, 2003, 2005, 2008-2013 Free Software
+;; Copyright (C) 1999-2001, 2003, 2005, 2008-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index b42e24fb9c0..9b7882c7acd 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,6 +1,6 @@
;;; semantic/complete.el --- Routines for performing tag completion
-;; Copyright (C) 2003-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -118,6 +118,7 @@
(eval-when-compile
;; For the semantic-find-tags-for-completion macro.
(require 'semantic/find))
+(require 'semantic/db-find) ;For type semanticdb-find-result-with-nil.
;;; Code:
@@ -155,7 +156,7 @@ Presumably if you call this you will insert something new there."
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
(apply 'message fmt args)
- (message (concat (buffer-string) (apply 'format fmt args)))))
+ (apply 'message (concat "%s" fmt) (buffer-string) args)))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses
@@ -187,6 +188,8 @@ Value should be a ... what?")
"Default history variable for any unhistoried prompt.
Keeps STRINGS only in the history.")
+(defvar semantic-complete-active-default)
+(defvar semantic-complete-current-matched-tag)
(defun semantic-complete-read-tag-engine (collector displayor prompt
default-tag initial-input
@@ -927,7 +930,7 @@ derive from this list.")
The only options available for completion are those which can be logically
inserted into the current context.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them.
@@ -942,11 +945,11 @@ inserted into the current context.")
prefix
(oref obj first-pass-completions)))))
-(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
-(defmethod semantic-collector-next-action
+(cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
@@ -971,19 +974,19 @@ PARTIAL indicates if we are doing a partial completion."
'complete-whitespace)))
'complete))
-(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+(cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) last-prefix)))
-(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
"Get the raw cache of tags for completion.
Calculate the cache if there isn't one."
(or (oref obj cache)
(semantic-collector-calculate-cache obj)))
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format."
@@ -1002,7 +1005,7 @@ Output must be in semanticdb Find result format."
(if result
(list (cons table result)))))
-(defmethod semantic-collector-calculate-completions
+(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
@@ -1079,7 +1082,7 @@ Output must be in semanticdb Find result format."
)))
))
-(defmethod semantic-collector-try-completion-whitespace
+(cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching
@@ -1111,7 +1114,7 @@ has been run first."
)))
-(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
@@ -1119,12 +1122,12 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match)
(oref obj current-exact-match)))
-(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
"Return the active whitespace completion value."
(when (slot-boundp obj 'last-whitespace-completion)
(oref obj last-whitespace-completion)))
-(defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
@@ -1132,7 +1135,7 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match)
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
-(defmethod semantic-collector-all-completions
+(cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
@@ -1140,7 +1143,7 @@ matching PREFIX."
(when (slot-boundp obj 'last-all-completions)
(oref obj last-all-completions)))
-(defmethod semantic-collector-try-completion
+(cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
@@ -1151,13 +1154,13 @@ with that name."
(if (slot-boundp obj 'last-completion)
(oref obj last-completion)))
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
-(defmethod semantic-collector-flush ((this semantic-collector-abstract))
+(cl-defmethod semantic-collector-flush ((this semantic-collector-abstract))
"Flush THIS collector object, clearing any caches and prefix."
(oset this cache nil)
(slot-makeunbound this 'last-prefix)
@@ -1174,7 +1177,7 @@ with that name."
These collectors track themselves on a per-buffer basis."
:abstract t)
-(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+(cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
@@ -1183,7 +1186,7 @@ These collectors track themselves on a per-buffer basis."
(if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
- (let ((new (call-next-method)))
+ (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new)
(setq old new)))
(slot-makeunbound old 'last-completion)
@@ -1214,7 +1217,7 @@ NEWCACHE is the new tag table, but we ignore it."
When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'"
@@ -1244,7 +1247,7 @@ Uses semanticdb for searching all tags in the current project."
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
@@ -1257,7 +1260,7 @@ Uses semanticdb for searching all tags in the current project."
(declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(require 'semantic/db-find)
@@ -1271,7 +1274,7 @@ Uses semanticdb for searching all tags in the current project."
"The scope the local members are being completed from."))
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope)
@@ -1320,11 +1323,11 @@ Provides the basics for a displayor, including interacting with
a collector, and tracking tables of completion to display."
:abstract t)
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
"Clean up any mess this displayor may have."
nil)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB)
@@ -1333,33 +1336,33 @@ a collector, and tracking tables of completion to display."
'scroll
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
(oset obj table table)
(oset obj last-prefix prefix))
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
"A request to show the current tags table."
(ding))
-(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
"A request to for the displayor to focus on some tag option."
(ding))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
"A request to for the displayor to scroll the completion list (if needed)."
(scroll-other-window))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
"Set the current focus to the previous item."
nil)
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
"Set the current focus to the next item."
nil)
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
@@ -1378,7 +1381,7 @@ Traditional display mechanism for a list of possible completions.
Completions are showin in a new buffer and listed with the ability
to click on the items to aid in completion.")
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
"A request to show the current tags table."
;; NOTE TO SELF. Find the character to type next, and emphasize it.
@@ -1409,7 +1412,7 @@ Focusing is a way of differentiating among multiple tags
which have the same name."
:abstract t)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text))
@@ -1425,13 +1428,13 @@ which have the same name."
'focus)
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(slot-makeunbound obj 'focus))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
"Set the current focus to the previous item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
@@ -1443,7 +1446,7 @@ Not meaningful return value."
)
)))
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
"Set the current focus to the next item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
@@ -1456,13 +1459,13 @@ Not meaningful return value."
(oset obj focus 0))
)))
-(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
"Return the next tag OBJ should focus on."
(when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj
(semanticdb-find-result-nth table (oref obj focus)))))
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
"Return the tag currently in focus, or call parent method."
(if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table)
@@ -1478,7 +1481,7 @@ Not meaningful return value."
;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever
- (call-next-method)))
+ (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting.
@@ -1488,10 +1491,10 @@ Not meaningful return value."
"Display completions in *Completions* buffer, with focus highlight.
A traditional displayor which can focus on a tag by showing it.
Same as `semantic-displayor-traditional', but with selection between
-multiple tags with the same name done by 'focusing' on the source
+multiple tags with the same name done by focusing on the source
location of the different tags to differentiate them.")
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-traditional-with-focus-highlight))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting
@@ -1627,19 +1630,21 @@ This will not happen if you directly set this variable via `setq'."
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
-(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
+(cl-defmethod initialize-instance :after ((obj semantic-displayor-tooltip) &rest args)
"Make sure we have tooltips required."
(condition-case nil
(require 'tooltip)
(error nil))
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
+(defvar tooltip-mode)
+
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
"A request to show the current tags table."
(if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer.
- (call-next-method)
+ (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table))
@@ -1660,7 +1665,7 @@ Display mechanism using tooltip for a list of possible completions.")
(when (>= (oref obj typing-count) 5)
(oset obj mode 'standard)
(setq mode 'standard)
- (message "Resetting inline-mode to 'standard'."))
+ (message "Resetting inline-mode to `standard'."))
(when (and (> numcompl max-tags)
(< (oref obj typing-count) 2))
;; Discretely hint at completion availability.
@@ -1679,7 +1684,7 @@ Display mechanism using tooltip for a list of possible completions.")
(setq msg-tail (concat "\n[<TAB> " (number-to-string (- numcompl max-tags)) " more]"))
(setq msg-tail (concat "\n[<n/a> " (number-to-string (- numcompl max-tags)) " more]"))
(when (>= (oref obj typing-count) 2)
- (message "Refine search to display results beyond the '%s' limit"
+ (message "Refine search to display results beyond the `%s' limit"
(symbol-name 'semantic-complete-inline-max-tags-extended)))))
((= numcompl 1)
;; two possible cases
@@ -1702,23 +1707,19 @@ Display mechanism using tooltip for a list of possible completions.")
;;; Compatibility
;;
-(eval-and-compile
- (if (fboundp 'window-inside-edges)
- ;; Emacs devel.
- (defalias 'semantic-displayor-window-edges
- 'window-inside-edges)
- ;; Emacs 21
- (defalias 'semantic-displayor-window-edges
- 'window-edges)
- ))
(defun semantic-displayor-point-position ()
"Return the location of POINT as positioned on the selected frame.
Return a cons cell (X . Y)"
(let* ((frame (selected-frame))
- (left (or (car-safe (cdr-safe (frame-parameter frame 'left)))
- (frame-parameter frame 'left)))
- (top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
+ (toolbarleft
+ (if (eq (cdr (assoc 'tool-bar-position default-frame-alist)) 'left)
+ (tool-bar-pixel-width)
+ 0))
+ (left (+ (or (car-safe (cdr-safe (frame-parameter frame 'left)))
+ (frame-parameter frame 'left))
+ toolbarleft))
+ (top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
(frame-parameter frame 'top)))
(point-pix-pos (posn-x-y (posn-at-point)))
(edges (window-inside-pixel-edges (selected-window))))
@@ -1726,6 +1727,9 @@ Return a cons cell (X . Y)"
(+ (cdr point-pix-pos) (cadr edges) top))))
+(defvar tooltip-frame-parameters)
+(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+
(defun semantic-displayor-tooltip-show (text)
"Display a tooltip with TEXT near cursor."
(let ((point-pix-pos (semantic-displayor-point-position))
@@ -1739,7 +1743,7 @@ Return a cons cell (X . Y)"
tooltip-frame-parameters)
(tooltip-show text)))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30)
@@ -1765,9 +1769,9 @@ Completion displayor using ghost chars after point for focus options.
Whichever completion is currently in focus will be displayed as ghost
text using overlay options.")
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
"The next action to take on the inline completion related to display."
- (let ((ans (call-next-method))
+ (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table)
(oref obj table))))
(if (and (eq ans 'displayend)
@@ -1777,22 +1781,22 @@ text using overlay options.")
nil
ans)))
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
"Clean up any mess this displayor may have."
(when (slot-boundp obj 'ghostoverlay)
(semantic-overlay-delete (oref obj ghostoverlay)))
)
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(semantic-displayor-cleanup obj)
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
"A request to show the current tags table."
; (if (oref obj first-show)
; (progn
@@ -1803,11 +1807,11 @@ text using overlay options.")
;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost
;; text display.
-; (call-next-method)
+; (cl-call-next-method)
; )
)
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible
@@ -1860,7 +1864,7 @@ completion text in ghost text."
(list 'const
:tag doc1
C)))
- (eieio-build-class-alist semantic-displayor-abstract t))
+ (eieio-build-class-alist 'semantic-displayor-abstract t))
)
"Possible options for inline completion displayors.
Use this to enable custom editing.")
@@ -1963,7 +1967,7 @@ completion works."
(complst nil))
(when (and thissym (or (not (string= thissym ""))
nextsym))
- ;; Do a quick calcuation of completions.
+ ;; Do a quick calculation of completions.
(semantic-collector-calculate-completions
collector thissym nil)
;; Get the master list
@@ -2043,7 +2047,7 @@ completion works."
(complst nil))
(when (and thissym (or (not (string= thissym ""))
nextsym))
- ;; Do a quick calcuation of completions.
+ ;; Do a quick calculation of completions.
(semantic-collector-calculate-completions
collector thissym nil)
;; Get the master list
@@ -2213,6 +2217,7 @@ use `semantic-complete-analyze-inline' to complete."
;; input.
(when (save-window-excursion
(save-excursion
+ ;; FIXME: Use `while-no-input'?
(and (not (semantic-exit-on-input 'csi
(semantic-fetch-tags)
(semantic-throw-on-input 'csi)
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index b010a30da7f..33b9a2e6037 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,6 +1,6 @@
;;; semantic/ctxt.el --- Context calculations for Semantic tools.
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -168,8 +168,7 @@ Uses the bovinator with the special top-symbol `bovine-inner-scope'
to collect tags, such as local variables or prototypes."
;; This assumes a bovine parser. Make sure we don't do
;; anything in that case.
- (when (and semantic--parse-table (not (eq semantic--parse-table t))
- (not (semantic-parse-tree-unparseable-p)))
+ (when (and semantic--parse-table (not (eq semantic--parse-table t)))
(let ((vars (semantic-get-cache-data 'get-local-variables)))
(if vars
(progn
@@ -363,7 +362,7 @@ This skips forward over symbols in a complex reference.
For example, in the C statement:
this.that().entry;
-If the cursor is on 'this', will move point to the ; after entry.")
+If the cursor is on `this', will move point to the ; after entry.")
(defun semantic-ctxt-end-of-symbol-default (&optional point)
"Move point to the end of the current symbol under POINT.
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index 8b121587147..15f544746eb 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -1,6 +1,6 @@
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
-;;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index a62ac549ea7..2199a7d9862 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,6 +1,6 @@
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; Joakim Verona
@@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'."
If DIRECTORY is found to be defunct, it won't load the DB, and will
warn instead."
(if (file-directory-p directory)
- (semanticdb-create-database semanticdb-project-database-ebrowse
+ (semanticdb-create-database 'semanticdb-project-database-ebrowse
directory)
(let* ((BF (semanticdb-ebrowse-file-for-directory directory))
(BFL (concat BF "-load.el"))
@@ -224,7 +224,7 @@ warn instead."
()
"Search Ebrowse for symbols.")
-(defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
+(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
@@ -282,7 +282,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
;;; Methods for creating a database or tables
;;
-(defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-create-database ((dbeC (subclass semanticdb-project-database-ebrowse))
directory)
"Create a new semantic database for DIRECTORY based on ebrowse.
If there is no database for DIRECTORY available, then
@@ -325,7 +325,7 @@ If there is no database for DIRECTORY available, then
db)))
-(defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
data)
"For the ebrowse database DBE, strip all tables from DATA."
;JAVE what it actually seems to do is split the original tree in "tables" associated with files
@@ -479,7 +479,7 @@ Optional argument BASECLASSES specifies a baseclass to the tree being provided."
;;;
;; Overload for converting the simple faux tag into something better.
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
"Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAGS
@@ -521,7 +521,7 @@ return that."
(setq tags (cdr tags))))
tagret))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
"Convert in Ebrowse database OBJ one TAG into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAG
@@ -569,48 +569,48 @@ return that."
;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
;; how your new search routines are implemented.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; If we ever need to do something special, add here.
;; Since ebrowse tags are converted into semantic tags, we can
;; get away with this sort of thing.
- (call-next-method)
+ (cl-call-next-method)
)
)
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-ebrowse) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
- (call-next-method)))
+ (if tags (cl-call-next-method)
+ (cl-call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -621,38 +621,38 @@ Returns a table of all matching tags."
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-method table name tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;(semanticdb-find-tags-for-completion-method table prefix tags)
- (call-next-method))
+ (cl-call-next-method))
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-ebrowse) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; Ebrowse collects all this type of stuff together for us.
;; but we can't use it.... yet.
nil
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 3376389c7d5..432f638475a 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
-;;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -44,16 +44,16 @@
)
"A table for returning search results from Emacs.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
"Do not refresh Emacs Lisp table.
It does not need refreshing."
nil)
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
"Return nil, we never need a refresh."
nil)
-(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
@@ -67,7 +67,7 @@ Adds the number of tags in this file to the object print name."
)
"Database representing Emacs core.")
-(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(let ((count 0))
@@ -90,7 +90,7 @@ the omniscience database.")
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
"For an Emacs Lisp database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; We need to return something since there is always the "master table"
@@ -101,34 +101,34 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
"From OBJ, return FILENAME's associated table object.
For Emacs Lisp, creates a specialized table."
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
"Return the list of tags belonging to TABLE."
;; specialty table ? Probably derive tags at request time.
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(with-current-buffer buffer
(eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
"Fetch the full filename that OBJ refers to.
For Emacs Lisp system DB, there isn't one."
nil)
;;; Conversion
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
"Convert tags, originating from Emacs OBJ, into standardized form."
(let ((newtags nil))
(dolist (T tags)
@@ -138,7 +138,7 @@ For Emacs Lisp system DB, there isn't one."
;; There is no promise to have files associated.
(nreverse newtags)))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
"Convert one TAG, originating from Emacs OBJ, into standardized form.
If Emacs cannot resolve this symbol to a particular file, then return nil."
;; Here's the idea. For each tag, get the name, then use
@@ -223,7 +223,11 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots
+ (let ((class (find-class sym)))
+ (if (fboundp 'eieio--class-public-a) ; Emacs < 25.1
+ (eieio--class-public-a class)
+ (mapcar #'eieio-slot-descriptor-name
+ (eieio-class-slots class)))))
(semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
@@ -243,12 +247,12 @@ TOKTYPE is a hint to the type of tag desired."
(defvar semanticdb-elisp-mapatom-collector nil
"Variable used to collect `mapatoms' output.")
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags named NAME in TABLE.
Uses `intern-soft' to match NAME to Emacs symbols.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; No need to search. Use `intern-soft' which does the same thing for us.
(let* ((sym (intern-soft name))
(fun (semanticdb-elisp-sym->tag sym 'function))
@@ -264,52 +268,52 @@ Return a list of tags."
taglst
))))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Uses `apropos-internal' to find matches.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(apropos-internal regex)))))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(all-completions prefix obarray)))))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-emacs-lisp) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; We could implement this, but it could be messy.
nil))
;;; Deep Searches
;;
;; For Emacs Lisp deep searches are like top level searches.
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
@@ -318,12 +322,12 @@ Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp."
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-emacs-lisp) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; EIEIO is the only time this matters
(when (featurep 'eieio)
(let* ((class (intern-soft type))
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index 2ef4fba1288..f38153b18c1 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
;;; semantic/db-file.el --- Save a semanticdb to a cache file.
-;;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -123,7 +123,7 @@ To save the version number, we must hand-set this version string.")
;;; Code:
;;
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database-file))
directory)
"Create a new semantic database for DIRECTORY and return it.
If a database for DIRECTORY has already been loaded, return it.
@@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one."
(defun semanticdb-load-database (filename)
"Load the database FILENAME."
(condition-case foo
- (let* ((r (eieio-persistent-read filename semanticdb-project-database-file))
+ (let* ((r (eieio-persistent-read filename
+ 'semanticdb-project-database-file))
(c (semanticdb-get-database-tables r))
(tv (oref r semantic-tag-version))
(fv (oref r semanticdb-version))
@@ -196,7 +197,7 @@ If DIRECTORY doesn't exist, create a new one."
"Return the project belonging to FILENAME if it was already loaded."
(eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
-(defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
&optional suppress-questions)
"Does the directory the database DB needs to write to exist?
If SUPPRESS-QUESTIONS, then do not ask to create the directory."
@@ -218,7 +219,7 @@ If SUPPRESS-QUESTIONS, then do not ask to create the directory."
(setq semanticdb--inhibit-make-directory t))
nil))))
-(defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
&optional
suppress-questions)
"Write out the database DB to its file.
@@ -258,13 +259,13 @@ If DB is not specified, then use the current database."
)
))
-(defmethod semanticdb-live-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-project-database))
"Return non-nil if the file associated with OBJ is live.
Live databases are objects associated with existing directories."
(and (slot-boundp obj 'reference-directory)
(file-exists-p (oref obj reference-directory))))
-(defmethod semanticdb-live-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-table))
"Return non-nil if the file associated with OBJ is live.
Live files are either buffers in Emacs, or files existing on the filesystem."
(let ((full-filename (semanticdb-full-filename obj)))
@@ -278,7 +279,7 @@ to prevent overload.")
(declare-function data-debug-insert-thing "data-debug")
-(defmethod object-write ((obj semanticdb-table))
+(cl-defmethod object-write ((obj semanticdb-table))
"When writing a table, we have to make sure we deoverlay it first.
Restore the overlays after writing.
Argument OBJ is the object to write."
@@ -311,7 +312,7 @@ Argument OBJ is the object to write."
;; Do it!
(condition-case tableerror
- (call-next-method)
+ (cl-call-next-method)
(error
(when semanticdb-data-debug-on-write-error
(require 'data-debug)
@@ -327,7 +328,7 @@ Argument OBJ is the object to write."
;;; State queries
;;
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
(let ((path semanticdb-persistent-path))
@@ -359,25 +360,25 @@ Uses `semanticdb-persistent-path' to determine the return value."
(throw 'found t))
(t (error "Invalid path %S" (car path))))
(setq path (cdr path)))
- (call-next-method))
+ (cl-call-next-method))
))
;;; Filename manipulation
;;
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
"From OBJ, return FILENAME's associated table object."
;; Cheater option. In this case, we always have files directly
;; under ourselves. The main project type may not.
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
-(defmethod semanticdb-file-name-non-directory :STATIC
- ((dbclass semanticdb-project-database-file))
+(cl-defmethod semanticdb-file-name-non-directory
+ ((dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
-(defmethod semanticdb-file-name-directory :STATIC
- ((dbclass semanticdb-project-database-file) directory)
+(cl-defmethod semanticdb-file-name-directory
+ ((dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory
@@ -388,8 +389,8 @@ The returned path is related to DIRECTORY."
file (file-name-as-directory semanticdb-default-save-directory)))
directory))
-(defmethod semanticdb-cache-filename :STATIC
- ((dbclass semanticdb-project-database-file) path)
+(cl-defmethod semanticdb-cache-filename
+ ((dbclass (subclass semanticdb-project-database-file)) path)
"For DBCLASS, return a file to a cache file belonging to PATH.
This could be a cache file in the current directory, or an encoded file
name in a secondary directory."
@@ -398,7 +399,7 @@ name in a secondary directory."
(concat (semanticdb-file-name-directory dbclass path)
(semanticdb-file-name-non-directory dbclass)))
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
"Fetch the full filename that OBJ refers to."
(oref obj file))
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 91b1e34b690..293f535d60b 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,6 +1,6 @@
;;; semantic/db-find.el --- Searching through semantic databases.
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -196,7 +196,7 @@ expunge duplicates.")
"Concrete search index for `semanticdb-find'.
This class will cache data derived during various searches.")
-(defmethod semantic-reset ((idx semanticdb-find-search-index))
+(cl-defmethod semantic-reset ((idx semanticdb-find-search-index))
"Reset the object IDX."
(require 'semantic/scope)
;; Clear the include path.
@@ -208,7 +208,7 @@ This class will cache data derived during various searches.")
(semantic-scope-reset-cache)
)
-(defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
@@ -220,7 +220,7 @@ This class will cache data derived during various searches.")
(semantic-reset (semanticdb-get-table-index tab))))
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; Only reset if include statements changed.
@@ -297,7 +297,7 @@ refreshed when things change. See `semanticdb-ref-test'.
Note for overloading: If you opt to overload this function for your
major mode, and your routine takes a long time, be sure to call
- (semantic-throw-on-input 'your-symbol-here)
+ (semantic-throw-on-input \\='your-symbol-here)
so that it can be called from the idle work handler."
)
@@ -1114,7 +1114,7 @@ for backward compatibility.
If optional argument BRUTISH is non-nil, then ignore include statements,
and search all tables in this project tree."
(let (found match)
- (save-excursion
+ (save-current-buffer
;; If path is a buffer, set ourselves up in that buffer
;; so that the override methods work correctly.
(when (bufferp path) (set-buffer path))
@@ -1127,7 +1127,7 @@ and search all tables in this project tree."
;; databases and not associated with a file.
(unless (and find-file-match
(obj-of-class-p
- (car tableandtags) semanticdb-search-results-table))
+ (car tableandtags) 'semanticdb-search-results-table))
(when (setq match (funcall function
(car tableandtags) (cdr tableandtags)))
(when find-file-match
@@ -1144,7 +1144,7 @@ and search all tables in this project tree."
;; `semanticdb-search-results-table', since those are system
;; databases and not associated with a file.
(unless (and find-file-match
- (obj-of-class-p table semanticdb-search-results-table))
+ (obj-of-class-p table 'semanticdb-search-results-table))
(when (and table (setq match (funcall function table nil)))
(semanticdb-find-log-activity table match)
(when find-file-match
@@ -1304,25 +1304,25 @@ associated with that tag should be loaded into a buffer."
;; Override these with system databases to as new types of back ends.
;;; Top level Searches
-(defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name name (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
+(cl-defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -1333,14 +1333,14 @@ Returns a table of all matching tags."
(semantic-find-tags-included (or tags (semanticdb-get-tags table)))
(semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(require 'semantic/find)
(semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -1348,7 +1348,7 @@ Returns a table of all matching tags."
(semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table))))
;;; Deep Searches
-(defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
@@ -1356,7 +1356,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags."
(semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
@@ -1364,7 +1364,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index 70d5f6ecc05..b95fa34cb3c 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -1,6 +1,6 @@
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
-;; Copyright (C) 2002-2006, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2006, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -112,12 +112,12 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
)
"A table for returning search results from GNU Global.")
-(defmethod object-print ((obj semanticdb-table-global) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-global) &rest strings)
"Pretty printer extension for `semanticdb-table-global'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -126,7 +126,7 @@ local variable."
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
"For a global database, there are no explicit tables.
For each file hit, get the traditional semantic table from that file."
;; We need to return something since there is always the "master table"
@@ -138,9 +138,9 @@ For each file hit, get the traditional semantic table from that file."
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
"From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
@@ -150,13 +150,13 @@ For each file hit, get the traditional semantic table from that file."
;;
;; Only NAME based searches work with GLOBAL as that is all it tracks.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; Call out to GNU Global for some results.
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-name name 'project))
@@ -167,12 +167,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project))
)
@@ -180,12 +180,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-completion prefix 'project))
(faketags nil)
@@ -206,21 +206,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index dbb3b84be0d..4aced34d8ef 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -1,6 +1,6 @@
;;; semantic/db-javascript.el --- Semantic database extensions for javascript
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Joakim Verona
@@ -111,7 +111,7 @@ the omniscience database.")
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
"For a javascript database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; NOTE: This method overrides an accessor for the `tables' slot in
@@ -126,23 +126,23 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
"From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -192,43 +192,43 @@ database (if available.)"
(setq tags (cdr tags)))
result))
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
(assoc-string name semanticdb-javascript-tags)
))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search regex)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search (concat "^" prefix ".*"))
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-javascript) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; Note: This search method could be considered optional in an
@@ -244,21 +244,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
@@ -267,12 +267,12 @@ Like `semanticdb-find-tags-for-completion-method' for javascript."
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-javascript) type &optional tags)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; OPTIONAL: This could be considered an optional function. It is
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 7d147113a92..433d5ae4fd1 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -1,6 +1,6 @@
;;; semantic/db-mode.el --- Semanticdb Minor Mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -66,7 +66,7 @@ database, which can be saved for future Emacs sessions."
(add-hook (cadr elt) (car elt)))
;; Disable
(dolist (elt semanticdb-hooks)
- (add-hook (cadr elt) (car elt)))))
+ (remove-hook (cadr elt) (car elt)))))
(defvaralias 'semanticdb-mode-hook 'global-semanticdb-minor-mode-hook)
(defvaralias 'semanticdb-global-mode 'global-semanticdb-minor-mode)
@@ -82,7 +82,7 @@ Update the environment of Semantic enabled buffers accordingly."
;; Save databases before disabling semanticdb.
(semanticdb-save-all-db))
;; Toggle semanticdb minor mode.
- (global-semanticdb-minor-mode))
+ (global-semanticdb-minor-mode 'toggle))
;;; Hook Functions:
;;
@@ -105,7 +105,8 @@ Sets up the semanticdb environment."
(oset ctbl major-mode major-mode)
;; Local state
(setq semanticdb-current-table ctbl)
- ;; Try to swap in saved tags
+ (oset ctbl buffer (current-buffer))
+ ;; Try to swap in saved tags
(if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags))
(/= (or (oref ctbl pointmax) 0) (point-max))
)
@@ -133,7 +134,6 @@ Sets up the semanticdb environment."
(semantic--set-buffer-cache (oref ctbl tags))
;; Don't need it to be dirty. Set dirty due to hooks from above.
(oset ctbl dirty nil) ;; Special case here.
- (oset ctbl buffer (current-buffer))
;; Bind into the buffer.
(semantic--tag-link-cache-to-buffer)
)
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index 2d00d07b9cf..445dcfe5c20 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -1,6 +1,6 @@
;;; semantic/db-ref.el --- Handle cross-db file references
-;;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -37,6 +37,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'semantic)
(require 'semantic/db)
(require 'semantic/tag)
@@ -44,7 +45,7 @@
;; For the semantic-find-tags-by-name-regexp macro.
(eval-when-compile (require 'semantic/find))
-(defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
+(cl-defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
include-tag)
"Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG. The reference
@@ -66,18 +67,18 @@ will be added to the database that INCLUDE-TAG refers to."
(object-add-to-list refdbt 'db-refs dbt)
t)))
-(defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
nil)
-(defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
"Return a list of direct includes in table DBT."
(semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))
-(defmethod semanticdb-check-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
"Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whos file no longer
refers to DBT will be removed."
@@ -108,13 +109,13 @@ refers to DBT will be removed."
))
(setq refs (cdr refs)))))
-(defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
"Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed.
nil
)
-(defmethod semanticdb-refresh-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
"Refresh references to DBT in other files."
(let ((refs (semanticdb-includes-in-table dbt))
)
@@ -127,7 +128,7 @@ refers to DBT will be removed."
(setq refs (cdr refs)))
))
-(defmethod semanticdb-notify-references ((dbt semanticdb-table)
+(cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
method)
"Notify all references of the table DBT using method.
METHOD takes two arguments.
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index a20ff83aec8..20b5b3f9ea0 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,6 +1,6 @@
;;; semantic/db-typecache.el --- Manage Datatypes
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -67,7 +67,7 @@ Said object must support `semantic-reset' methods.")
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-typecache))
"Reset the object IDX."
(oset tc filestream nil)
(oset tc includestream nil)
@@ -78,14 +78,14 @@ Said object must support `semantic-reset' methods.")
(oset tc dependants nil)
)
-(defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
+(cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on."
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
-(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
new-tags)
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
@@ -125,7 +125,7 @@ Debugging function."
(t -1) ))
-(defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
"Retrieve the typecache from the semanticdb TABLE.
If there is no table, create one, and fill it in."
(semanticdb-refresh-table table)
@@ -141,7 +141,7 @@ If there is no table, create one, and fill it in."
cache))
-(defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
"Return non-nil (the typecache) if TABLE has a pre-calculated typecache."
(let* ((idx (semanticdb-get-table-index table)))
(oref idx type-cache)))
@@ -162,25 +162,25 @@ If there is no table, create one, and fill it in."
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-database-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-database-typecache))
"Reset the object IDX."
(oset tc stream nil)
)
-(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
)
-(defmethod semanticdb-get-typecache ((db semanticdb-project-database))
+(cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB.
If there is no table, create one, and fill it in."
- (semanticdb-cache-get db semanticdb-database-typecache)
+ (semanticdb-cache-get db 'semanticdb-database-typecache)
)
@@ -312,11 +312,11 @@ If TAG has fully qualified names, expand it to a series of nested
namespaces instead."
tag)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the file-tags.
File-tags are those that belong to this file only, and excludes
all included files."
@@ -338,11 +338,11 @@ all included files."
(oref cache filestream)
))
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the merged types from the include tags.
Include-tags are the tags brought in via includes, all merged together into
a master list."
@@ -418,7 +418,7 @@ is of class 'type."
(types (semantic-find-tags-by-class 'type nmerge)))
(or (car-safe types) (car-safe nmerge))))
-(defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
type find-file-match)
"Search the typecache in TABLE for the datatype TYPE.
If type is a string, split the string, and search for the parts.
@@ -544,7 +544,7 @@ found tag to be loaded."
;;
;; Routines for a typecache that crosses all tables in a given database
;; for a matching major-mode.
-(defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
+(cl-defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
&optional mode)
"Return the typecache for the project database DB.
If there isn't one, create it.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 8d9cfcccd7d..e4ac56cdab4 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,6 +1,6 @@
;;; semantic/db.el --- Semantic tag database manager
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -115,32 +115,44 @@ This table is the root of tables, and contains the minimum needed
for a new table not associated with a buffer."
:abstract t)
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
"Return a nil, meaning abstract table OBJ is not in a buffer."
nil)
-(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
"Return a buffer associated with OBJ.
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
-(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
+;; This generic method allows for sloppier coding. Many
+;; functions treat "table" as something that could be a buffer,
+;; file name, or other. This makes use of table more robust.
+(cl-defmethod semanticdb-full-filename (buffer-or-string)
+ "Fetch the full filename that BUFFER-OR-STRING refers to.
+This uses semanticdb to get a better file name."
+ (cond ((bufferp buffer-or-string)
+ (with-current-buffer buffer-or-string
+ (semanticdb-full-filename semanticdb-current-table)))
+ ((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
+ (expand-file-name buffer-or-string))))
+
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
- "Return non-nil if OBJ is 'dirty'."
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
+ "Return non-nil if OBJ is dirty."
nil)
-(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
"Mark the abstract table OBJ dirty.
Abstract tables can not be marked dirty, as there is nothing
for them to synchronize against."
;; The abstract table can not be dirty.
nil)
-(defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
"For the table OBJ, convert a list of TAGS, into standardized form.
The default is to return TAGS.
Some databases may default to searching and providing simplified tags
@@ -148,7 +160,7 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form."
tags)
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
"For the table OBJ, convert a TAG, into standardized form.
This method returns a list of the form (DATABASE . NEWTAG).
@@ -159,14 +171,14 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form."
(cons obj tag))
-(defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
"Pretty printer extension for `semanticdb-abstract-table'.
Adds the number of tags in this file to the object print name."
(if (or (not strings)
(and (= (length strings) 1) (stringp (car strings))
(string= (car strings) "")))
;; Else, add a tags quantifier.
- (call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
+ (cl-call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
;; Pass through.
(apply 'call-next-method obj strings)
))
@@ -183,7 +195,7 @@ The search index will store data about which other tables might be
needed, or perhaps create hash or index tables for the current buffer."
:abstract t)
-(defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
"Return the search index for the table OBJ.
If one doesn't exist, create it."
(if (slot-boundp obj 'index)
@@ -197,13 +209,13 @@ If one doesn't exist, create it."
(oset obj index idx)
idx)))
-(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -221,7 +233,7 @@ If one doesn't exist, create it."
Examples include search results from external sources such as from
Emacs's own symbol table, or from external libraries.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
This will call `semantic-fetch-tags' if that file is in memory."
nil)
@@ -273,7 +285,7 @@ For C/C++, the C preprocessor macros can be saved here.")
)
"A single table of tags derived from file.")
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer."
(let ((buff (oref obj buffer)))
@@ -281,7 +293,7 @@ If the buffer is in memory, return that buffer."
buff
(oset obj buffer nil))))
-(defmethod semanticdb-get-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer.
If the buffer is not in memory, load it with `find-file-noselect'."
@@ -290,26 +302,26 @@ If the buffer is not in memory, load it with `find-file-noselect'."
(save-match-data
(find-file-noselect (semanticdb-full-filename obj) t))))
-(defmethod semanticdb-set-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-buffer ((obj semanticdb-table))
"Set the current buffer to be a buffer owned by OBJ.
If OBJ's file is not loaded, read it in first."
(set-buffer (semanticdb-get-buffer obj)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table))
"Fetch the full filename that OBJ refers to."
(expand-file-name (oref obj file)
(oref (oref obj parent-db) reference-directory)))
-(defmethod semanticdb-dirty-p ((obj semanticdb-table))
- "Return non-nil if OBJ is 'dirty'."
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-table))
+ "Return non-nil if OBJ is dirty."
(oref obj dirty))
-(defmethod semanticdb-set-dirty ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
"Mark the abstract table OBJ dirty."
(oset obj dirty t)
)
-(defmethod object-print ((obj semanticdb-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table) &rest strings)
"Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj
@@ -318,6 +330,10 @@ Adds the number of tags in this file to the object print name."
;;; DATABASE BASE CLASS
;;
+(unless (fboundp 'semanticdb-abstract-table-list-p)
+ (cl-deftype semanticdb-abstract-table-list ()
+ '(list-of semanticdb-abstract-table)))
+
(defclass semanticdb-project-database (eieio-instance-tracker)
((tracking-symbol :initform semanticdb-database-list)
(reference-directory :type string
@@ -347,13 +363,13 @@ Note: This index will not be saved in a persistent file.")
:documentation "List of `semantic-db-table' objects."))
"Database of file tables.")
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
- "Return non-nil if DB is 'dirty'.
+(cl-defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
+ "Return non-nil if DB is dirty.
A database is dirty if the state of the database changed in a way
where it may need to resynchronize with some persistent storage."
(let ((dirty nil)
@@ -363,7 +379,7 @@ where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs)))
dirty))
-(defmethod object-print ((obj semanticdb-project-database) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database) &rest strings)
"Pretty printer extension for `semanticdb-project-database'.
Adds the number of tables in this file to the object print name."
(apply 'call-next-method obj
@@ -374,7 +390,7 @@ Adds the number of tables in this file to the object print name."
)
strings)))
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
"Create a new semantic database of class DBC for DIRECTORY and return it.
If a database for DIRECTORY has already been created, return it.
If DIRECTORY doesn't exist, create a new one."
@@ -388,11 +404,11 @@ If DIRECTORY doesn't exist, create a new one."
(oset db reference-directory (file-truename directory)))
db))
-(defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
+(cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
"Reset the tables in DB to be empty."
(oset db tables nil))
-(defmethod semanticdb-create-table ((db semanticdb-project-database) file)
+(cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file)
"Create a new table in DB for FILE and return it.
The class of DB contains the class name for the type of table to create.
If the table for FILE exists, return it.
@@ -409,7 +425,7 @@ If the table for FILE does not exist, create one."
(object-add-to-list db 'tables newtab t))
newtab))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
"From OBJ, return FILENAME's associated table object."
(object-assoc (file-relative-name (file-truename filename)
(oref obj reference-directory))
@@ -459,7 +475,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
desired-class)
"Get a cache object on TABLE of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
@@ -469,7 +485,7 @@ other than :table."
(let ((cache (oref table cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
@@ -479,18 +495,18 @@ other than :table."
(object-add-to-list table 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list table 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -510,7 +526,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-get ((db semanticdb-project-database)
desired-class)
"Get a cache object on DB of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
@@ -520,7 +536,7 @@ other than :table."
(let ((cache (oref db cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
@@ -530,19 +546,19 @@ other than :table."
(object-add-to-list db 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-remove ((db semanticdb-project-database)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list db 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -550,7 +566,7 @@ other than :table."
;;; REFRESH
-(defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
Optional argument FORCE will force a refresh even if the file in question
is not in a buffer. Avoid using FORCE for most uses, as an old cache
@@ -560,8 +576,9 @@ This will call `semantic-fetch-tags' if that file is in memory."
;;
;; Already in a buffer, just do it.
((semanticdb-in-buffer-p obj)
- (semanticdb-set-buffer obj)
- (semantic-fetch-tags))
+ (save-excursion
+ (semanticdb-set-buffer obj)
+ (semantic-fetch-tags)))
;;
;; Not in a buffer. Forcing a load.
(force
@@ -576,7 +593,7 @@ This will call `semantic-fetch-tags' if that file is in memory."
;; Kill off the buffer if it didn't exist when we were called.
(kill-buffer buff))))))
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
"Return non-nil of OBJ's tag list is out of date.
The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj))
@@ -607,7 +624,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; Synchronization
;;
-(defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE with some NEW-TAGS."
(oset table tags new-tags)
@@ -638,7 +655,7 @@ The file associated with OBJ does not need to be in a buffer."
(semanticdb-refresh-references table)
)
-(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE where some NEW-TAGS changed."
;; You might think we need to reset the tags, but since the partial
@@ -671,7 +688,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; SAVE/LOAD
;;
-(defmethod semanticdb-save-db ((DB semanticdb-project-database)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database)
&optional suppress-questions)
"Cause a database to save itself.
The database base class does not save itself persistently.
@@ -697,7 +714,7 @@ form."
(interactive)
(unless noninteractive
(message "Saving tag summaries..."))
- (let ((semanticdb--inhibit-make-directory nil))
+ (let ((semanticdb--inhibit-make-directory noninteractive))
(mapc 'semanticdb-save-db semanticdb-database-list))
(unless noninteractive
(message "Saving tag summaries...done")))
@@ -706,6 +723,7 @@ form."
"Save all semantic tag databases from idle time.
Exit the save between databases if there is user input."
(semantic-safe "Auto-DB Save: %S"
+ ;; FIXME: Use `while-no-input'?
(semantic-exit-on-input 'semanticdb-idle-save
(mapc (lambda (db)
(semantic-throw-on-input 'semanticdb-idle-save)
@@ -724,7 +742,7 @@ Project Management software (such as EDE and JDE) should add their own
predicates with `add-hook' to this variable, and semanticdb will save tag
caches in directories controlled by them.")
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
nil)
@@ -755,7 +773,7 @@ This temporarily sets `semanticdb-match-any-mode' while executing BODY."
,@body))
(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
-(defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
See `semanticdb-equivalent-mode' for details.
This version is used during searches. Major-modes that opt
@@ -766,13 +784,13 @@ all files of any type."
(semanticdb-equivalent-mode table buffer))
)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index 775f98fe4e0..4a3c51f4e0c 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -1,6 +1,6 @@
;;; semantic/debug.el --- Language Debugger framework
-;; Copyright (C) 2003-2005, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -39,6 +39,7 @@
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(eval-when-compile (require 'semantic/find))
;;; Code:
@@ -57,6 +58,12 @@ to one of the parser generators.")
;;;###autoload
(make-variable-buffer-local 'semantic-debug-parser-class)
+;;;###autoload
+(defvar semantic-debug-parser-debugger-source nil
+ "Location of the debug parser class.")
+;;;###autoload
+(make-variable-buffer-local 'semantic-debug-parser-source)
+
(defvar semantic-debug-enabled nil
"Non-nil when debugging a parser.")
@@ -104,19 +111,20 @@ These buffers are brought into view when layout occurs.")
"The currently displayed frame.")
(overlays :type list
:initarg nil
+ :initform nil
:documentation
"Any active overlays being used to show the debug position.")
)
"Controls action when in `semantic-debug-mode'")
;; Methods
-(defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
+(cl-defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
"Set the current frame on IFACE to FRAME."
(if frame
(oset iface current-frame frame)
(slot-makeunbound iface 'current-frame)))
-(defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
"Set the parser location in IFACE to POINT."
(with-current-buffer (oref iface parser-buffer)
(if (not (slot-boundp iface 'parser-location))
@@ -124,7 +132,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface parser-location) point))
)
-(defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
"Set the source location in IFACE to POINT."
(with-current-buffer (oref iface source-buffer)
(if (not (slot-boundp iface 'source-location))
@@ -132,7 +140,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface source-location) point))
)
-(defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
"Layout windows in the current frame to facilitate debugging."
(delete-other-windows)
;; Deal with the data buffer
@@ -160,7 +168,7 @@ These buffers are brought into view when layout occurs.")
(goto-char (oref iface source-location)))
)
-(defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
+(cl-defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
"For IFACE, highlight TOKEN in the source buffer .
TOKEN is a lexical token."
(set-buffer (oref iface :source-buffer))
@@ -171,7 +179,7 @@ TOKEN is a lexical token."
(semantic-debug-set-source-location iface (semantic-lex-token-start token))
)
-(defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
+(cl-defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
"For IFACE, highlight NONTERM in the parser buffer.
NONTERM is the name of the rule currently being processed that shows up
as a nonterminal (or tag) in the source buffer.
@@ -219,7 +227,7 @@ If RULE and MATCH indices are specified, highlight those also."
))))
-(defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
"Remove all debugging overlays."
(mapc 'semantic-overlay-delete (oref iface overlays))
(oset iface overlays nil))
@@ -264,12 +272,12 @@ on different types of return values."
)
"One frame representation.")
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
)
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
)
@@ -323,15 +331,18 @@ Argument ONOFF is non-nil when we are entering debug mode.
(oref semantic-debug-current-interface parser-buffer)
(use-local-map
(oref semantic-debug-current-interface parser-local-map))
+ (setq buffer-read-only nil)
)
(with-current-buffer
(oref semantic-debug-current-interface source-buffer)
(use-local-map
(oref semantic-debug-current-interface source-local-map))
+ (setq buffer-read-only nil)
)
(run-hooks 'semantic-debug-exit-hook)
)))
+;;;###autoload
(defun semantic-debug ()
"Parse the current buffer and run in debug mode."
(interactive)
@@ -341,6 +352,9 @@ Argument ONOFF is non-nil when we are entering debug mode.
(error "This major mode does not support parser debugging"))
;; Clear the cache to force a full reparse.
(semantic-clear-toplevel-cache)
+ ;; Load in the debugger for this file.
+ (when semantic-debug-parser-debugger-source
+ (require semantic-debug-parser-debugger-source))
;; Do the parse
(let ((semantic-debug-enabled t)
;; Create an interface
@@ -508,49 +522,49 @@ by overriding one of the command methods. Be sure to use
down to your parser later."
:abstract t)
-(defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
"Execute next for this PARSER."
(setq semantic-debug-user-command 'next)
)
-(defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
"Execute a step for this PARSER."
(setq semantic-debug-user-command 'step)
)
-(defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go)
)
-(defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail)
)
-(defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit)
)
-(defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort)
)
-(defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface
(when current-frame
(semantic-debug-frame-info current-frame)
)))
-(defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
"Set a breakpoint for this PARSER."
)
;; Stack stuff
-(defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
"Return a list of frames for the current parser.
A frame is of the form:
( .. .what ? .. )
diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el
index 5bd683fcd22..6707fdff40c 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -1,6 +1,6 @@
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
-;;; Copyright (C) 1999-2003, 2005-2007, 2009-2013 Free Software
+;;; Copyright (C) 1999-2003, 2005-2007, 2009-2015 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -88,20 +88,6 @@ If VISIBLE is non-nil, make the text visible."
"Return non-nil if TAG is invisible."
(semantic-overlay-get (semantic-tag-overlay tag) 'invisible))
-(defun semantic-set-tag-intangible (tag &optional tangible)
- "Enable the text in TAG to be made intangible.
-If TANGIBLE is non-nil, make the text visible.
-This function does not have meaning in XEmacs because it seems that
-the extent 'intangible' property does not exist."
- (semantic-overlay-put (semantic-tag-overlay tag) 'intangible
- (not tangible)))
-
-(defun semantic-tag-intangible-p (tag)
- "Return non-nil if TAG is intangible.
-This function does not have meaning in XEmacs because it seems that
-the extent 'intangible' property does not exist."
- (semantic-overlay-get (semantic-tag-overlay tag) 'intangible))
-
(defun semantic-overlay-signal-read-only
(overlay after start end &optional len)
"Hook used in modification hooks to prevent modification.
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 0451ad44fe8..1974e0ade07 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/include.el --- Decoration modes for include statements
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -42,8 +42,8 @@
;;; Code:
;;; FACES AND KEYMAPS
-(defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
- "The keybinding lisp object to use for binding the right mouse button.")
+(defvar semantic-decoration-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
+ "The keybinding Lisp object to use for binding the right mouse button.")
;;; Includes that are in a happy state!
;;
@@ -55,7 +55,7 @@ Used by the decoration style: `semantic-decoration-on-includes'."
(defvar semantic-decoration-on-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu)
km)
"Keymap used on includes.")
@@ -126,7 +126,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'."
(defvar semantic-decoration-on-unknown-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -189,7 +189,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'."
(defvar semantic-decoration-on-fileless-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-fileless-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -251,7 +251,7 @@ Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
(defvar semantic-decoration-on-unparsed-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -335,6 +335,9 @@ This mode provides a nice context menu on the include statements."
(defun semantic-decoration-on-includes-highlight-default (tag)
"Highlight the include TAG to show that semantic can't find it."
(let* ((file (semantic-dependency-tag-file tag))
+ ;; Don't actually load includes
+ (semanticdb-find-default-throttle
+ (remq 'unloaded semanticdb-find-default-throttle))
(table (semanticdb-find-table-for-include tag (current-buffer)))
(face nil)
(map nil)
@@ -365,8 +368,8 @@ This mode provides a nice context menu on the include statements."
(semanticdb-cache-get
table 'semantic-decoration-unparsed-include-cache)
;; Add a dependency.
- (let ((table semanticdb-current-table))
- (semanticdb-add-reference table tag))
+ (let ((currenttable semanticdb-current-table))
+ (semanticdb-add-reference currenttable tag))
)
))
@@ -500,7 +503,8 @@ Argument EVENT is the mouse clicked event."
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n\n")
- (princ "This header file has been marked \"Unknown\".
+ (princ (substitute-command-keys "\
+This header file has been marked \"Unknown\".
This means that Semantic has not been able to locate this file on disk.
When Semantic cannot find an include file, this means that the
@@ -518,9 +522,9 @@ M-x semantic-add-system-include RET /path/to/includes RET
or, in your .emacs file do:
- (semantic-add-system-include \"/path/to/include\" '")
+ (semantic-add-system-include \"/path/to/include\" \\='"))
(princ (symbol-name mm))
- (princ ")
+ (princ (substitute-command-keys ")
to add the path to Semantic's search.
@@ -528,7 +532,7 @@ If this is an include file that belongs to your project, then you may
need to update `semanticdb-project-roots' or better yet, use `ede'
to manage your project. See the ede manual for projects that will
wrap existing project code for Semantic's benefit.
-")
+"))
(when (or (eq mm 'c++-mode) (eq mm 'c-mode))
(princ "
@@ -536,7 +540,7 @@ For C/C++ includes located within a project, you can use a special
EDE project that will wrap an existing build system. You can do that
like this in your .emacs file:
- (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
+ (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn \\='MYFCN)
See the CEDET manual, the EDE manual, or the commentary in
ede/cpp-root.el for more.
@@ -742,7 +746,8 @@ Argument EVENT describes the event that caused this function to be called."
(when (and (boundp 'ede-object)
(boundp 'ede-object-project)
ede-object)
- (princ " This file's project include search is handled by the EDE object:\n")
+ (princ (substitute-command-keys
+ " This file's project include search is handled by the EDE object:\n"))
(princ " Buffer Target: ")
(princ (object-print ede-object))
(princ "\n")
@@ -766,7 +771,8 @@ Argument EVENT describes the event that caused this function to be called."
(princ "\n"))
)))
- (princ "\n This file's system include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's system include path is:\n"))
(dolist (dir semantic-dependency-system-include-path)
(princ " ")
(princ dir)
@@ -828,7 +834,7 @@ When an include's referring file is parsed, we need to undecorate
any decorated referring includes.")
-(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
+(cl-defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
"Reset OBJ back to it's empty settings."
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
@@ -838,13 +844,13 @@ any decorated referring includes.")
))
))
-(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize CACHE with some NEW-TAGS."
(if (semantic-find-tags-by-class 'include new-tags)
(semantic-reset cache)))
-(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index cc5e9d9bec2..9192ec15165 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/mode.el --- Minor mode for decorating tags
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -275,7 +275,13 @@ minor mode is enabled."
'semantic-decorate-tags-after-full-reparse nil t)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
- (semantic-decorate-add-decorations (semantic-fetch-available-tags)))
+ ;; However, don't do this immediately, because EDE will be
+ ;; activated later by find-file-hook, and includes might not
+ ;; be found yet.
+ (run-with-idle-timer
+ 0.1 nil
+ (lambda ()
+ (semantic-decorate-add-decorations (semantic-fetch-available-tags)))))
;; Remove decorations from available tags.
(semantic-decorate-clear-decorations (semantic-fetch-available-tags))
;; Cleanup any leftover crap too.
@@ -387,7 +393,7 @@ must return non-nil to indicate that the tag should be decorated by
`NAME-highlight'.
To put primary decorations on a tag `NAME-highlight' must use
-functions like `semantic-set-tag-face', `semantic-set-tag-intangible',
+functions like `semantic-set-tag-face', `semantic-set-tag-read-only',
etc., found in the semantic-decorate library.
To add other kind of decorations on a tag, `NAME-highlight' must use
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 7f4321f6da6..e5e7da1dd79 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -1,6 +1,6 @@
;;; semantic/dep.el --- Methods for tracking dependencies (include files)
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index e5b958d90a3..3ceb3510ad2 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -1,6 +1,6 @@
;;; semantic/doc.el --- Routines for documentation strings
-;; Copyright (C) 1999-2003, 2005, 2008-2013 Free Software Foundation,
+;; Copyright (C) 1999-2003, 2005, 2008-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -56,13 +56,12 @@ If nosnarf if 'lex, then only return the lex token."
doctmp
;; Check just before the definition.
(when (semantic-tag-with-position-p tag)
- (semantic-documentation-comment-preceeding-tag tag nosnarf))
+ (semantic-documentation-comment-preceding-tag tag nosnarf))
;; Let's look for comments either after the definition, but before code:
;; Not sure yet. Fill in something clever later....
nil))))))
-;; FIXME this is not how you spell "preceding".
-(defun semantic-documentation-comment-preceeding-tag (&optional tag nosnarf)
+(defun semantic-documentation-comment-preceding-tag (&optional tag nosnarf)
"Find a comment preceding TAG.
If TAG is nil. use the tag under point.
Searches the space between TAG and the preceding tag for a comment,
@@ -84,6 +83,10 @@ just the lexical token and not the string."
;; of a function.
(semantic-doc-snarf-comment-for-tag nosnarf)))
))
+(define-obsolete-function-alias
+ 'semantic-documentation-comment-preceeding-tag
+ 'semantic-documentation-comment-preceding-tag
+ "25.1")
(defun semantic-doc-snarf-comment-for-tag (nosnarf)
"Snarf up the comment at POINT for `semantic-documentation-for-tag'.
@@ -118,7 +121,8 @@ If NOSNARF is 'lex, then return the lex token."
(setq ct (concat (substring ct 0 (match-beginning 0))
(substring ct (match-end 0)))))
;; Remove comment delimiter at the end of the string.
- (when (string-match (concat (regexp-quote comment-end) "$") ct)
+ (when (and comment-end (not (string= comment-end ""))
+ (string-match (concat (regexp-quote comment-end) "$") ct))
(setq ct (substring ct 0 (match-beginning 0)))))
;; Now return the text.
ct))))
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 17859e232a3..eb4a98c0a2d 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,6 @@
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
-;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -51,7 +51,7 @@
A grammar target consists of grammar files that build Emacs Lisp programs for
parsing different languages.")
-(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -124,17 +124,17 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs.")
;;; Target options.
-(defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
+(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it
;; is common to have only one target of this class per directory.
(if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
-(defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
+(cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer))
(proj (ede-target-parent obj))
@@ -167,13 +167,13 @@ Lays claim to all -by.el, and -wy.el files."
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p)
(error "No Automake support for Semantic Grammars"))
(t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR"))))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this semantic-ede-proj-target-grammar))
"Insert variables needed by target THIS."
(ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath
@@ -192,7 +192,7 @@ Lays claim to all -by.el, and -wy.el files."
" ")))
)
-(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target.
This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
needed for the compilation of the resulting parsers."
@@ -200,12 +200,12 @@ needed for the compilation of the resulting parsers."
max-lisp-eval-depth 700)'\n"
(oref this name))))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
"Insert dist dependencies, or intermediate targets.
This makes sure that all grammar lisp files are created before the dist
runs, so they are always up to date.
Argument THIS is the target that should insert stuff."
- (call-next-method)
+ (cl-call-next-method)
(insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
)
@@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff."
;; "Target class for Emacs/Semantic grammar files." nil nil)
(ede-proj-register-target "semantic grammar"
- semantic-ede-proj-target-grammar)
+ 'semantic-ede-proj-target-grammar)
(provide 'semantic/ede-grammar)
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 91455cdb741..aa7131e9773 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -1,6 +1,6 @@
;;; semantic/edit.el --- Edit Management for Semantic
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -463,11 +463,11 @@ See `semantic-edits-change-leaf-tag' for details on parents."
(defun semantic-parse-changes-failed (&rest args)
"Signal that Semantic failed to parse changes.
-That is, display a message by passing all ARGS to `format', then throw
+That is, display a message by passing all ARGS to `format-message', then throw
a 'semantic-parse-changes-failed exception with value t."
(when semantic-edits-verbose-flag
(message "Semantic parse changes failed: %S"
- (apply 'format args)))
+ (apply #'format-message args)))
(throw 'semantic-parse-changes-failed t))
(defsubst semantic-edits-incremental-fail ()
@@ -907,11 +907,11 @@ pre-positioned to a convenient location."
(defun semantic-edits-splice-insert (newtags parent cachelist)
"Insert NEWTAGS into PARENT using CACHELIST.
-PARENT could be nil, in which case CACHLIST is the buffer cache
+PARENT could be nil, in which case CACHELIST is the buffer cache
which must be updated.
CACHELIST must be searched to find where NEWTAGS are to be inserted.
The positions of NEWTAGS must be synchronized with those in
-CACHELIST for this to work. Some routines pre-position CACHLIST at a
+CACHELIST for this to work. Some routines pre-position CACHELIST at a
convenient location, so use that."
(let* ((start (semantic-tag-start (car newtags)))
(newtagendcell (nthcdr (1- (length newtags)) newtags))
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index f660c69ec3d..fdd5f5290f1 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -1,6 +1,6 @@
;;; semantic/find.el --- Search routines for Semantic
-;; Copyright (C) 1999-2005, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -265,9 +265,9 @@ TABLE is a semantic tags table. See `semantic-something-to-tag-table'."
"Find the first tag with NAME in TABLE.
NAME is a string.
TABLE is a semantic tags table. See `semantic-something-to-tag-table'.
-This routine uses `assoc' to quickly find the first matching entry."
- (funcall (if semantic-case-fold 'assoc-ignore-case 'assoc)
- name (semantic-something-to-tag-table table)))
+Respects `semantic-case-fold'."
+ (assoc-string name (semantic-something-to-tag-table table)
+ semantic-case-fold))
(defmacro semantic-find-tags-by-name (name &optional table)
"Find all tags with NAME in TABLE.
@@ -457,13 +457,11 @@ TABLE is a tag table. See `semantic-something-to-tag-table'."
"Find a tag NAME within STREAMORBUFFER. NAME is a string.
If SEARCH-PARTS is non-nil, search children of tags.
If SEARCH-INCLUDE was never implemented.
+Respects `semantic-case-fold'.
Use `semantic-find-first-tag-by-name' instead."
(let* ((stream (semantic-something-to-tag-table streamorbuffer))
- (assoc-fun (if semantic-case-fold
- #'assoc-ignore-case
- #'assoc))
- (m (funcall assoc-fun name stream)))
+ (m (assoc-string name stream semantic-case-fold)))
(if m
m
(let ((toklst stream)
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index c6fbbed2424..1184a98951e 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -1,6 +1,6 @@
;;; semantic/format.el --- Routines for formatting tags
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -499,7 +499,12 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(setq r (concat r "[]")
deref (1- deref)))
r)))
- )
+ (default (when (eq class 'variable)
+ (let ((defval
+ (semantic-tag-get-attribute tag :default-value)))
+ (when (and defval (stringp defval))
+ (concat "[=" defval "]")))))
+ )
(if args
(setq args
(concat " "
@@ -512,7 +517,8 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(if type (concat type " "))
name
(or args "")
- (or array ""))))
+ (or array "")
+ (or default ""))))
;;;###autoload
(define-overloadable-function semantic-format-tag-concise-prototype (tag &optional parent color)
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index dadf181ce21..d8ba6f275f3 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
;;; semantic/fw.el --- Framework for Semantic
-;;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -38,6 +38,7 @@
(if (featurep 'xemacs)
(progn
(defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
+ ;; FIXME: Why not just (require 'overlay)?
(defalias 'semantic-overlay-live-p
(lambda (o)
(and (extent-live-p o)
@@ -113,18 +114,13 @@
"Extract the window from EVENT."
(car (car (cdr event))))
- (if (> emacs-major-version 21)
- (defalias 'semantic-buffer-local-value 'buffer-local-value)
+ (defalias 'semantic-buffer-local-value 'buffer-local-value)
- (defun semantic-buffer-local-value (sym &optional buf)
- "Get the value of SYM from buffer local variable in BUF."
- (cdr (assoc sym (buffer-local-variables buf)))))
)
(defalias 'semantic-make-local-hook
- (if (and (not (featurep 'xemacs))
- (>= emacs-major-version 21))
+ (if (featurep 'emacs)
#'identity #'make-local-hook))
(defalias 'semantic-mode-line-update
@@ -177,10 +173,10 @@ recover the cached data with `semantic-get-cache-data'.
LIFESPAN indicates how long the data cache will be remembered.
The default LIFESPAN is 'end-of-command.
Possible Lifespans are:
- 'end-of-command - Remove the cache at the end of the currently
- executing command.
- 'exit-cache-zone - Remove when point leaves the overlay at the
- end of the currently executing command."
+ `end-of-command' - Remove the cache at the end of the currently
+ executing command.
+ `exit-cache-zone' - Remove when point leaves the overlay at the
+ end of the currently executing command."
;; Check if LIFESPAN is valid before to create any overlay
(or lifespan (setq lifespan 'end-of-command))
(or (memq lifespan '(end-of-command exit-cache-zone))
@@ -307,7 +303,7 @@ error message.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
Avoid using a large BODY since it is duplicated."
- ;;(declare (debug t) (indent 1))
+ (declare (debug t) (indent 1))
`(if debug-on-error
;;(let ((inhibit-quit nil)) ,@body)
;; Note to self: Doing the above screws up the wisent parser.
@@ -318,10 +314,18 @@ Avoid using a large BODY since it is duplicated."
(message ,format (format "%S - %s" (current-buffer)
(error-message-string err)))
nil))))
-(put 'semantic-safe 'lisp-indent-function 1)
;;; Misc utilities
;;
+
+(defvar semantic-new-buffer-fcn-was-run nil
+ "Non-nil after `semantic-new-buffer-fcn' has been executed.")
+(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
+
+(defsubst semantic-active-p ()
+ "Return non-nil if the current buffer was set up for parsing."
+ semantic-new-buffer-fcn-was-run)
+
(defsubst semantic-map-buffers (function)
"Run FUNCTION for each Semantic enabled buffer found.
FUNCTION does not have arguments. When FUNCTION is entered
@@ -361,6 +365,8 @@ later installation should be done in MODE hook."
;;
(defvar semantic-current-input-throw-symbol nil
"The current throw symbol for `semantic-exit-on-input'.")
+(defvar semantic--on-input-start-marker nil
+ "The marker when starting a semantic-exit-on-input form.")
(defmacro semantic-exit-on-input (symbol &rest forms)
"Using SYMBOL as an argument to `throw', execute FORMS.
@@ -368,10 +374,11 @@ If FORMS includes a call to `semantic-throw-on-input', then
if a user presses any key during execution, this form macro
will exit with the value passed to `semantic-throw-on-input'.
If FORMS completes, then the return value is the same as `progn'."
- `(let ((semantic-current-input-throw-symbol ,symbol))
+ (declare (indent 1) (debug def-body))
+ `(let ((semantic-current-input-throw-symbol ,symbol)
+ (semantic--on-input-start-marker (point-marker)))
(catch ,symbol
,@forms)))
-(put 'semantic-exit-on-input 'lisp-indent-function 1)
(defmacro semantic-throw-on-input (from)
"Exit with `throw' when in `semantic-exit-on-input' on user input.
@@ -379,7 +386,15 @@ FROM is an indication of where this function is called from as a value
to pass to `throw'. It is recommended to use the name of the function
calling this one."
`(when (and semantic-current-input-throw-symbol
- (or (input-pending-p) (accept-process-output)))
+ (or (input-pending-p)
+ (with-current-buffer
+ (marker-buffer semantic--on-input-start-marker)
+ ;; Timers might run during accept-process-output.
+ ;; If they redisplay, point must be where the user
+ ;; expects. (Bug#15045)
+ (save-excursion
+ (goto-char semantic--on-input-start-marker)
+ (accept-process-output)))))
(throw semantic-current-input-throw-symbol ,from)))
@@ -433,12 +448,12 @@ into `mode-local-init-hook'." file filename)
;;
(defmacro semanticdb-without-unloaded-file-searches (forms)
"Execute FORMS with `unloaded' removed from the current throttle."
+ (declare (indent 1))
`(let ((semanticdb-find-default-throttle
(if (featurep 'semantic/db-find)
(remq 'unloaded semanticdb-find-default-throttle)
nil)))
,forms))
-(put 'semanticdb-without-unloaded-file-searches 'lisp-indent-function 1)
;; ;;; Editor goodies ;-)
@@ -505,12 +520,6 @@ into `mode-local-init-hook'." file filename)
;; (font-lock-add-keywords 'emacs-lisp-mode
;; semantic-fw-font-lock-keywords))
-;;; Interfacing with edebug
-;;
-(defun semantic-fw-add-edebug-spec ()
- (def-edebug-spec semantic-exit-on-input 'def-body))
-
-(add-hook 'edebug-setup-hook 'semantic-fw-add-edebug-spec)
(provide 'semantic/fw)
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 4172390da4e..4b59e17f1e0 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -1,6 +1,6 @@
;;; semantic/grammar-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2009-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -387,12 +387,12 @@
(let
((s $1))
(if
- (string-match "^{[ \n ]*" s)
+ (string-match "^{[\r\n\t ]*" s)
(setq s
(substring s
(match-end 0))))
(if
- (string-match "[ \n ]*}$" s)
+ (string-match "[\r\n\t ]*}$" s)
(setq s
(substring s 0
(match-beginning 0))))
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index ce658cd5d54..fc7e9e61a16 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/grammar.el --- Major mode framework for Semantic grammars
-;; Copyright (C) 2002-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -33,6 +33,8 @@
(require 'semantic/wisent)
(require 'semantic/ctxt)
(require 'semantic/format)
+;; FIXME this is a generated file, but we need to load this file to
+;; generate it!
(require 'semantic/grammar-wy)
(require 'semantic/idle)
(require 'help-fns)
@@ -605,6 +607,11 @@ The symbols in the template are local variables in
\(provide '" libr ")
+;; Local Variables:
+;; version-control: never
+;; no-update-autoloads: t
+;; End:
+
;;; " file " ends here
")
"Generated footer template.
@@ -621,39 +628,38 @@ The symbols in the list are local variables in
t)
(match-string 0))))
+(defun semantic-grammar--template-expand (template env)
+ (mapconcat (lambda (S)
+ (if (stringp S) S
+ (let ((x (assq S env)))
+ (cond
+ (x (cdr x))
+ ((symbolp S) (symbol-value S))))))
+ template ""))
+
(defun semantic-grammar-header ()
"Return text of a generated standard header."
- (let ((file (semantic-grammar-buffer-file
+ (semantic-grammar--template-expand
+ semantic-grammar-header-template
+ `((file . ,(semantic-grammar-buffer-file
semantic--grammar-output-buffer))
- (gram (semantic-grammar-buffer-file))
- (date (format-time-string "%Y-%m-%d %T%z"))
- (vcid (concat "$" "Id" "$")) ;; Avoid expansion
- ;; Try to get the copyright from the input grammar, or
- ;; generate a new one if not found.
- (copy (or (semantic-grammar-copyright-line)
+ (gram . ,(semantic-grammar-buffer-file))
+ (date . ,(format-time-string "%Y-%m-%d %T%z"))
+ (vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
+ ;; Try to get the copyright from the input grammar, or
+ ;; generate a new one if not found.
+ (copy . ,(or (semantic-grammar-copyright-line)
(concat (format-time-string ";; Copyright (C) %Y ")
- user-full-name)))
- (out ""))
- (dolist (S semantic-grammar-header-template)
- (cond ((stringp S)
- (setq out (concat out S)))
- ((symbolp S)
- (setq out (concat out (symbol-value S))))))
- out))
+ user-full-name))))))
(defun semantic-grammar-footer ()
"Return text of a generated standard footer."
- (let* ((file (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
- (libr (or semantic--grammar-provide
- semantic--grammar-package))
- (out ""))
- (dolist (S semantic-grammar-footer-template)
- (cond ((stringp S)
- (setq out (concat out S)))
- ((symbolp S)
- (setq out (concat out (symbol-value S))))))
- out))
+ (semantic-grammar--template-expand
+ semantic-grammar-footer-template
+ `((file . ,(semantic-grammar-buffer-file
+ semantic--grammar-output-buffer))
+ (libr . ,(or semantic--grammar-provide
+ semantic--grammar-package)))))
(defun semantic-grammar-token-data ()
"Return the string value of the table of lexical tokens."
@@ -707,7 +713,7 @@ Block definitions are read from the current table of lexical types."
(let* ((blocks (cdr (semantic-lex-type-value "block" t)))
(open-delims (cdr (semantic-lex-type-value "open-paren" t)))
(close-delims (cdr (semantic-lex-type-value "close-paren" t)))
- olist clist block-spec delim-spec open-spec close-spec)
+ olist clist delim-spec open-spec close-spec)
(dolist (block-spec blocks)
(setq delim-spec (semantic-grammar--lex-delim-spec block-spec)
open-spec (assq (car delim-spec) open-delims)
@@ -811,7 +817,7 @@ Block definitions are read from the current table of lexical types."
;;; Generation of the grammar support file.
;;
-(defcustom semantic-grammar-file-regexp "\\.[wb]y$"
+(defcustom semantic-grammar-file-regexp "\\.[wb]y\\'"
"Regexp which matches grammar source files."
:group 'semantic
:type 'regexp)
@@ -822,9 +828,10 @@ Block definitions are read from the current table of lexical types."
(noninteractive)
noninteractive))
-(defun semantic-grammar-create-package (&optional force)
+(defun semantic-grammar-create-package (&optional force uptodate)
"Create package Lisp code from grammar in current buffer.
-Does nothing if the Lisp code seems up to date.
+If the Lisp code seems up to date, do nothing (if UPTODATE
+is non-nil, return nil in such cases).
If optional argument FORCE is non-nil, unconditionally re-generate the
Lisp code."
(interactive "P")
@@ -854,13 +861,18 @@ Lisp code."
(file-newer-than-file-p
(buffer-file-name semantic--grammar-output-buffer)
(buffer-file-name semantic--grammar-input-buffer)))
- (message "Package `%s' is up to date." semantic--grammar-package)
+ (progn
+ (message "Package `%s' is up to date." semantic--grammar-package)
+ ;; It would be better if this were always the case, IMO,
+ ;; but the (unspecified) return value of this function is
+ ;; assumed to be non-nil in some places, it seems.
+ (if uptodate (setq output nil)))
;; Create the package
(set-buffer semantic--grammar-output-buffer)
;; Use Unix EOLs, so that the file is portable to all platforms.
(setq buffer-file-coding-system 'raw-text-unix)
(erase-buffer)
- (unless (eq major-mode 'emacs-lisp-mode)
+ (unless (derived-mode-p 'emacs-lisp-mode)
(emacs-lisp-mode))
;;;; Header + Prologue
@@ -1060,7 +1072,7 @@ See also the variable `semantic-grammar-file-regexp'."
(defvar semantic--grammar-macros-regexp-2 nil)
(make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
-(defun semantic--grammar-clear-macros-regexp-2 (&rest ignore)
+(defun semantic--grammar-clear-macros-regexp-2 (&rest _)
"Clear the cached regexp that match macros local in this grammar.
IGNORE arguments.
Added to `before-change-functions' hooks to be run before each text
@@ -1102,7 +1114,9 @@ END is the limit of the search."
;;;; Define major mode
;;;;
-(defvar semantic-grammar-syntax-table
+(define-obsolete-variable-alias 'semantic-grammar-syntax-table
+ 'semantic-grammar-mode-syntax-table "24.1")
+(defvar semantic-grammar-mode-syntax-table
(let ((table (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\: "." table) ;; COLON
(modify-syntax-entry ?\> "." table) ;; GT
@@ -1158,19 +1172,25 @@ END is the limit of the search."
(defvar semantic-grammar-mode-keywords-2
(append semantic-grammar-mode-keywords-1
- lisp-font-lock-keywords-1)
+ (if (boundp 'lisp-font-lock-keywords-1)
+ lisp-font-lock-keywords-1
+ lisp-el-font-lock-keywords-1))
"Font Lock keywords used to highlight Semantic grammar buffers.")
(defvar semantic-grammar-mode-keywords-3
(append semantic-grammar-mode-keywords-1
- lisp-font-lock-keywords-2)
+ (if (boundp 'lisp-font-lock-keywords-2)
+ lisp-font-lock-keywords-2
+ lisp-el-font-lock-keywords-2))
"Font Lock keywords used to highlight Semantic grammar buffers.")
(defvar semantic-grammar-mode-keywords
semantic-grammar-mode-keywords-1
"Font Lock keywords used to highlight Semantic grammar buffers.")
-(defvar semantic-grammar-map
+(define-obsolete-variable-alias 'semantic-grammar-map
+ 'semantic-grammar-mode-map "24.1")
+(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "|" 'semantic-grammar-electric-punctuation)
@@ -1271,22 +1291,17 @@ the change bounds to encompass the whole nonterminal tag."
(semantic-tag-start outer)
(semantic-tag-end outer)))))
-(defun semantic-grammar-mode ()
+(define-derived-mode semantic-grammar-mode
+ fundamental-mode "Semantic Grammar Framework"
"Initialize a buffer for editing Semantic grammars.
-\\{semantic-grammar-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'semantic-grammar-mode
- mode-name "Semantic Grammar Framework")
+\\{semantic-grammar-mode-map}"
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start) ";;")
;; Look within the line for a ; following an even number of backslashes
;; after either a non-backslash or the line beginning.
(set (make-local-variable 'comment-start-skip)
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set-syntax-table semantic-grammar-syntax-table)
- (use-local-map semantic-grammar-map)
(set (make-local-variable 'indent-line-function)
'semantic-grammar-indent)
(set (make-local-variable 'fill-paragraph-function)
@@ -1335,15 +1350,14 @@ the change bounds to encompass the whole nonterminal tag."
(semantic-make-local-hook 'semantic-edits-new-change-functions)
(add-hook 'semantic-edits-new-change-functions
'semantic-grammar-edits-new-change-hook-fcn
- nil t)
- (semantic-run-mode-hooks 'semantic-grammar-mode-hook))
+ nil t))
;;;;
;;;; Useful commands
;;;;
(defvar semantic-grammar-skip-quoted-syntax-table
- (let ((st (copy-syntax-table semantic-grammar-syntax-table)))
+ (let ((st (copy-syntax-table semantic-grammar-mode-syntax-table)))
(modify-syntax-entry ?\' "$" st)
st)
"Syntax table to skip a whole quoted expression in grammar code.
@@ -1644,20 +1658,17 @@ Select the buffer containing the tag's definition, and move point there."
)
"Association of syntax elements, and the corresponding help.")
-(declare-function eldoc-function-argstring "eldoc")
-(declare-function eldoc-docstring-format-sym-doc "eldoc")
-(declare-function eldoc-last-data-store "eldoc")
-(declare-function eldoc-get-fnsym-args-string "eldoc")
-(declare-function eldoc-get-var-docstring "eldoc")
+(defvar semantic-grammar-eldoc-last-data (cons nil nil))
(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
"Return a one-line docstring for the given grammar MACRO.
EXPANDER is the name of the function that expands MACRO."
(require 'eldoc)
- (if (and (eq expander (aref eldoc-last-data 0))
- (eq 'function (aref eldoc-last-data 2)))
- (aref eldoc-last-data 1)
- (let ((doc (help-split-fundoc (documentation expander t) expander)))
+ (cond
+ ((eq expander (car semantic-grammar-eldoc-last-data))
+ (cdr semantic-grammar-eldoc-last-data))
+ ((fboundp 'eldoc-function-argstring) ;; Emacs<25
+ (let* ((doc (help-split-fundoc (documentation expander t) expander)))
(cond
(doc
(setq doc (car doc))
@@ -1669,8 +1680,17 @@ EXPANDER is the name of the function that expands MACRO."
(setq doc
(eldoc-docstring-format-sym-doc
macro (format "==> %s %s" expander doc) 'default))
- (eldoc-last-data-store expander doc 'function))
- doc)))
+ (setq semantic-grammar-eldoc-last-data (cons expander doc)))
+ doc))
+ ((fboundp 'elisp-get-fnsym-args-string) ;; Emacs≥25
+ (elisp-get-fnsym-args-string
+ expander nil
+ (concat (propertize (symbol-name macro)
+ 'face 'font-lock-keyword-face)
+ " ==> "
+ (propertize (symbol-name macro)
+ 'face 'font-lock-function-name-face)
+ ": ")))))
(define-mode-local-override semantic-idle-summary-current-symbol-info
semantic-grammar-mode ()
@@ -1701,10 +1721,14 @@ Otherwise return nil."
(setq val (semantic-grammar-eldoc-get-macro-docstring elt val)))
;; Function
((and elt (fboundp elt))
- (setq val (eldoc-get-fnsym-args-string elt)))
+ (setq val (if (fboundp 'eldoc-get-fnsym-args-string)
+ (eldoc-get-fnsym-args-string elt)
+ (elisp-get-fnsym-args-string elt))))
;; Variable
((and elt (boundp elt))
- (setq val (eldoc-get-var-docstring elt)))
+ (setq val (if (fboundp 'eldoc-get-var-docstring)
+ (eldoc-get-var-docstring elt)
+ (elisp-get-var-docstring elt))))
(t nil)))
(or val (semantic-idle-summary-current-symbol-info-default))))
@@ -1912,6 +1936,7 @@ Optional argument COLOR determines if color is added to the text."
(provide 'semantic/grammar)
+
;; Local variables:
;; generated-autoload-load-name: "semantic/grammar"
;; End:
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index d98ccf2bf55..2194bf5bd38 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -1,6 +1,6 @@
;;; semantic/html.el --- Semantic details for html files
-;; Copyright (C) 2004-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index a1595eb7b89..fcc9c002cef 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -1,6 +1,6 @@
;;; semantic/ia-sb.el --- Speedbar analysis display interactor
-;;; Copyright (C) 2002-2004, 2006, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 2002-2004, 2006, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -138,8 +138,8 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
)))
-(defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
- "Show documentation about CONTEXT iff CONTEXT points at a complete symbol."
+(cl-defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
+ "Show documentation about CONTEXT if CONTEXT points at a complete symbol."
(let ((sym (car (reverse (oref context prefix))))
(doc nil))
(when (semantic-tag-p sym)
@@ -163,7 +163,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
;; This is from semantic-sb
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
"Show a set of speedbar buttons specific to CONTEXT."
(let ((prefix (oref context prefix)))
(when prefix
@@ -173,9 +173,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'semantic-sb-token-jump))
))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((assignee (oref context assignee)))
(when assignee
(speedbar-insert-separator "Assignee")
@@ -183,9 +183,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'speedbar-tag-face
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((func (oref context function)))
(when func
(speedbar-insert-separator "Function")
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index d087ac6fcde..27e6db16f39 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
;;; semantic/ia.el --- Interactive Analysis functions
-;;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -123,7 +123,8 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; the smart completion engine sometimes fails.
(semantic-complete-symbol))
;; Use try completion to seek a common substring.
- (let ((tc (try-completion (or pre "") syms)))
+ (let* ((completion-ignore-case (string= (downcase pre) pre))
+ (tc (try-completion (or pre "") syms)))
(if (and (stringp tc) (not (string= tc (or pre ""))))
(let ((tok (semantic-find-first-tag-by-name
tc syms)))
@@ -161,11 +162,14 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; Complete this symbol.
(if (not syms)
(progn
- (message "No smart completions found. Trying Senator.")
- (when (semantic-analyze-context-p a)
- ;; This is a quick way of getting a nice completion list
- ;; in the menu if the regular context mechanism fails.
- (senator-completion-menu-popup)))
+ (message "No smart completions found.")
+ ;; Disabled - see http://debbugs.gnu.org/14522
+ ;; (message "No smart completions found. Trying Senator.")
+ ;; (when (semantic-analyze-context-p a)
+ ;; ;; This is a quick way of getting a nice completion list
+ ;; ;; in the menu if the regular context mechanism fails.
+ ;; (senator-completion-menu-popup))
+ )
(let* ((menu
(mapcar
@@ -179,7 +183,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; XEmacs needs that the menu has at least 2 items. So,
;; include a nil item that will be ignored by imenu.
(cons nil menu)
- (senator-completion-menu-point-as-event)
+ `(down-mouse-1 ,(posn-at-point))
"Completions")))
(when ans
(if (not (semantic-tag-p ans))
@@ -360,21 +364,30 @@ origin of the code at point."
(let ((secondclass (car (reverse (oref ctxt prefixtypes)))))
(cond
((and (semantic-tag-with-position-p secondclass)
- (y-or-n-p (format "Could not find `%s'. Jump to %s? "
- first (semantic-tag-name secondclass))))
+ (y-or-n-p (format-message
+ "Could not find `%s'. Jump to %s? "
+ first (semantic-tag-name secondclass))))
(semantic-ia--fast-jump-helper secondclass)
)
;; If we missed out on the class of the second item, then
;; just visit SECOND.
((and (semantic-tag-p second)
- (y-or-n-p (format "Could not find `%s'. Jump to %s? "
- first (semantic-tag-name second))))
+ (y-or-n-p (format-message
+ "Could not find `%s'. Jump to %s? "
+ first (semantic-tag-name second))))
(semantic-ia--fast-jump-helper second)
))))
((semantic-tag-of-class-p (semantic-current-tag) 'include)
;; Just borrow this cool fcn.
(require 'semantic/decorate/include)
+
+ ;; Push the mark, so you can pop global mark back, or
+ ;; use semantic-mru-bookmark mode to do so.
+ (push-mark)
+ (when (fboundp 'push-tag-mark)
+ (push-tag-mark))
+
(semantic-decoration-include-visit)
)
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index d024e5d8237..95d9d846466 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,6 +1,6 @@
;;; idle.el --- Schedule parsing tasks in idle time
-;; Copyright (C) 2003-2006, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2006, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -216,6 +216,7 @@ current buffer.")
And also manages services that depend on tag values."
(when semantic-idle-scheduler-verbose-flag
(message "IDLE: Core handler..."))
+ ;; FIXME: Use `while-no-input'?
(semantic-exit-on-input 'idle-timer
(let* ((inhibit-quit nil)
(buffers (delq (current-buffer)
@@ -715,8 +716,8 @@ It might be useful to override this variable to add comment faces
specific to a major mode. For example, in jde mode:
\(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
- (append (default-value 'semantic-idle-summary-out-of-context-faces)
- '(jde-java-font-lock-doc-tag-face
+ (append (default-value \\='semantic-idle-summary-out-of-context-faces)
+ \\='(jde-java-font-lock-doc-tag-face
jde-java-font-lock-link-face
jde-java-font-lock-bold-face
jde-java-font-lock-underline-face
@@ -830,8 +831,14 @@ turned on in every Semantic-supported buffer."
;; of all uses of the symbol that is under the cursor.
;;
;; This is to mimic the Eclipse tool of a similar nature.
-(defvar semantic-idle-symbol-highlight-face 'region
+(defface semantic-idle-symbol-highlight
+ '((t :inherit region))
+ "Face used for highlighting local symbols."
+ :group 'semantic-faces)
+(defvar semantic-idle-symbol-highlight-face 'semantic-idle-symbol-highlight
"Face used for highlighting local symbols.")
+(make-obsolete-variable 'semantic-idle-symbol-highlight-face
+ "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 370f651b93d..c043125b5cf 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -1,7 +1,7 @@
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
-;;; Copyright (C) 2000-2005, 2007-2008, 2010-2013
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2008, 2010-2015 Free Software
+;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Maintainer: Eric Ludlam
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index b4e4bc5110d..829eafae37a 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -1,6 +1,6 @@
;;; semantic/java.el --- Semantic functions for Java
-;;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -369,7 +369,7 @@ That is @NAME."
(defsubst semantic-java-doc-tag-name (tag)
"Return name of the doc TAG symbol.
-That is TAG `symbol-name' without the leading '@'."
+That is TAG `symbol-name' without the leading `@'."
(substring (symbol-name tag) 1))
(defun semantic-java-doc-keyword-before-p (k1 k2)
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 462e520654a..761cc1af5ed 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,6 +1,6 @@
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -70,6 +70,8 @@
(require 'semantic)
(require 'semantic/lex)
+(declare-function semantic-c-end-of-macro "semantic/bovine/c")
+
;;; Code:
(defvar semantic-lex-spp-macro-symbol-obarray nil
"Table of macro keywords used by the Semantic Preprocessor.
@@ -527,16 +529,54 @@ and what valid VAL values are."
;;
;; Nested token FOO shows up in the table of macros, and gets replace
;; inline. This is the same as case 2.
+ ;;
+ ;; CASE 5: Macros which open a scope without closing it
+ ;;
+ ;; #define __NAMESPACE_STD namespace std {
+ ;; #define __NAMESPACE_END }
+ ;; ==>
+ ;; ((NAMESPACE "namespace" 140 . 149)
+ ;; (symbol "std" 150 . 153)
+ ;; (open-paren "{" 154 . 155))
+ ;;
+ ;; Note that we get a single 'open-paren' instead of a
+ ;; 'semantic-list', which is because we use
+ ;; 'semantic-lex-spp-paren-or-list' instead of
+ ;; 'semantic-lex-paren-or-list' in our spp-lexer. To keep things
+ ;; reasonably simple, we assume that such an open scope will always
+ ;; be closed by another macro (see
+ ;; `semantic-lex-spp-find-closing-macro'). We generate a
+ ;; 'semantic-list' to this closing macro, and we leave an overlay
+ ;; which contains information how far we got into the macro's
+ ;; stream (since it might open several scopes).
+
+ (let* ((arglist (semantic-lex-spp-macro-with-args val))
+ (argalist nil)
+ (val-tmp nil)
+ (v nil)
+ (sppov (semantic-lex-spp-get-overlay beg))
+ (sppinfo (when sppov (overlay-get sppov 'semantic-spp))))
+
+ ;; First, check if we were already here and left information
+ (when sppinfo
+ ;; Advance in the tokens as far as we got last time
+ (when (numberp (car sppinfo))
+ (while (and val
+ (>= (car sppinfo) (car (last (car val)))))
+ (setq val (cdr val))))
+ ;; And push an open paren
+ (semantic-lex-push-token
+ (semantic-lex-token 'open-paren beg (1+ beg) "{"))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (unless val
+ ;; We reached the end of this macro, so delete overlay
+ (delete-overlay sppov)))
- (let ((arglist (semantic-lex-spp-macro-with-args val))
- (argalist nil)
- (val-tmp nil)
- (v nil)
- )
;; CASE 2: Dealing with the arg list.
- (when arglist
+ (when (and val arglist)
;; Skip the arg list.
- (setq val (cdr val))
+ (when (eq (caar val) 'spp-arg-list)
+ (setq val (cdr val)))
;; Push args into the replacement list.
(let ((AV argvalues))
@@ -616,7 +656,32 @@ and what valid VAL values are."
(semantic-lex-push-token
(semantic-lex-token (semantic-lex-token-class v) beg end txt))
)
-
+ ;; CASE 5: Macro which opens a scope
+ ((eq (semantic-lex-token-class v) 'open-paren)
+ ;; We assume that the scope will be closed by another macro.
+ ;; (Everything else would be a terrible idea anyway.)
+ (let* ((endpoint (semantic-lex-spp-find-closing-macro))
+ (ov (when endpoint
+ (or sppov
+ (make-overlay beg end)))))
+ (when ov
+ ;; Generate a semantic-list which spans to the end of
+ ;; the closing macro
+ (semantic-lex-push-token
+ (semantic-lex-token 'semantic-list beg endpoint))
+ ;; The rest of the current macro's stream will be parsed
+ ;; next time.
+ (setq val-tmp nil)
+ ;; Store our current state were we are in the macro and
+ ;; the endpoint.
+ (overlay-put ov 'semantic-spp
+ (cons (car (last v)) endpoint)))))
+ ((eq (semantic-lex-token-class v) 'close-paren)
+ ;; Macro which closes a scope
+ ;; Just push the close paren, but also decrease depth
+ (semantic-lex-push-token
+ (semantic-lex-token 'close-paren beg end txt))
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth)))
;; CASE 1: Just another token in the stream.
(t
;; Nothing new.
@@ -652,6 +717,37 @@ will return empty string instead.")
txt
""))
+(defun semantic-lex-spp-find-closing-macro ()
+ "Find next macro which closes a scope through a close-paren.
+Returns position with the end of that macro."
+ (let ((macros (semantic-lex-spp-macros))
+ (cmacro-regexp "\\(")
+ (case-fold-search nil))
+ ;; Build a regexp which search for all macros with a closing
+ ;; paren, and search for it.
+ (dolist (cur macros)
+ (let ((stream (symbol-value cur)))
+ (when (and (listp stream) (listp (car stream)))
+ (while stream
+ (if (and (eq (caar stream) 'close-paren)
+ (string= (nth 1 (car stream)) "}"))
+ (setq cmacro-regexp (concat cmacro-regexp (symbol-name cur) "\\|")
+ stream nil)
+ (setq stream (cdr-safe stream)))))))
+ (when cmacro-regexp
+ (save-excursion
+ (when (re-search-forward
+ (concat (substring cmacro-regexp 0 -2) "\\)[^0-9a-zA-Z_]") nil t)
+ (point))))))
+
+(defun semantic-lex-spp-get-overlay (&optional point)
+ "Return first overlay which has a 'semantic-spp property."
+ (let ((overlays (overlays-at (or point (point)))))
+ (while (and overlays
+ (null (overlay-get (car overlays) 'semantic-spp)))
+ (setq overlays (cdr overlays)))
+ (car-safe overlays)))
+
;;; Macro Merging
;;
;; Used when token streams from different macros include each other.
@@ -727,7 +823,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
-(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end)
+(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@@ -767,6 +863,9 @@ Argument BEG and END specify the bounds of SYM in the buffer."
(setq semantic-lex-end-point end)
)
))
+(define-obsolete-function-alias
+ 'semantic-lex-spp-anlyzer-do-replace
+ 'semantic-lex-spp-analyzer-do-replace "25.1")
(defvar semantic-lex-spp-replacements-enabled t
"Non-nil means do replacements when finding keywords.
@@ -820,12 +919,50 @@ STR occurs in the current buffer between BEG and END."
))
(define-lex-regex-analyzer semantic-lex-spp-replace-or-symbol-or-keyword
- "Like 'semantic-lex-symbol-or-keyword' plus preprocessor macro replacement."
+ "Like `semantic-lex-symbol-or-keyword' plus preprocessor macro replacement."
"\\(\\sw\\|\\s_\\)+"
(let ((str (match-string 0))
(beg (match-beginning 0))
- (end (match-end 0)))
- (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)))
+ (end (match-end 0))
+ sppov)
+ (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)
+ (when (setq sppov (semantic-lex-spp-get-overlay beg))
+ (setq semantic-lex-end-point (cdr (overlay-get sppov 'semantic-spp))))))
+
+(define-lex-regex-analyzer semantic-lex-spp-paren-or-list
+ "Detect open parenthesis.
+Contrary to `semantic-lex-paren-or-list', this will push a single
+open-paren onto the stream if no closing paren can be found.
+This is important for macros which open a scope which is closed
+by another macro."
+ "\\s("
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (progn
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren (match-beginning 0) (match-end 0))))
+ (save-excursion
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (peom (save-excursion (semantic-c-end-of-macro) (point))))
+ (condition-case nil
+ (progn
+ ;; This will throw an error if no closing paren can be found.
+ (forward-list 1)
+ (when (> (point) peom)
+ ;; If we have left the macro, this is the wrong closing
+ ;; paren, so error out as well.
+ (error ""))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'semantic-list start (point))))
+ (error
+ ;; Only push a single open-paren.
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren start end))))))))
;;; ANALYZERS FOR NEW MACROS
;;
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index feead78985c..7738e06ff88 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1,6 +1,6 @@
;;; semantic/lex.el --- Lexical Analyzer builder
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -831,63 +831,6 @@ analyzer which might mistake a number for as a symbol."
;; Return the token stream
(nreverse semantic-lex-token-stream))))
-;;; Collapsed block tokens delimited by any tokens.
-;;
-(defun semantic-lex-start-block (syntax)
- "Mark the last read token as the beginning of a SYNTAX block."
- (if (or (not semantic-lex-maximum-depth)
- (< semantic-lex-current-depth semantic-lex-maximum-depth))
- (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
- (push (list syntax (car semantic-lex-token-stream))
- semantic-lex-block-stack)))
-
-(defun semantic-lex-end-block (syntax)
- "Process the end of a previously marked SYNTAX block.
-That is, collapse the tokens inside that block, including the
-beginning and end of block tokens, into a high level block token of
-class SYNTAX.
-The token at beginning of block is the one marked by a previous call
-to `semantic-lex-start-block'. The current token is the end of block.
-The collapsed tokens are saved in `semantic-lex-block-streams'."
- (if (null semantic-lex-block-stack)
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
- (let* ((stream semantic-lex-token-stream)
- (blk (pop semantic-lex-block-stack))
- (bstream (cdr blk))
- (first (car bstream))
- (last (pop stream)) ;; The current token mark the EOBLK
- tok)
- (if (not (eq (car blk) syntax))
- ;; SYNTAX doesn't match the syntax of the current block in
- ;; the stack. So we encountered the end of the SYNTAX block
- ;; before the end of the current one in the stack which is
- ;; signaled unterminated.
- (semantic-lex-unterminated-syntax-detected (car blk))
- ;; Move tokens found inside the block from the main stream
- ;; into a separate block stream.
- (while (and stream (not (eq (setq tok (pop stream)) first)))
- (push tok bstream))
- ;; The token marked as beginning of block was not encountered.
- ;; This should not happen!
- (or (eq tok first)
- (error "Token %S not found at beginning of block `%s'"
- first syntax))
- ;; Save the block stream for future reuse, to avoid to redo
- ;; the lexical analysis of the block content!
- ;; Anchor the block stream with its start position, so we can
- ;; use: (cdr (assq start semantic-lex-block-streams)) to
- ;; quickly retrieve the lexical stream associated to a block.
- (setcar blk (semantic-lex-token-start first))
- (setcdr blk (nreverse bstream))
- (push blk semantic-lex-block-streams)
- ;; In the main stream, replace the tokens inside the block by
- ;; a high level block token of class SYNTAX.
- (setq semantic-lex-token-stream stream)
- (semantic-lex-push-token
- (semantic-lex-token
- syntax (car blk) (semantic-lex-token-end last)))
- ))))
-
;;; Lexical token API
;;
;; Functions for accessing parts of a token. Use these functions
@@ -1049,6 +992,63 @@ Optional argument DEPTH is the depth to scan into lists."
(semantic-lex-token-end semlist)
depth))
+;;; Collapsed block tokens delimited by any tokens.
+;;
+(defun semantic-lex-start-block (syntax)
+ "Mark the last read token as the beginning of a SYNTAX block."
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (push (list syntax (car semantic-lex-token-stream))
+ semantic-lex-block-stack)))
+
+(defun semantic-lex-end-block (syntax)
+ "Process the end of a previously marked SYNTAX block.
+That is, collapse the tokens inside that block, including the
+beginning and end of block tokens, into a high level block token of
+class SYNTAX.
+The token at beginning of block is the one marked by a previous call
+to `semantic-lex-start-block'. The current token is the end of block.
+The collapsed tokens are saved in `semantic-lex-block-streams'."
+ (if (null semantic-lex-block-stack)
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+ (let* ((stream semantic-lex-token-stream)
+ (blk (pop semantic-lex-block-stack))
+ (bstream (cdr blk))
+ (first (car bstream))
+ (last (pop stream)) ;; The current token mark the EOBLK
+ tok)
+ (if (not (eq (car blk) syntax))
+ ;; SYNTAX doesn't match the syntax of the current block in
+ ;; the stack. So we encountered the end of the SYNTAX block
+ ;; before the end of the current one in the stack which is
+ ;; signaled unterminated.
+ (semantic-lex-unterminated-syntax-detected (car blk))
+ ;; Move tokens found inside the block from the main stream
+ ;; into a separate block stream.
+ (while (and stream (not (eq (setq tok (pop stream)) first)))
+ (push tok bstream))
+ ;; The token marked as beginning of block was not encountered.
+ ;; This should not happen!
+ (or (eq tok first)
+ (error "Token %S not found at beginning of block `%s'"
+ first syntax))
+ ;; Save the block stream for future reuse, to avoid to redo
+ ;; the lexical analysis of the block content!
+ ;; Anchor the block stream with its start position, so we can
+ ;; use: (cdr (assq start semantic-lex-block-streams)) to
+ ;; quickly retrieve the lexical stream associated to a block.
+ (setcar blk (semantic-lex-token-start first))
+ (setcdr blk (nreverse bstream))
+ (push blk semantic-lex-block-streams)
+ ;; In the main stream, replace the tokens inside the block by
+ ;; a high level block token of class SYNTAX.
+ (setq semantic-lex-token-stream stream)
+ (semantic-lex-push-token
+ (semantic-lex-token
+ syntax (car blk) (semantic-lex-token-end last)))
+ ))))
+
;;; Analyzer creation macros
;;
;; An individual analyzer is a condition and code that goes with it.
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index 297353fed67..b2a2c8c7619 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -1,6 +1,6 @@
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -86,7 +86,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
)
"A single bookmark.")
-(defmethod initialize-instance :AFTER ((sbm semantic-bookmark) &rest fields)
+(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
"Initialize the bookmark SBM with details about :tag."
(condition-case nil
(save-excursion
@@ -96,7 +96,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
(error (message "Error bookmarking tag.")))
)
-(defmethod semantic-mrub-visit ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-visit ((sbm semantic-bookmark))
"Visit the semantic tag bookmark SBM.
Uses `semantic-go-to-tag' and highlighting."
(require 'semantic/decorate)
@@ -117,7 +117,7 @@ Uses `semantic-go-to-tag' and highlighting."
(semantic-momentary-highlight-tag tag)
))
-(defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
+(cl-defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
"Update the existing bookmark SBM.
POINT is some important location.
REASON is a symbol. See slot `reason' on `semantic-bookmark'."
@@ -132,7 +132,7 @@ REASON is a symbol. See slot `reason' on `semantic-bookmark'."
(error nil))
)
-(defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
"Method called on a tag before the current buffer list of tags is flushed.
If there is a buffer match, unlink the tag."
(let ((tag (oref sbm tag))
@@ -183,7 +183,7 @@ Argument POINT is where to find the tag near."
(when nearby (setq tag nearby))))
tag))
-(defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
+(cl-defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
&optional reason)
"Add a bookmark to the ring SBR from POINT.
REASON is why it is being pushed. See doc for `semantic-bookmark'
@@ -207,7 +207,7 @@ The resulting bookmark is then sorted within the ring."
)))
(defun semantic-mrub-cache-flush-fcn ()
- "Function called in the `semantic-before-toplevel-cache-flush-hook`.
+ "Function called in the `semantic-before-toplevel-cache-flush-hook'.
Cause tags in the ring to become unlinked."
(let* ((ring (oref semantic-mru-bookmark-ring ring))
(len (ring-length ring))
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index accee18f257..295d4e9673b 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -1,6 +1,6 @@
;;; semantic/sb.el --- Semantic tag display for speedbar
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 13e858ca000..acc6545233b 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,6 +1,6 @@
;;; semantic/scope.el --- Analyzer Scope Calculations
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -101,7 +101,7 @@ Saves scoping information between runs of the analyzer.")
;;
;; Methods for basic management of the structure in semanticdb.
;;
-(defmethod semantic-reset ((obj semantic-scope-cache))
+(cl-defmethod semantic-reset ((obj semantic-scope-cache))
"Reset OBJ back to it's empty settings."
(oset obj tag nil)
(oset obj scopetypes nil)
@@ -114,13 +114,13 @@ Saves scoping information between runs of the analyzer.")
(oset obj typescope nil)
)
-(defmethod semanticdb-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
-(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; If there are any includes or datatypes changed, then clear.
@@ -134,10 +134,10 @@ Saves scoping information between runs of the analyzer.")
"Get the current cached scope, and reset it."
(when semanticdb-current-table
(let ((co (semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache)))
+ 'semantic-scope-cache)))
(semantic-reset co))))
-(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
+(cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
types-in-scope)
"Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are
@@ -195,12 +195,18 @@ Use `semantic-ctxt-scoped-types' to find types."
;; Get this thing as a tag
(let ((tmp (cond
((stringp (car sp))
- (semanticdb-typecache-find (car sp)))
- ;(semantic-analyze-find-tag (car sp) 'type))
+ (or (semanticdb-typecache-find (car sp))
+ ;; If we did not find it in the typecache,
+ ;; look in the tags we found so far
+ (car (semantic-deep-find-tags-by-name
+ (car sp)
+ code-scoped-types))))
((semantic-tag-p (car sp))
(if (semantic-tag-prototype-p (car sp))
- (semanticdb-typecache-find (semantic-tag-name (car sp)))
- ;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type)
+ (or (semanticdb-typecache-find (semantic-tag-name (car sp)))
+ (car (semantic-deep-find-tags-by-name
+ (semantic-tag-name (car sp))
+ code-scoped-types)))
(car sp)))
(t nil))))
(when tmp
@@ -506,10 +512,33 @@ tag is not something you can complete from within TYPE."
(leftover nil)
)
(dolist (S allslots)
- (when (or (not (semantic-tag-of-class-p S 'function))
- (not (semantic-tag-function-parent S)))
- (setq leftover (cons S leftover)))
- )
+ ;; We have to specially deal with 'using' tags here, since those
+ ;; pull in namespaces or classes into the current scope.
+ ;; (Should this go into c.el? If so, into which override?)
+ (if (semantic-tag-of-class-p S 'using)
+ (let* ((fullname (semantic-analyze-unsplit-name
+ (list (semantic-tag-name type)
+ (semantic-tag-name S))))
+ ;; Search the typecache, first for the unqualified name
+ (usingtype (or
+ (semanticdb-typecache-find (semantic-tag-name S))
+ ;; If that didn't return anything, use
+ ;; fully qualified name
+ (semanticdb-typecache-find fullname)))
+ (filename (when usingtype (semantic-tag-file-name usingtype))))
+ (when usingtype
+ ;; Use recursion to examine that namespace or class
+ (let ((tags (semantic-completable-tags-from-type usingtype)))
+ (if filename
+ ;; If we have a filename, copy the tags with it
+ (dolist (cur tags)
+ (setq leftover (cons (semantic-tag-copy cur nil filename)
+ leftover)))
+ ;; Otherwise just run with it
+ (setq leftover (append tags leftover))))))
+ (when (or (not (semantic-tag-of-class-p S 'function))
+ (not (semantic-tag-function-parent S)))
+ (setq leftover (cons S leftover)))))
(nreverse leftover)))
(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
@@ -677,7 +706,7 @@ The class returned from the scope calculation is variable
(let* ((TAG (semantic-current-tag))
(scopecache
(semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache))
+ 'semantic-scope-cache))
)
(when (not (semantic-equivalent-tag-p TAG (oref scopecache tag)))
(semantic-reset scopecache))
@@ -734,8 +763,9 @@ The class returned from the scope calculation is variable
(when (called-interactively-p 'any)
(require 'eieio-datadebug)
(data-debug-show scopecache))
- ;; Return ourselves
- scopecache))))
+ ;; Return ourselves, but make a clone first so that the caller
+ ;; can reset the scope cache without affecting others.
+ (clone scopecache)))))
(defun semantic-scope-find (name &optional class scope-in)
"Find the tag with NAME, and optional CLASS in the current SCOPE-IN.
@@ -799,7 +829,7 @@ hits in order, with the first tag being in the closest scope."
;;; DUMP
;;
-(defmethod semantic-analyze-show ((context semantic-scope-cache))
+(cl-defmethod semantic-analyze-show ((context semantic-scope-cache))
"Insert CONTEXT into the current buffer in a nice way."
(require 'semantic/analyze)
(semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index 157223ff192..544abff8dd1 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -1,9 +1,9 @@
;;; semantic/senator.el --- SEmantic NAvigaTOR
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 10 Nov 2000
;; Keywords: syntax
@@ -507,7 +507,7 @@ filters in `senator-search-tag-filter-functions' remain active."
(define-overloadable-function semantic-up-reference (tag)
"Return a tag that is referred to by TAG.
A \"reference\" could be any interesting feature of TAG.
-In C++, a function may have a 'parent' which is non-local.
+In C++, a function may have a `parent' which is non-local.
If that parent which is only a reference in the function tag
is found, we can jump to it.
Some tags such as includes have other reference features.")
@@ -516,7 +516,7 @@ Some tags such as includes have other reference features.")
(defun senator-go-to-up-reference (&optional tag)
"Move up one reference from the current TAG.
A \"reference\" could be any interesting feature of TAG.
-In C++, a function may have a 'parent' which is non-local.
+In C++, a function may have a `parent' which is non-local.
If that parent which is only a reference in the function tag
is found, we can jump to it.
Some tags such as includes have other reference features."
@@ -722,8 +722,14 @@ yanked to."
(defun senator-copy-tag-to-register (register &optional kill-flag)
"Copy the current tag into REGISTER.
Optional argument KILL-FLAG will delete the text of the tag to the
-kill ring."
- (interactive "cTag to register: \nP")
+kill ring.
+
+Interactively, reads the register using `register-read-with-preview',
+if available."
+ (interactive (list (if (fboundp 'register-read-with-preview)
+ (register-read-with-preview "Tag to register: ")
+ (read-char "Tag to register: "))
+ current-prefix-arg))
(semantic-fetch-tags)
(let ((ft (semantic-obtain-foreign-tag)))
(when ft
@@ -807,7 +813,7 @@ Use a senator search function when semantic isearch mode is enabled."
(concat (if senator-isearch-semantic-mode
"senator-"
"")
- (cond (isearch-word "word-")
+ (cond (isearch-regexp-function "word-")
(isearch-regexp "re-")
(t ""))
"search-"
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index b32e11290ac..587d084701d 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -1,6 +1,6 @@
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
-;;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index f85b66e66c6..89e8b40632d 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -1,6 +1,6 @@
;;; semantic/symref.el --- Symbol Reference API
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -314,7 +314,7 @@ Use the `semantic-symref-hit-tags' method to get this list.")
)
"The results from a symbol reference search.")
-(defmethod semantic-symref-result-get-files ((result semantic-symref-result))
+(cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT."
(if (slot-boundp result :hit-files)
(oref result hit-files)
@@ -333,7 +333,26 @@ Use the `semantic-symref-hit-tags' method to get this list.")
)
))
-(defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
+(defvar semantic-symref-recently-opened-buffers nil
+ "List of buffers opened by `semantic-symref-result-get-tags'.")
+
+(defun semantic-symref-cleanup-recent-buffers-fcn ()
+ "Hook function to be used in `post-command-hook' to cleanup buffers.
+Buffers collected during symref can result in some files being
+opened multiple times for one operation. This will keep buffers open
+until the next command is executed."
+ ;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers)
+ (mapc (lambda (buff)
+ ;; Don't delete any buffers which are being used
+ ;; upon completion of some command.
+ (when (not (get-buffer-window buff))
+ (kill-buffer buff)))
+ semantic-symref-recently-opened-buffers)
+ (setq semantic-symref-recently-opened-buffers nil)
+ (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ )
+
+(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
@@ -347,75 +366,19 @@ already."
(txt (oref (oref result :created-by) :searchfor))
(searchtype (oref (oref result :created-by) :searchtype))
(ans nil)
- (out nil)
- (buffs-to-kill nil))
+ (out nil))
(save-excursion
- (setq
- ans
- (mapcar
- (lambda (hit)
- (let* ((line (car hit))
- (file (cdr hit))
- (buff (find-buffer-visiting file))
- (tag nil)
- )
- (cond
- ;; We have a buffer already. Check it out.
- (buff
- (set-buffer buff))
-
- ;; We have a table, but it needs a refresh.
- ;; This means we should load in that buffer.
- (t
- (let ((kbuff
- (if open-buffers
- ;; Even if we keep the buffers open, don't
- ;; let EDE ask lots of questions.
- (let ((ede-auto-add-method 'never))
- (find-file-noselect file t))
- ;; When not keeping the buffers open, then
- ;; don't setup all the fancy froo-froo features
- ;; either.
- (semantic-find-file-noselect file t))))
- (set-buffer kbuff)
- (setq buffs-to-kill (cons kbuff buffs-to-kill))
- (semantic-fetch-tags)
- ))
- )
-
- ;; Too much baggage in goto-line
- ;; (goto-line line)
- (goto-char (point-min))
- (forward-line (1- line))
-
- ;; Search forward for the matching text
- (when (re-search-forward (regexp-quote txt)
- (point-at-eol)
- t)
- (goto-char (match-beginning 0))
- )
-
- (setq tag (semantic-current-tag))
-
- ;; If we are searching for a tag, but bound the tag we are looking
- ;; for, see if it resides in some other parent tag.
- ;;
- ;; If there is no parent tag, then we still need to hang the originator
- ;; in our list.
- (when (and (eq searchtype 'symbol)
- (string= (semantic-tag-name tag) txt))
- (setq tag (or (semantic-current-tag-parent) tag)))
-
- ;; Copy the tag, which adds a :filename property.
- (when tag
- (setq tag (semantic-tag-copy tag nil t))
- ;; Ad this hit to the tag.
- (semantic--tag-put-property tag :hit (list line)))
- tag))
- lines)))
+ (setq ans (mapcar
+ (lambda (hit)
+ (semantic-symref-hit-to-tag-via-buffer
+ hit txt searchtype open-buffers))
+ lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
- (when (not open-buffers)
- (mapc 'kill-buffer buffs-to-kill))
+ (if (not open-buffers)
+ (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ ;; Else, just clear the saved buffers so they aren't deleted later.
+ (setq semantic-symref-recently-opened-buffers nil)
+ )
;; Strip out duplicates.
(dolist (T ans)
(if (and T (not (semantic-equivalent-tag-p (car out) T)))
@@ -429,6 +392,115 @@ already."
;; Out is reversed... twice
(oset result :hit-tags (nreverse out)))))
+(defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype)
+ "Convert the symref HIT into a TAG by looking up the tag via a database.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+If there is no database, of if the searchtype is wrong, return nil."
+ ;; Allowed search types for this mechanism:
+ ;; tagname, tagregexp, tagcompletions
+ (if (not (memq searchtype '(tagname tagregexp tagcompletions)))
+ nil
+ (let* ((line (car hit))
+ (file (cdr hit))
+ ;; FAIL here vv - don't load is not obeyed if no table found.
+ (db (semanticdb-file-table-object file t))
+ (found nil)
+ (hit nil)
+ )
+ (cond ((eq searchtype 'tagname)
+ (setq found (semantic-find-tags-by-name searchtxt db)))
+ ((eq searchtype 'tagregexp)
+ (setq found (semantic-find-tags-by-name-regexp searchtxt db)))
+ ((eq searchtype 'tagcompletions)
+ (setq found (semantic-find-tags-for-completion searchtxt db)))
+ )
+ ;; Loop over FOUND to see if we can line up a match with a line number.
+ (when (= (length found) 1)
+ (setq hit (car found)))
+
+ ;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations.
+ ;; as such, this is a cheat and we will need to give up.
+ hit)))
+
+(defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers)
+ "Convert the symref HIT into a TAG by looking up the tag via a buffer.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+Optional OPEN-BUFFERS, when nil will use a faster version of
+`find-file' when a file needs to be opened. If non-nil, then
+normal buffer initialization will be used.
+This function will leave buffers loaded from a file open, but
+will add buffers that must be opened to `semantic-symref-recently-opened-buffers'.
+Any caller MUST deal with that variable, either clearing it, or deleting the
+buffers that were opened."
+ (let* ((line (car hit))
+ (file (cdr hit))
+ (buff (find-buffer-visiting file))
+ (tag nil)
+ )
+ (cond
+ ;; We have a buffer already. Check it out.
+ (buff
+ (set-buffer buff))
+
+ ;; We have a table, but it needs a refresh.
+ ;; This means we should load in that buffer.
+ (t
+ (let ((kbuff
+ (if open-buffers
+ ;; Even if we keep the buffers open, don't
+ ;; let EDE ask lots of questions.
+ (let ((ede-auto-add-method 'never))
+ (find-file-noselect file t))
+ ;; When not keeping the buffers open, then
+ ;; don't setup all the fancy froo-froo features
+ ;; either.
+ (semantic-find-file-noselect file t))))
+ (set-buffer kbuff)
+ (push kbuff semantic-symref-recently-opened-buffers)
+ (semantic-fetch-tags)
+ ))
+ )
+
+ ;; Too much baggage in goto-line
+ ;; (goto-line line)
+ (goto-char (point-min))
+ (forward-line (1- line))
+
+ ;; Search forward for the matching text.
+ ;; FIXME: This still fails if the regexp uses something specific
+ ;; to the extended syntax, like grouping.
+ (when (re-search-forward (if (memq searchtype '(regexp tagregexp))
+ searchtxt
+ (regexp-quote searchtxt))
+ (point-at-eol)
+ t)
+ (goto-char (match-beginning 0))
+ )
+
+ (setq tag (semantic-current-tag))
+
+ ;; If we are searching for a tag, but bound the tag we are looking
+ ;; for, see if it resides in some other parent tag.
+ ;;
+ ;; If there is no parent tag, then we still need to hang the originator
+ ;; in our list.
+ (when (and (eq searchtype 'symbol)
+ (string= (semantic-tag-name tag) searchtxt))
+ (setq tag (or (semantic-current-tag-parent) tag)))
+
+ ;; Copy the tag, which adds a :filename property.
+ (when tag
+ (setq tag (semantic-tag-copy tag nil t))
+ ;; Ad this hit to the tag.
+ (semantic--tag-put-property tag :hit (list line)))
+ tag))
+
;;; SYMREF TOOLS
;;
;; The base symref tool provides something to hang new tools off of
@@ -440,7 +512,7 @@ already."
(searchtype :initarg :searchtype
:type symbol
:documentation "The type of search to do.
-Values could be `symbol, `regexp, 'tagname, or 'completion.")
+Values could be 'symbol, 'regexp, 'tagname, or 'completion.")
(searchscope :initarg :searchscope
:type symbol
:documentation
@@ -463,7 +535,7 @@ NAME is the name of the tool used in the configuration variable
`semantic-symref-tool'"
:abstract t)
-(defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
@@ -481,11 +553,11 @@ The symref TOOL should already contain the search criteria."
)
))
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'"))
-(defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
+(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
@@ -499,7 +571,7 @@ over until it returns nil."
(nreverse result)))
)
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 426e1202c3b..91804f4ac9d 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -42,7 +42,7 @@ the hit list.
See the function `cedet-cscope-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
"Perform a search with GNU Global."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
@@ -60,7 +60,7 @@ See the function `cedet-cscope-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index c7b41b0081e..1cfa69fca21 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,6 +1,6 @@
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el
index 75c7b02e7d3..88713474d69 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,6 +1,6 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,7 +38,7 @@ the hit list.
See the function `cedet-gnu-global-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
"Perform a search with GNU Global."
(let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype)
@@ -49,7 +49,7 @@ See the function `cedet-gnu-global-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index ce5c80526a8..cea6d4f07cd 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,6 +1,6 @@
;;; semantic/symref/grep.el --- Symref implementation using find/grep
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -46,9 +46,11 @@ and those hits returned.")
'((c-mode "*.[ch]")
(c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
(html-mode "*.s?html" "*.php")
+ (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
+ "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
)
- "List of major modes and file extension pattern regexp.
-See find -regex man page for format.")
+ "List of major modes and file extension pattern.
+See find -name man page for format.")
(defun semantic-symref-derive-find-filepatterns (&optional mode)
"Derive a list of file patterns for the current buffer.
@@ -85,6 +87,9 @@ Optional argument MODE specifies the `major-mode' to test."
(error "Customize `semantic-symref-filepattern-alist' for %s" major-mode))
)))
+(defvar grepflags)
+(defvar greppattern)
+
(defvar semantic-symref-grep-expand-keywords
(condition-case nil
(let* ((kw (copy-alist grep-expand-keywords))
@@ -96,7 +101,7 @@ Optional argument MODE specifies the `major-mode' to test."
(error nil))
"Grep expand keywords used when expanding templates for symref.")
-(defun semantic-symref-grep-use-template (rootdir filepattern grepflags greppattern)
+(defun semantic-symref-grep-use-template (rootdir filepattern flags pattern)
"Use the grep template expand feature to create a grep command.
ROOTDIR is the root location to run the `find' from.
FILEPATTERN is a string representing find flags for searching file patterns.
@@ -104,43 +109,60 @@ GREPFLAGS are flags passed to grep, such as -n or -l.
GREPPATTERN is the pattern used by grep."
;; We have grep-compute-defaults. Let's use it.
(grep-compute-defaults)
- (let* ((grep-expand-keywords semantic-symref-grep-expand-keywords)
- (cmd (grep-expand-template grep-find-template
- greppattern
- filepattern
- rootdir)))
- ;; For some reason, my default has no <D> in it.
+ (let* ((grepflags flags)
+ (greppattern pattern)
+ (grep-expand-keywords semantic-symref-grep-expand-keywords)
+ (cmd (grep-expand-template
+ (if (memq system-type '(windows-nt ms-dos))
+ ;; grep-find uses '--color=always' on MS-Windows
+ ;; because it wants the colorized output, to show
+ ;; it to the user. By contrast, here we don't show
+ ;; the output, and the SGR escapes get in the way
+ ;; of parsing the output.
+ (replace-regexp-in-string "--color=always" ""
+ grep-find-template t t)
+ grep-find-template)
+ greppattern
+ filepattern
+ rootdir)))
+ ;; http://debbugs.gnu.org/20719
(when (string-match "find \\(\\.\\)" cmd)
(setq cmd (replace-match rootdir t t cmd 1)))
;;(message "New command: %s" cmd)
cmd))
-(defcustom semantic-symref-grep-shell "sh"
+(defcustom semantic-symref-grep-shell shell-file-name
"The shell command to use for executing find/grep.
This shell should support pipe redirect syntax."
:group 'semantic
:type 'string)
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
(let ((st (oref tool :searchtype)))
- (when (not (eq st 'symbol))
+ (when (not (memq st '(symbol regexp)))
(error "Symref impl GREP does not support searchtype of %s" st))
)
;; Find the root of the project, and do a find-grep...
(let* (;; Find the file patterns to use.
- (pat (cdr (assoc major-mode semantic-symref-filepattern-alist)))
(rootdir (semantic-symref-calculate-rootdir))
(filepattern (semantic-symref-derive-find-filepatterns))
;; Grep based flags.
(grepflags (cond ((eq (oref tool :resulttype) 'file)
- "-l ")
- (t "-n ")))
- (greppat (cond ((eq (oref tool :searchtype) 'regexp)
- (oref tool searchfor))
- (t
- (concat "'\\<" (oref tool searchfor) "\\>'"))))
+ "-l ")
+ ((eq (oref tool :searchtype) 'regexp)
+ "-nE ")
+ (t "-n ")))
+ (greppat (shell-quote-argument
+ (cond ((eq (oref tool :searchtype) 'regexp)
+ (oref tool searchfor))
+ (t
+ ;; Can't use the word boundaries: Grep
+ ;; doesn't always agrees with the language
+ ;; syntax on those.
+ (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)"
+ (oref tool searchfor))))))
;; Misc
(b (get-buffer-create "*Semantic SymRef*"))
(ans nil)
@@ -158,16 +180,18 @@ This shell should support pipe redirect syntax."
(let ((cmd (concat "find " default-directory " -type f " filepattern " -print0 "
"| xargs -0 grep -H " grepflags "-e " greppat)))
;;(message "Old command: %s" cmd)
- (call-process semantic-symref-grep-shell nil b nil "-c" cmd)
+ (call-process semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd)
)
(let ((cmd (semantic-symref-grep-use-template rootdir filepattern grepflags greppat)))
- (call-process semantic-symref-grep-shell nil b nil "-c" cmd))
+ (call-process semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd))
))
(setq ans (semantic-symref-parse-tool-output tool b))
;; Return the answer
ans))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 499efe60230..655b000ccdd 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,7 +38,7 @@ the hit list.
See the function `cedet-idutils-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
"Perform a search with IDUtils."
(let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype)
@@ -49,7 +49,7 @@ See the function `cedet-idutils-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
@@ -60,7 +60,7 @@ Moves cursor to end of the match."
(when (re-search-forward "^\\([^ ]+\\) " nil t)
(match-string 1)))
(t
- (when (re-search-forward "^\\([^ :]+\\):+\\([0-9]+\\):" nil t)
+ (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t)
(cons (string-to-number (match-string 2))
(expand-file-name (match-string 1) default-directory))
))))
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index c1f0a092afc..f72499bf88e 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,6 +1,6 @@
;;; semantic/symref/list.el --- Symref Output List UI.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -48,18 +48,18 @@ they are used in.
Display the references in `semantic-symref-results-mode'."
(interactive)
(semantic-fetch-tags)
- (let ((ct (semantic-current-tag))
- (res nil)
- )
+ (let ((ct (semantic-current-tag)))
;; Must have a tag...
(when (not ct) (error "Place cursor inside tag to be searched for"))
;; Check w/ user.
- (when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct))))
+ (when (not (y-or-n-p (format "Find references for %s? "
+ (semantic-tag-name ct))))
(error "Quit"))
;; Gather results and tags
(message "Gathering References...")
- (setq res (semantic-symref-find-references-by-name (semantic-tag-name ct)))
- (semantic-symref-produce-list-on-results res (semantic-tag-name ct))))
+ (let* ((name (semantic-tag-name ct))
+ (res (semantic-symref-find-references-by-name name)))
+ (semantic-symref-produce-list-on-results res name))))
;;;###autoload
(defun semantic-symref-symbol (sym)
@@ -72,11 +72,9 @@ Display the references in `semantic-symref-results-mode'."
(interactive (list (semantic-tag-name (semantic-complete-read-tag-project
"Symrefs for: "))))
(semantic-fetch-tags)
- (let ((res nil)
- )
- ;; Gather results and tags
- (message "Gathering References...")
- (setq res (semantic-symref-find-references-by-name sym))
+ ;; Gather results and tags
+ (message "Gathering References...")
+ (let ((res (semantic-symref-find-references-by-name sym)))
(semantic-symref-produce-list-on-results res sym)))
;;;###autoload
@@ -86,32 +84,19 @@ This command uses the currently configured references tool within the
current project to find references to the input SYM. The
references are the organized by file and the name of the function
they are used in.
-Display the references in`semantic-symref-results-mode'."
- (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep
- "Symrefs for: "))))
+Display the references in `semantic-symref-results-mode'."
+ (interactive (list (let ((tag (semantic-current-tag)))
+ (read-string " Symrefs for: " nil nil
+ (when tag
+ (regexp-quote (semantic-tag-name tag)))))))
+ ;; FIXME: Shouldn't the input be in Emacs regexp format, for
+ ;; consistency? Converting it to extended is not hard.
(semantic-fetch-tags)
- (let ((res nil)
- )
- ;; Gather results and tags
- (message "Gathering References...")
- (setq res (semantic-symref-find-text sym))
+ (message "Gathering References...")
+ ;; Gather results and tags
+ (let ((res (semantic-symref-find-text sym)))
(semantic-symref-produce-list-on-results res sym)))
-
-(defun semantic-symref-produce-list-on-results (res str)
- "Produce a symref list mode buffer on the results RES."
- (when (not res) (error "No references found"))
- (semantic-symref-result-get-tags res t)
- (message "Gathering References...done")
- ;; Build a references buffer.
- (let ((buff (get-buffer-create
- (format "*Symref %s" str)))
- )
- (switch-to-buffer-other-window buff)
- (set-buffer buff)
- (semantic-symref-results-mode res))
- )
-
;;; RESULTS MODE
;;
(defgroup semantic-symref-results-mode nil
@@ -178,36 +163,35 @@ Display the references in`semantic-symref-results-mode'."
(defcustom semantic-symref-auto-expand-results nil
"Non-nil to expand symref results on buffer creation."
- :group 'semantic-symref-results-mode
:type 'boolean)
(defcustom semantic-symref-results-mode-hook nil
"Hook run when `semantic-symref-results-mode' starts."
- :group 'semantic-symref-results-mode
:type 'hook)
(defvar semantic-symref-current-results nil
"The current results in a results mode buffer.")
-(defun semantic-symref-results-mode (results)
- ;; FIXME: Use define-derived-mode.
- "Major-mode for displaying Semantic Symbol Reference RESULTS.
-RESULTS is an object of class `semantic-symref-results'."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'semantic-symref-results-mode
- mode-name "Symref"
- )
- (use-local-map semantic-symref-results-mode-map)
- (set (make-local-variable 'semantic-symref-current-results)
- results)
- (semantic-symref-results-dump results)
- (goto-char (point-min))
+(defun semantic-symref-produce-list-on-results (res str)
+ "Produce a symref list mode buffer on the results RES."
+ (when (not res) (error "No references found"))
+ (semantic-symref-result-get-tags res t)
+ (message "Gathering References...done")
+ ;; Build a references buffer.
+ (let ((buff (get-buffer-create (format "*Symref %s" str))))
+ (switch-to-buffer-other-window buff)
+ (set-buffer buff)
+ (semantic-symref-results-mode)
+ (set (make-local-variable 'semantic-symref-current-results) res)
+ (semantic-symref-results-dump res)
+ (goto-char (point-min))))
+
+(define-derived-mode semantic-symref-results-mode nil "Symref"
+ "Major-mode for displaying Semantic Symbol Reference results."
(buffer-disable-undo)
+ ;; FIXME: Why bother turning off font-lock?
(set (make-local-variable 'font-lock-global-modes) nil)
- (font-lock-mode -1)
- (run-mode-hooks 'semantic-symref-results-mode-hook)
- )
+ (font-lock-mode -1))
(defun semantic-symref-hide-buffer ()
"Hide buffer with semantic-symref results."
@@ -215,9 +199,8 @@ RESULTS is an object of class `semantic-symref-results'."
(bury-buffer))
(defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
- "*Function to use when creating items in Imenu.
+ "Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
- :group 'semantic-symref-results-mode
:type semantic-format-tag-custom-list)
(defun semantic-symref-results-dump (results)
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index b32b46b9e6a..fc5af6b908e 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -1,6 +1,6 @@
;;; semantic/tag-file.el --- Routines that find files based on tags.
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index bc7be980998..fe4440b1e1a 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -1,6 +1,6 @@
;;; semantic/tag-ls.el --- Language Specific override functions for tags
-;; Copyright (C) 1999-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -271,11 +271,11 @@ search locally, then semanticdb for that tag (when enabled.)")
(define-overloadable-function semantic-tag-protection (tag &optional parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
- nil - No special protection. Language dependent.
- 'public - Anyone can access this TAG.
- 'private - Only methods in the local scope can access TAG.
- 'protected - Like private for outside scopes, like public for child
- classes.
+ nil - No special protection. Language dependent.
+ `public' - Anyone can access this TAG.
+ `private' - Only methods in the local scope can access TAG.
+ `protected' - Like private for outside scopes, like public for child
+ classes.
Some languages may choose to provide additional return symbols specific
to themselves. Use of this function should allow for this.
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index 6db6b2e473a..98357186251 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -1,6 +1,6 @@
;;; semantic/tag-write.el --- Write tags to a text stream
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 6c532d2ebf5..34fc8ba92ce 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,6 +1,6 @@
;;; semantic/tag.el --- tag creation and access
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -95,7 +95,7 @@ print statement."
(defsubst semantic-tag-class (tag)
"Return the class of TAG.
-That is, the symbol 'variable, 'function, 'type, or other.
+This is a symbol like `variable', `function', or `type'.
There is no limit to the symbols that may represent the class of a tag.
Each parser generates tags with classes defined by it.
@@ -172,7 +172,7 @@ That function is for internal use only."
(semantic--tag-set-overlay tag (vector start end)))))
(defun semantic-tag-in-buffer-p (tag)
- "Return the buffer TAG resides in IFF tag is already in a buffer.
+ "Return the buffer TAG resides in, if tag is already in a buffer.
If a tag is not in a buffer, return nil."
(let ((o (semantic-tag-overlay tag)))
;; TAG is currently linked to a buffer, return it.
@@ -621,7 +621,7 @@ buffer, the originating buffer file name is kept in the `:filename'
property of the copied tag.
If KEEP-FILE is a string, and the originating buffer is NOT available,
then KEEP-FILE is stored on the `:filename' property.
-This runs the tag hook `unlink-copy-hook`."
+This runs the tag hook `unlink-copy-hook'."
;; Right now, TAG is a list.
(let ((copy (semantic-tag-clone tag name)))
@@ -958,7 +958,7 @@ Return nil if TAG is not of class 'alias."
"Return a list of components for TAG.
A Component is a part of TAG which itself may be a TAG.
Examples include the elements of a structure in a
-tag of class `type, or the list of arguments to a
+tag of class 'type, or the list of arguments to a
tag of class 'function."
)
@@ -1212,7 +1212,7 @@ Returns a list of cooked tags.
The parser returns raw tags with positional data START END at the
end of the tag data structure (a list for now). We convert it from
that to a cooked state that uses an overlay proxy, that is, a vector
-\[START END].
+[START END].
The raw tag is changed with side effects and maybe expanded in
several derived tags when the variable `semantic-tag-expand-function'
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 34a85b8b79b..cf6726e711e 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -1,6 +1,6 @@
;;; semantic/texi.el --- Semantic details for Texinfo files
-;; Copyright (C) 2001-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -32,7 +32,7 @@
(require 'texinfo)
(defvar ede-minor-mode)
-(declare-function lookup-words "ispell")
+(declare-function ispell-lookup-words "ispell")
(declare-function ede-current-project "ede")
(defvar semantic-texi-super-regex
@@ -431,7 +431,7 @@ that start with that symbol."
((member 'word (oref context :prefixclass))
;; Do completion for words via ispell.
(require 'ispell)
- (let ((word-list (lookup-words prefix)))
+ (let ((word-list (ispell-lookup-words prefix)))
(mapcar (lambda (f) (semantic-tag f 'word)) word-list))
)
(t nil))
diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el
index b04de9b1aa6..c080642f670 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -1,6 +1,6 @@
;;; semantic/util-modes.el --- Semantic minor modes
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -684,15 +684,11 @@ when it lands in the sticky line."
(defconst semantic-stickyfunc-header-line-format
(cond ((featurep 'xemacs)
nil)
- ((>= emacs-major-version 22)
+ (t
'(:eval (list
;; Magic bit I found on emacswiki.
(propertize " " 'display '((space :align-to 0)))
- (semantic-stickyfunc-fetch-stickyline))))
- ((= emacs-major-version 21)
- '(:eval (list semantic-stickyfunc-indent-string
- (semantic-stickyfunc-fetch-stickyline))))
- (t nil))
+ (semantic-stickyfunc-fetch-stickyline)))))
"The header line format used by stickyfunc mode.")
;;;###autoload
@@ -719,7 +715,7 @@ minor mode is enabled."
(unless (boundp 'default-header-line-format)
;; Disable if there are no header lines to use.
(setq semantic-stickyfunc-mode nil)
- (error "Sticky Function mode requires Emacs 21"))
+ (error "Sticky Function mode requires Emacs"))
;; Enable the mode
;; Save previous buffer local value of header line format.
(when (and (local-variable-p 'header-line-format (current-buffer))
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 9e89ccb3e6e..fedc28135ae 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -1,6 +1,6 @@
;;; semantic/util.el --- Utilities for use with semantic tag tables
-;;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -419,7 +419,8 @@ determining which symbols are considered."
(setq list (sort list 'string<))
(if (> (length list) 1)
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list list pattern))
+ (display-completion-list
+ (completion-hilit-commonality list (length pattern) nil)))
;; Bury any out-of-date completions buffer.
(let ((win (get-buffer-window "*Completions*" 0)))
(if win (with-selected-window win (bury-buffer))))))
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 89c63e7be96..761bc6812da 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent.el --- Wisent - Semantic gateway
-;; Copyright (C) 2001-2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2007, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -322,9 +322,9 @@ the standard function `semantic-parse-region'."
semantic--progress-reporter
(progress-reporter-update
semantic--progress-reporter
- (/ (* 100 (semantic-lex-token-start
- (car wisent-lex-istream)))
- (point-max))))))
+ (floor (* 100.0 (semantic-lex-token-start
+ (car wisent-lex-istream)))
+ (point-max))))))
;; Return parse tree
(nreverse ptree)))
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 48a83f2cc79..585c11a05d3 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
-;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2013 Free
+;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2015 Free
;; Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -41,6 +41,7 @@
;;; Code:
(require 'semantic/wisent)
+(eval-when-compile (require 'cl))
;;;; -------------------
;;;; Misc. useful things
@@ -66,18 +67,23 @@
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
+ (declare (indent 1))
(let* ((context (wisent-context-name name))
- (bindings (mapcar #'(lambda (v) (list 'defvar v)) vars)))
- `(eval-when-compile
- ,@bindings
- (defvar ,context ',vars))))
-(put 'wisent-defcontext 'lisp-indent-function 1)
+ (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
+ `(progn
+ ,@declarations
+ (eval-when-compile
+ (defvar ,context ',vars)))))
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
- `(let* ,(wisent-context-bindings name)
- ,@body))
-(put 'wisent-with-context 'lisp-indent-function 1)
+ (declare (indent 1))
+ (let ((bindings (wisent-context-bindings name)))
+ `(progn
+ ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding)))
+ bindings)
+ (let* ,bindings
+ ,@body))))
;; A naive implementation of data structures! But it suffice here ;-)
@@ -224,11 +230,11 @@ Its name is defined in constant `wisent-log-buffer-name'."
(defsubst wisent-log (&rest args)
"Insert text into the log buffer.
-`format' is applied to ARGS and the result string is inserted into the
+`format-message' is applied to ARGS and the result string is inserted into the
log buffer returned by the function `wisent-log-buffer'."
(and wisent-new-log-flag (wisent-new-log))
(with-current-buffer (wisent-log-buffer)
- (insert (apply 'format args))))
+ (insert (apply #'format-message args))))
(defconst wisent-log-file "wisent.output"
"The log file.
@@ -909,7 +915,7 @@ An NVARS by NRULES matrix of bits indicating which rules can help
derive the beginning of the data for each nonterminal. For example,
if symbol 5 can be derived as the sequence of symbols 8 3 20, and one
of the rules for deriving symbol 8 is rule 4, then the
-\[5 - NTOKENS, 4] bit in FDERIVES is set."
+[5 - NTOKENS, 4] bit in FDERIVES is set."
(let (i j k)
(setq fderives (make-vector nvars nil))
(setq i 0)
@@ -2886,7 +2892,7 @@ Also warn if X is a $N or $regionN symbol with N < 1 or N > M."
"Parse BODY of semantic action.
N is the maximum number of $N variables that can be referenced in
BODY. Warn on references out of permitted range.
-Optional argument FOUND is the accumulated list of '$N' references
+Optional argument FOUND is the accumulated list of $N references
encountered so far.
Return a cons (FOUND . XBODY), where FOUND is the list of $N
references found in BODY, and XBODY is BODY expression with
@@ -2896,7 +2902,7 @@ references found in BODY, and XBODY is BODY expression with
(progn
(if (wisent-check-$N body n)
;; Accumulate $i symbol
- (add-to-list 'found body))
+ (pushnew body found :test #'equal))
(cons found body))
;; BODY is a list, expand inside it
(let (xbody sexpr)
@@ -2916,7 +2922,7 @@ references found in BODY, and XBODY is BODY expression with
;; $i symbol
((wisent-check-$N sexpr n)
;; Accumulate $i symbol
- (add-to-list 'found sexpr))
+ (pushnew sexpr found :test #'equal))
)
;; Accumulate expanded forms
(setq xbody (nconc xbody (list sexpr))))
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 109d5ae7dfb..a247c250810 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -473,6 +473,54 @@ Menu items are appended to the common grammar menu.")
\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
,wisent-make-parsers--python-license)))
+;; Cf bovine--make-parser-1.
+(defun wisent--make-parser-1 (infile &optional outdir)
+ (if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
+ (let ((packagename
+ ;; This is with-demoted-errors.
+ (condition-case err
+ (with-current-buffer (find-file-noselect infile)
+ (if outdir (setq default-directory outdir))
+ (semantic-grammar-create-package nil t))
+ (error (message "%s" (error-message-string err)) nil)))
+ output-data)
+ (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
+ (let ((additional-copyright (nth 1 output-data))
+ (additional-license (nth 2 output-data))
+ (filename (expand-file-name
+ (progn (string-match ".*/\\(.*\\)" packagename)
+ (match-string 1 packagename))
+ outdir))
+ copyright-end)
+ ;; Touch up the generated parsers for Emacs integration.
+ (with-temp-file filename
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (when additional-copyright
+ (re-search-forward "Copyright (C).*$")
+ (insert "\n;; " additional-copyright))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert wisent-make-parsers--emacs-license)
+ (insert "\n\n;;; Commentary:
+;;
+;; This file was generated from admin/grammars/"
+ (file-name-nondirectory infile) ".")
+ (when additional-license
+ (insert "\n" additional-license))
+ (insert "\n\n;;; Code:\n")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (delete-trailing-whitespace))))))
+
(defun wisent-make-parsers ()
"Generate Emacs' built-in Wisent-based parser files."
(interactive)
@@ -480,46 +528,32 @@ Menu items are appended to the common grammar menu.")
;; Loop through each .wy file in current directory, and run
;; `semantic-grammar-batch-build-one-package' to build the grammar.
(dolist (f (directory-files default-directory nil "\\.wy\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- output-data)
- (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
- (let ((additional-copyright (nth 1 output-data))
- (additional-license (nth 2 output-data))
- (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
- copyright-end)
- ;; Touch up the generated parsers for Emacs integration.
- (with-temp-buffer
- (insert-file-contents filename)
- ;; Fix copyright header:
- (goto-char (point-min))
- (when additional-copyright
- (re-search-forward "Copyright (C).*$")
- (insert "\n;; " additional-copyright))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert wisent-make-parsers--emacs-license)
- (insert "\n\n;;; Commentary:
-;;
-;; This file was generated from admin/grammars/"
- f ".")
- (when additional-license
- (insert "\n" additional-license))
- (insert "\n\n;;; Code:\n")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (delete-trailing-whitespace)
- (write-region nil nil (expand-file-name filename))))))))
+ (wisent--make-parser-1 f)))
+
+
+(defun wisent-batch-make-parser (&optional infile outdir)
+ "Generate a Wisent parser from input INFILE, writing to OUTDIR.
+This is mainly intended for use in batch mode:
+
+emacs -batch -l semantic/wisent/grammar -f wisent-make-parser-batch \\
+ [-dir output-dir | -o output-file] file.by
+
+If -o is supplied, only the directory part is used."
+ (semantic-mode 1)
+ (when (and noninteractive (not infile))
+ (let (arg)
+ (while command-line-args-left
+ (setq arg (pop command-line-args-left))
+ (cond ((string-equal arg "-dir")
+ (setq outdir (pop command-line-args-left)))
+ ((string-equal arg "-o")
+ (setq outdir (file-name-directory (pop command-line-args-left))))
+ (t (setq infile arg))))))
+ (or infile (error "No input file specified"))
+ (or (file-readable-p infile)
+ (error "Input file `%s' not readable" infile))
+ (wisent--make-parser-1 infile outdir))
+
(provide 'semantic/wisent/grammar)
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index 076ffedc419..f0496322d20 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
-;; Copyright (C) 2001-2006, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2006, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index d27f1bc4c66..a676a8b4591 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/javascript.el --- javascript parser support
-;; Copyright (C) 2005, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -73,11 +73,11 @@ This function overrides `get-local-variables'."
(define-mode-local-override semantic-tag-protection javascript-mode (tag &optional parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
- nil - No special protection. Language dependent.
- 'public - Anyone can access this TAG.
- 'private - Only methods in the local scope can access TAG.
- 'protected - Like private for outside scopes, like public for child
- classes.
+ nil - No special protection. Language dependent.
+ `public' - Anyone can access this TAG.
+ `private' - Only methods in the local scope can access TAG.
+ `protected' - Like private for outside scopes, like public for child
+ classes.
Some languages may choose to provide additional return symbols specific
to themselves. Use of this function should allow for this.
@@ -114,7 +114,7 @@ This is currently needed for the mozrepl omniscient database."
(setq symlist (list (match-string 1 tmp)
(substring tmp (1+ (match-end 1)) (length tmp))))
(setq symlist (list tmp))))))))
-
+
;;; Setup Function
;;
;; Since javascript-mode is an alias for js-mode, let it inherit all
diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el
deleted file mode 100644
index 1156cb5792c..00000000000
--- a/lisp/cedet/semantic/wisent/javat-wy.el
+++ /dev/null
@@ -1,688 +0,0 @@
-;;; semantic/wisent/javat-wy.el --- Generated parser support file
-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/java-tags.wy.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-java-tags-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("abstract" . ABSTRACT)
- ("boolean" . BOOLEAN)
- ("break" . BREAK)
- ("byte" . BYTE)
- ("case" . CASE)
- ("catch" . CATCH)
- ("char" . CHAR)
- ("class" . CLASS)
- ("const" . CONST)
- ("continue" . CONTINUE)
- ("default" . DEFAULT)
- ("do" . DO)
- ("double" . DOUBLE)
- ("else" . ELSE)
- ("extends" . EXTENDS)
- ("final" . FINAL)
- ("finally" . FINALLY)
- ("float" . FLOAT)
- ("for" . FOR)
- ("goto" . GOTO)
- ("if" . IF)
- ("implements" . IMPLEMENTS)
- ("import" . IMPORT)
- ("instanceof" . INSTANCEOF)
- ("int" . INT)
- ("interface" . INTERFACE)
- ("long" . LONG)
- ("native" . NATIVE)
- ("new" . NEW)
- ("package" . PACKAGE)
- ("private" . PRIVATE)
- ("protected" . PROTECTED)
- ("public" . PUBLIC)
- ("return" . RETURN)
- ("short" . SHORT)
- ("static" . STATIC)
- ("strictfp" . STRICTFP)
- ("super" . SUPER)
- ("switch" . SWITCH)
- ("synchronized" . SYNCHRONIZED)
- ("this" . THIS)
- ("throw" . THROW)
- ("throws" . THROWS)
- ("transient" . TRANSIENT)
- ("try" . TRY)
- ("void" . VOID)
- ("volatile" . VOLATILE)
- ("while" . WHILE)
- ("@author" . _AUTHOR)
- ("@version" . _VERSION)
- ("@param" . _PARAM)
- ("@return" . _RETURN)
- ("@exception" . _EXCEPTION)
- ("@throws" . _THROWS)
- ("@see" . _SEE)
- ("@since" . _SINCE)
- ("@serial" . _SERIAL)
- ("@serialData" . _SERIALDATA)
- ("@serialField" . _SERIALFIELD)
- ("@deprecated" . _DEPRECATED))
- '(("@deprecated" javadoc
- (seq 12 usage
- (type function variable)
- opt t))
- ("@serialField" javadoc
- (seq 11 usage
- (variable)
- opt t))
- ("@serialData" javadoc
- (seq 10 usage
- (function)
- opt t))
- ("@serial" javadoc
- (seq 9 usage
- (variable)
- opt t))
- ("@since" javadoc
- (seq 8 usage
- (type function variable)
- opt t))
- ("@see" javadoc
- (seq 7 usage
- (type function variable)
- opt t with-ref t))
- ("@throws" javadoc
- (seq 6 usage
- (function)
- with-name t))
- ("@exception" javadoc
- (seq 5 usage
- (function)
- with-name t))
- ("@return" javadoc
- (seq 4 usage
- (function)))
- ("@param" javadoc
- (seq 3 usage
- (function)
- with-name t))
- ("@version" javadoc
- (seq 2 usage
- (type)))
- ("@author" javadoc
- (seq 1 usage
- (type)))
- ("while" summary "while (<expr>) <stmt> | do <stmt> while (<expr>);")
- ("volatile" summary "Field declaration modifier: volatile <type> <name> ...")
- ("void" summary "Method return type: void <name> ...")
- ("try" summary "try {<stmts>} [catch(<parm>) {<stmts>} ...] [finally {<stmts>}]")
- ("transient" summary "Field declaration modifier: transient <type> <name> ...")
- ("throws" summary "Method|Constructor declaration: throws <classType>, ...")
- ("throw" summary "throw <expr> ;")
- ("synchronized" summary "synchronized (<expr>) ... | Method decl. modifier: synchronized <type> <name> ...")
- ("switch" summary "switch(<expr>) {[case <const-expr>: <stmts> ...] [default: <stmts>]}")
- ("strictfp" summary "Declaration modifier: strictfp {class|interface|<type>} <name> ...")
- ("static" summary "Declaration modifier: static {class|interface|<type>} <name> ...")
- ("short" summary "Integral primitive type (-32768 to 32767)")
- ("return" summary "return [<expr>] ;")
- ("public" summary "Access level modifier: public {class|interface|<type>} <name> ...")
- ("protected" summary "Access level modifier: protected {class|interface|<type>} <name> ...")
- ("private" summary "Access level modifier: private {class|interface|<type>} <name> ...")
- ("package" summary "Package declaration: package <name>")
- ("native" summary "Method declaration modifier: native <type> <name> ...")
- ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
- ("interface" summary "Interface declaration: interface <name>")
- ("int" summary "Integral primitive type (-2147483648 to 2147483647)")
- ("import" summary "Import package declarations: import <package>")
- ("implements" summary "Class SuperInterfaces declaration: implements <name> [, ...]")
- ("if" summary "if (<expr>) <stmt> [else <stmt>]")
- ("goto" summary "Unused reserved word")
- ("for" summary "for ([<init-expr>]; [<expr>]; [<update-expr>]) <stmt>")
- ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
- ("finally" summary "try {<stmts>} ... finally {<stmts>}")
- ("final" summary "Class|Member declaration modifier: final {class|<type>} <name> ...")
- ("extends" summary "SuperClass|SuperInterfaces declaration: extends <name> [, ...]")
- ("else" summary "if (<expr>) <stmt> else <stmt>")
- ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
- ("do" summary "do <stmt> while (<expr>);")
- ("default" summary "switch(<expr>) { ... default: <stmts>}")
- ("continue" summary "continue [<label>] ;")
- ("const" summary "Unused reserved word")
- ("class" summary "Class declaration: class <name>")
- ("char" summary "Integral primitive type (0 to 65535)")
- ("catch" summary "try {<stmts>} catch(<parm>) {<stmts>} ... ")
- ("case" summary "switch(<expr>) {case <const-expr>: <stmts> ... }")
- ("byte" summary "Integral primitive type (-128 to 127)")
- ("break" summary "break [<label>] ;")
- ("boolean" summary "Primitive logical quantity type (true or false)")
- ("abstract" summary "Class|Method declaration modifier: abstract {class|<type>} <name> ...")))
- "Table of language keywords.")
-
-(defconst wisent-java-tags-wy--token-table
- (semantic-lex-make-type-table
- '(("unicode"
- (unicodecharacter))
- ("number"
- (NUMBER_LITERAL))
- ("string"
- (STRING_LITERAL))
- ("symbol"
- (IDENTIFIER))
- ("punctuation"
- (COMP . "~")
- (OROR . "||")
- (OREQ . "|=")
- (OR . "|")
- (XOREQ . "^=")
- (XOR . "^")
- (QUESTION . "?")
- (URSHIFTEQ . ">>>=")
- (URSHIFT . ">>>")
- (RSHIFTEQ . ">>=")
- (RSHIFT . ">>")
- (GTEQ . ">=")
- (GT . ">")
- (EQEQ . "==")
- (EQ . "=")
- (LTEQ . "<=")
- (LSHIFTEQ . "<<=")
- (LSHIFT . "<<")
- (LT . "<")
- (SEMICOLON . ";")
- (COLON . ":")
- (DIVEQ . "/=")
- (DIV . "/")
- (DOT . ".")
- (MINUSEQ . "-=")
- (MINUSMINUS . "--")
- (MINUS . "-")
- (COMMA . ",")
- (PLUSEQ . "+=")
- (PLUSPLUS . "++")
- (PLUS . "+")
- (MULTEQ . "*=")
- (MULT . "*")
- (ANDEQ . "&=")
- (ANDAND . "&&")
- (AND . "&")
- (MODEQ . "%=")
- (MOD . "%")
- (NOTEQ . "!=")
- (NOT . "!"))
- ("close-paren"
- (RBRACK . "]")
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACK . "[")
- (LBRACE . "{")
- (LPAREN . "("))
- ("block"
- (BRACK_BLOCK . "(LBRACK RBRACK)")
- (BRACE_BLOCK . "(LBRACE RBRACE)")
- (PAREN_BLOCK . "(LPAREN RPAREN)")))
- '(("keyword" :declared t)
- ("unicode" syntax "\\\\u[0-9a-f][0-9a-f][0-9a-f][0-9a-f]")
- ("unicode" :declared t)
- ("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("punctuation" :declared t)
- ("block" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-java-tags-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK NOT NOTEQ MOD MODEQ AND ANDAND ANDEQ MULT MULTEQ PLUS PLUSPLUS PLUSEQ COMMA MINUS MINUSMINUS MINUSEQ DOT DIV DIVEQ COLON SEMICOLON LT LSHIFT LSHIFTEQ LTEQ EQ EQEQ GT GTEQ RSHIFT RSHIFTEQ URSHIFT URSHIFTEQ QUESTION XOR XOREQ OR OREQ OROR COMP IDENTIFIER STRING_LITERAL NUMBER_LITERAL unicodecharacter ABSTRACT BOOLEAN BREAK BYTE CASE CATCH CHAR CLASS CONST CONTINUE DEFAULT DO DOUBLE ELSE EXTENDS FINAL FINALLY FLOAT FOR GOTO IF IMPLEMENTS IMPORT INSTANCEOF INT INTERFACE LONG NATIVE NEW PACKAGE PRIVATE PROTECTED PUBLIC RETURN SHORT STATIC STRICTFP SUPER SWITCH SYNCHRONIZED THIS THROW THROWS TRANSIENT TRY VOID VOLATILE WHILE _AUTHOR _VERSION _PARAM _RETURN _EXCEPTION _THROWS _SEE _SINCE _SERIAL _SERIALDATA _SERIALFIELD _DEPRECATED)
- nil
- (compilation_unit
- ((package_declaration))
- ((import_declaration))
- ((type_declaration)))
- (package_declaration
- ((PACKAGE qualified_name SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-package $2 nil))))
- (import_declaration
- ((IMPORT qualified_name SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil)))
- ((IMPORT qualified_name DOT MULT SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-include
- (concat $2 $3 $4)
- nil))))
- (type_declaration
- ((SEMICOLON)
- nil)
- ((class_declaration))
- ((interface_declaration)))
- (class_declaration
- ((modifiers_opt CLASS qualified_name superc_opt interfaces_opt class_body)
- (wisent-raw-tag
- (semantic-tag-new-type $3 $2 $6
- (if
- (or $4 $5)
- (cons $4 $5))
- :typemodifiers $1))))
- (superc_opt
- (nil)
- ((EXTENDS qualified_name)
- (identity $2)))
- (interfaces_opt
- (nil)
- ((IMPLEMENTS qualified_name_list)
- (nreverse $2)))
- (class_body
- ((BRACE_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'class_member_declaration 1)))
- (class_member_declaration
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((block)
- nil)
- ((static_initializer)
- nil)
- ((constructor_declaration))
- ((interface_declaration))
- ((class_declaration))
- ((method_declaration))
- ((field_declaration)))
- (interface_declaration
- ((modifiers_opt INTERFACE qualified_name extends_interfaces_opt interface_body)
- (wisent-raw-tag
- (semantic-tag-new-type $3 $2 $5
- (if $4
- (cons nil $4))
- :typemodifiers $1))))
- (extends_interfaces_opt
- (nil)
- ((EXTENDS qualified_name_list)
- (identity $2)))
- (interface_body
- ((BRACE_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'interface_member_declaration 1)))
- (interface_member_declaration
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((interface_declaration))
- ((class_declaration))
- ((method_declaration))
- ((field_declaration)))
- (static_initializer
- ((STATIC block)))
- (constructor_declaration
- ((modifiers_opt constructor_declarator throwsc_opt constructor_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $2)
- nil
- (cdr $2)
- :typemodifiers $1 :throws $3 :constructor-flag t))))
- (constructor_declarator
- ((IDENTIFIER formal_parameter_list)
- (cons $1 $2)))
- (constructor_body
- ((block)))
- (method_declaration
- ((modifiers_opt VOID method_declarator throwsc_opt method_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $3)
- $2
- (cdr $3)
- :typemodifiers $1 :throws $4)))
- ((modifiers_opt type method_declarator throwsc_opt method_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $3)
- $2
- (cdr $3)
- :typemodifiers $1 :throws $4))))
- (method_declarator
- ((IDENTIFIER formal_parameter_list dims_opt)
- (cons
- (concat $1 $3)
- $2)))
- (throwsc_opt
- (nil)
- ((THROWS qualified_name_list)
- (nreverse $2)))
- (qualified_name_list
- ((qualified_name_list COMMA qualified_name)
- (cons $3 $1))
- ((qualified_name)
- (list $1)))
- (method_body
- ((SEMICOLON))
- ((block)))
- (block
- ((BRACE_BLOCK)))
- (formal_parameter_list
- ((PAREN_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'formal_parameters 1)))
- (formal_parameters
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((formal_parameter COMMA))
- ((formal_parameter RPAREN)))
- (formal_parameter
- ((formal_parameter_modifier_opt type opt_variable_declarator_id)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 $2 nil :typemodifiers $1))))
- (formal_parameter_modifier_opt
- (nil)
- ((FINAL)
- (list $1)))
- (field_declaration
- ((modifiers_opt type variable_declarators SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 $2 nil :typemodifiers $1))))
- (variable_declarators
- ((variable_declarators COMMA variable_declarator)
- (progn
- (setcdr
- (cdr
- (car $1))
- (cdr $region2))
- (cons $3 $1)))
- ((variable_declarator)
- (list $1)))
- (variable_declarator
- ((variable_declarator_id EQ variable_initializer)
- (cons $1 $region))
- ((variable_declarator_id)
- (cons $1 $region)))
- (opt_variable_declarator_id
- (nil
- (identity ""))
- ((variable_declarator_id)
- (identity $1)))
- (variable_declarator_id
- ((IDENTIFIER dims_opt)
- (concat $1 $2)))
- (variable_initializer
- ((expression)))
- (expression
- ((expression term))
- ((term)))
- (term
- ((literal))
- ((operator))
- ((primitive_type))
- ((IDENTIFIER))
- ((BRACK_BLOCK))
- ((PAREN_BLOCK))
- ((BRACE_BLOCK))
- ((NEW))
- ((CLASS))
- ((THIS))
- ((SUPER)))
- (literal
- ((STRING_LITERAL))
- ((NUMBER_LITERAL)))
- (operator
- ((NOT))
- ((PLUS))
- ((PLUSPLUS))
- ((MINUS))
- ((MINUSMINUS))
- ((NOTEQ))
- ((MOD))
- ((MODEQ))
- ((AND))
- ((ANDAND))
- ((ANDEQ))
- ((MULT))
- ((MULTEQ))
- ((PLUSEQ))
- ((MINUSEQ))
- ((DOT))
- ((DIV))
- ((DIVEQ))
- ((COLON))
- ((LT))
- ((LSHIFT))
- ((LSHIFTEQ))
- ((LTEQ))
- ((EQ))
- ((EQEQ))
- ((GT))
- ((GTEQ))
- ((RSHIFT))
- ((RSHIFTEQ))
- ((URSHIFT))
- ((URSHIFTEQ))
- ((QUESTION))
- ((XOR))
- ((XOREQ))
- ((OR))
- ((OREQ))
- ((OROR))
- ((COMP))
- ((INSTANCEOF)))
- (primitive_type
- ((BOOLEAN))
- ((CHAR))
- ((LONG))
- ((INT))
- ((SHORT))
- ((BYTE))
- ((DOUBLE))
- ((FLOAT)))
- (modifiers_opt
- (nil)
- ((modifiers)
- (nreverse $1)))
- (modifiers
- ((modifiers modifier)
- (cons $2 $1))
- ((modifier)
- (list $1)))
- (modifier
- ((STRICTFP))
- ((VOLATILE))
- ((TRANSIENT))
- ((SYNCHRONIZED))
- ((NATIVE))
- ((FINAL))
- ((ABSTRACT))
- ((STATIC))
- ((PRIVATE))
- ((PROTECTED))
- ((PUBLIC)))
- (type
- ((qualified_name dims_opt)
- (concat $1 $2))
- ((primitive_type dims_opt)
- (concat $1 $2)))
- (qualified_name
- ((qualified_name DOT IDENTIFIER)
- (concat $1 $2 $3))
- ((IDENTIFIER)))
- (dims_opt
- (nil
- (identity ""))
- ((dims)))
- (dims
- ((dims BRACK_BLOCK)
- (concat $1 "[]"))
- ((BRACK_BLOCK)
- (identity "[]"))))
- '(compilation_unit package_declaration import_declaration class_declaration field_declaration method_declaration formal_parameter constructor_declaration interface_declaration class_member_declaration interface_member_declaration formal_parameters)))
- "Parser table.")
-
-(defun wisent-java-tags-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-java-tags-wy--parse-table
- semantic-debug-parser-source "java-tags.wy"
- semantic-flex-keywords-obarray wisent-java-tags-wy--keyword-table
- semantic-lex-types-obarray wisent-java-tags-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-java-tags-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" LPAREN PAREN_BLOCK)
- ("{" LBRACE BRACE_BLOCK)
- ("[" LBRACK BRACK_BLOCK))
- (")" RPAREN)
- ("}" RBRACE)
- ("]" RBRACK))
- )
-
-(define-lex-string-type-analyzer wisent-java-tags-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((COMP . "~")
- (OROR . "||")
- (OREQ . "|=")
- (OR . "|")
- (XOREQ . "^=")
- (XOR . "^")
- (QUESTION . "?")
- (URSHIFTEQ . ">>>=")
- (URSHIFT . ">>>")
- (RSHIFTEQ . ">>=")
- (RSHIFT . ">>")
- (GTEQ . ">=")
- (GT . ">")
- (EQEQ . "==")
- (EQ . "=")
- (LTEQ . "<=")
- (LSHIFTEQ . "<<=")
- (LSHIFT . "<<")
- (LT . "<")
- (SEMICOLON . ";")
- (COLON . ":")
- (DIVEQ . "/=")
- (DIV . "/")
- (DOT . ".")
- (MINUSEQ . "-=")
- (MINUSMINUS . "--")
- (MINUS . "-")
- (COMMA . ",")
- (PLUSEQ . "+=")
- (PLUSPLUS . "++")
- (PLUS . "+")
- (MULTEQ . "*=")
- (MULT . "*")
- (ANDEQ . "&=")
- (ANDAND . "&&")
- (AND . "&")
- (MODEQ . "%=")
- (MOD . "%")
- (NOTEQ . "!=")
- (NOT . "!"))
- 'punctuation)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'IDENTIFIER)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<unicode>-regexp-analyzer
- "regexp analyzer for <unicode> tokens."
- "\\\\u[0-9a-f][0-9a-f][0-9a-f][0-9a-f]"
- nil
- 'unicodecharacter)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER_LITERAL)
-
-(define-lex-sexp-type-analyzer wisent-java-tags-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING_LITERAL)
-
-(define-lex-keyword-type-analyzer wisent-java-tags-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-;; Define the lexer for this grammar
-(define-lex wisent-java-tags-lexer
- "Lexical analyzer that handles Java buffers.
-It ignores whitespaces, newlines and comments."
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
- ;;;; Auto-generated analyzers.
- wisent-java-tags-wy--<number>-regexp-analyzer
- wisent-java-tags-wy--<string>-sexp-analyzer
- ;; Must detect keywords before other symbols
- wisent-java-tags-wy--<keyword>-keyword-analyzer
- wisent-java-tags-wy--<symbol>-regexp-analyzer
- wisent-java-tags-wy--<punctuation>-string-analyzer
- wisent-java-tags-wy--<block>-block-analyzer
- ;; In theory, Unicode chars should be turned into normal chars
- ;; and then combined into regular ascii keywords and text. This
- ;; analyzer just keeps these things from making the lexer go boom.
- wisent-java-tags-wy--<unicode>-regexp-analyzer
- ;;;;
- semantic-lex-default-action)
-
-(provide 'semantic/wisent/javat-wy)
-
-;;; semantic/wisent/javat-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/js-wy.el b/lisp/cedet/semantic/wisent/js-wy.el
deleted file mode 100644
index 2e331b1c4d9..00000000000
--- a/lisp/cedet/semantic/wisent/js-wy.el
+++ /dev/null
@@ -1,530 +0,0 @@
-;;; semantic/wisent/js-wy.el --- Generated parser support file
-
-;; Copyright (C) 2005, 2009-2013 Free Software Foundation, Inc.
-;; Copyright (C) 1998-2011 Ecma International.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/js.wy.
-
-;; It is derived from the grammar in the ECMAScript Language
-;; Specification published at
-;;
-;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
-;;
-;; and redistributed under the following license:
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above
-;; copyright notice, this list of conditions and the following
-;; disclaimer in the documentation and/or other materials provided
-;; with the distribution.
-;;
-;; 3. Neither the name of the authors nor Ecma International may be
-;; used to endorse or promote products derived from this software
-;; without specific prior written permission. THIS SOFTWARE IS
-;; PROVIDED BY THE ECMA INTERNATIONAL "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
-;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
-;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
-;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-;; DAMAGE.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-javascript-jv-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("if" . IF)
- ("break" . BREAK)
- ("continue" . CONTINUE)
- ("else" . ELSE)
- ("for" . FOR)
- ("function" . FUNCTION)
- ("this" . THIS)
- ("return" . RETURN)
- ("while" . WHILE)
- ("void" . VOID_SYMBOL)
- ("new" . NEW)
- ("delete" . DELETE)
- ("var" . VAR)
- ("with" . WITH)
- ("typeof" . TYPEOF)
- ("in" . IN))
- '(("in" summary "in something")
- ("typeof" summary "typeof ")
- ("with" summary "with ")
- ("var" summary "var <variablename> [= value];")
- ("delete" summary "delete(<objectreference>) - Deletes the object.")
- ("new" summary "new <objecttype> - Creates a new object.")
- ("void" summary "Method return type: void <name> ...")
- ("while" summary "while (<expr>) <stmt> | do <stmt> while (<expr>);")
- ("return" summary "return [<expr>] ;")
- ("this" summary "this")
- ("function" summary "function declaration blah blah")
- ("for" summary "for ([<init-expr>]; [<expr>]; [<update-expr>]) <stmt>")
- ("else" summary "if (<expr>) <stmt> else <stmt>")
- ("continue" summary "continue [<label>] ;")
- ("break" summary "break [<label>] ;")
- ("if" summary "if (<expr>) <stmt> [else <stmt>] (jv)")))
- "Table of language keywords.")
-
-(defconst wisent-javascript-jv-wy--token-table
- (semantic-lex-make-type-table
- '(("<no-type>"
- (NULL_TOKEN)
- (QUERY)
- (TRUE)
- (FALSE))
- ("number"
- (NUMBER))
- ("string"
- (STRING))
- ("symbol"
- (VARIABLE))
- ("close-paren"
- (CLOSE_SQ_BRACKETS . "]")
- (END_BLOCK . "}")
- (CLOSE_PARENTHESIS . ")"))
- ("open-paren"
- (OPEN_SQ_BRACKETS . "[")
- (START_BLOCK . "{")
- (OPEN_PARENTHESIS . "("))
- ("block"
- (BRACK_BLOCK . "(OPEN_SQ_BRACKETS CLOSE_SQ_BRACKETS)")
- (BRACE_BLOCK . "(START_BLOCK END_BLOCK)")
- (PAREN_BLOCK . "(OPEN_PARENTHESIS CLOSE_PARENTHESIS)"))
- ("punctuation"
- (ONES_COMPLIMENT . "~")
- (SEMICOLON . ";")
- (LINE_TERMINATOR . "\n")
- (LESS_THAN . "<")
- (DOT . ".")
- (COMMA . ",")
- (COLON . ":")
- (DIV . "/")
- (DECREMENT . "--")
- (INCREMENT . "++")
- (PLUS_EQUALS . "+=")
- (PLUS . "+")
- (MULTIPLY_EQUALS . "*=")
- (MULTIPLY . "*")
- (MOD_EQUALS . "%=")
- (MOD . "%")
- (MINUS_EQUALS . "-=")
- (MINUS . "-")
- (LS_EQUAL . "<=")
- (LOGICAL_NOT . "!!")
- (LOGICAL_OR . "||")
- (LOGICAL_AND . "&&")
- (GT_EQUAL . ">=")
- (GREATER_THAN . ">")
- (EQUALS . "==")
- (DIV_EQUALS . "/=")
- (NOT_EQUAL . "!=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS . ">>>=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL . ">>>")
- (BITWISE_SHIFT_RIGHT_EQUALS . ">>=")
- (BITWISE_SHIFT_RIGHT . ">>")
- (BITWISE_SHIFT_LEFT_EQUALS . "<<=")
- (BITWISE_SHIFT_LEFT . "<<")
- (BITWISE_OR_EQUALS . "|=")
- (BITWISE_OR . "|")
- (BITWISE_EXCLUSIVE_OR_EQUALS . "^=")
- (BITWISE_EXCLUSIVE_OR . "^")
- (BITWISE_AND_EQUALS . "&=")
- (BITWISE_AND . "&")
- (ASSIGN_SYMBOL . "=")))
- '(("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("keyword" :declared t)
- ("block" :declared t)
- ("punctuation" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-javascript-jv-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((ASSIGN_SYMBOL BITWISE_AND BITWISE_AND_EQUALS BITWISE_EXCLUSIVE_OR BITWISE_EXCLUSIVE_OR_EQUALS BITWISE_OR BITWISE_OR_EQUALS BITWISE_SHIFT_LEFT BITWISE_SHIFT_LEFT_EQUALS BITWISE_SHIFT_RIGHT BITWISE_SHIFT_RIGHT_EQUALS BITWISE_SHIFT_RIGHT_ZERO_FILL BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS NOT_EQUAL DIV_EQUALS EQUALS GREATER_THAN GT_EQUAL LOGICAL_AND LOGICAL_OR LOGICAL_NOT LS_EQUAL MINUS MINUS_EQUALS MOD MOD_EQUALS MULTIPLY MULTIPLY_EQUALS PLUS PLUS_EQUALS INCREMENT DECREMENT DIV COLON COMMA DOT LESS_THAN LINE_TERMINATOR SEMICOLON ONES_COMPLIMENT PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK OPEN_PARENTHESIS CLOSE_PARENTHESIS START_BLOCK END_BLOCK OPEN_SQ_BRACKETS CLOSE_SQ_BRACKETS IF BREAK CONTINUE ELSE FOR FUNCTION THIS RETURN WHILE VOID_SYMBOL NEW DELETE VAR WITH TYPEOF IN VARIABLE STRING NUMBER FALSE TRUE QUERY NULL_TOKEN)
- ((left PLUS MINUS)
- (left MULTIPLY DIV MOD)
- (nonassoc FALSE)
- (nonassoc HIGHER_THAN_FALSE)
- (nonassoc ELSE)
- (nonassoc LOWER_THAN_CLOSE_PARENTHESIS)
- (nonassoc CLOSE_PARENTHESIS))
- (Program
- ((SourceElement)))
- (SourceElement
- ((Statement))
- ((FunctionDeclaration)))
- (Statement
- ((Block))
- ((VariableStatement))
- ((EmptyStatement))
- ((ExpressionStatement))
- ((IfStatement))
- ((IterationExpression))
- ((ContinueStatement))
- ((BreakStatement))
- ((ReturnStatement))
- ((WithStatement)))
- (FunctionDeclaration
- ((FUNCTION VARIABLE FormalParameterListBlock Block)
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3))))
- (FormalParameterListBlock
- ((PAREN_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'FormalParameterList 1)))
- (FormalParameterList
- ((OPEN_PARENTHESIS)
- nil)
- ((VARIABLE)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil)))
- ((CLOSE_PARENTHESIS)
- nil)
- ((COMMA)
- nil))
- (StatementList
- ((Statement))
- ((StatementList Statement)))
- (Block
- ((BRACE_BLOCK)))
- (BlockExpand
- ((START_BLOCK StatementList END_BLOCK))
- ((START_BLOCK END_BLOCK)))
- (VariableStatement
- ((VAR VariableDeclarationList SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil))))
- (VariableDeclarationList
- ((VariableDeclaration)
- (list $1))
- ((VariableDeclarationList COMMA VariableDeclaration)
- (append $1
- (list $3))))
- (VariableDeclaration
- ((VARIABLE)
- (append
- (list $1 nil)
- $region))
- ((VARIABLE Initializer)
- (append
- (cons $1 $2)
- $region)))
- (Initializer
- ((ASSIGN_SYMBOL AssignmentExpression)
- (list $2)))
- (EmptyStatement
- ((SEMICOLON)))
- (ExpressionStatement
- ((Expression SEMICOLON)))
- (IfStatement
- ((IF OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)
- [HIGHER_THAN_FALSE])
- ((IF OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement ELSE Statement))
- ((IF OPEN_PARENTHESIS FALSE CLOSE_PARENTHESIS Statement))
- ((IF OPEN_PARENTHESIS LeftHandSideExpression AssignmentOperator AssignmentExpression CLOSE_PARENTHESIS Statement)))
- (IterationExpression
- ((WHILE OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)
- [HIGHER_THAN_FALSE])
- ((WHILE OPEN_PARENTHESIS FALSE CLOSE_PARENTHESIS Statement))
- ((WHILE OPEN_PARENTHESIS LeftHandSideExpression AssignmentOperator AssignmentExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS OptionalExpression SEMICOLON OptionalExpression SEMICOLON OptionalExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS VAR VariableDeclarationList SEMICOLON OptionalExpression SEMICOLON OptionalExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS LeftHandSideExpression IN Expression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS VAR VARIABLE OptionalInitializer IN Expression CLOSE_PARENTHESIS Statement)))
- (ContinueStatement
- ((CONTINUE SEMICOLON)))
- (BreakStatement
- ((BREAK SEMICOLON)))
- (ReturnStatement
- ((RETURN Expression SEMICOLON))
- ((RETURN SEMICOLON)))
- (WithStatement
- ((WITH OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)))
- (OptionalInitializer
- ((Initializer))
- (nil))
- (PrimaryExpression
- ((THIS))
- ((VARIABLE))
- ((NUMBER))
- ((STRING))
- ((NULL_TOKEN))
- ((TRUE))
- ((FALSE))
- ((OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS)))
- (MemberExpression
- ((PrimaryExpression))
- ((MemberExpression OPEN_SQ_BRACKETS Expression CLOSE_SQ_BRACKETS))
- ((MemberExpression DOT VARIABLE))
- ((NEW MemberExpression Arguments)))
- (NewExpression
- ((MemberExpression))
- ((NEW NewExpression)))
- (CallExpression
- ((MemberExpression Arguments))
- ((CallExpression Arguments))
- ((CallExpression OPEN_SQ_BRACKETS Expression CLOSE_SQ_BRACKETS))
- ((CallExpression DOT VARIABLE)))
- (Arguments
- ((OPEN_PARENTHESIS CLOSE_PARENTHESIS))
- ((OPEN_PARENTHESIS ArgumentList CLOSE_PARENTHESIS)))
- (ArgumentList
- ((AssignmentExpression))
- ((ArgumentList COMMA AssignmentExpression)))
- (LeftHandSideExpression
- ((NewExpression))
- ((CallExpression)))
- (PostfixExpression
- ((LeftHandSideExpression))
- ((LeftHandSideExpression INCREMENT))
- ((LeftHandSideExpression DECREMENT)))
- (UnaryExpression
- ((PostfixExpression))
- ((DELETE UnaryExpression))
- ((VOID_SYMBOL UnaryExpression))
- ((TYPEOF UnaryExpression))
- ((INCREMENT UnaryExpression))
- ((DECREMENT UnaryExpression))
- ((PLUS UnaryExpression))
- ((MINUS UnaryExpression))
- ((ONES_COMPLIMENT UnaryExpression))
- ((LOGICAL_NOT UnaryExpression)))
- (MultiplicativeExpression
- ((UnaryExpression))
- ((MultiplicativeExpression MULTIPLY UnaryExpression))
- ((MultiplicativeExpression DIV UnaryExpression))
- ((MultiplicativeExpression MOD UnaryExpression)))
- (AdditiveExpression
- ((MultiplicativeExpression))
- ((AdditiveExpression PLUS MultiplicativeExpression))
- ((AdditiveExpression MINUS MultiplicativeExpression)))
- (ShiftExpression
- ((AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_LEFT AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_RIGHT AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_RIGHT_ZERO_FILL AdditiveExpression)))
- (RelationalExpression
- ((ShiftExpression))
- ((RelationalExpression LESS_THAN ShiftExpression))
- ((RelationalExpression GREATER_THAN ShiftExpression))
- ((RelationalExpression LS_EQUAL ShiftExpression))
- ((RelationalExpression GT_EQUAL ShiftExpression)))
- (EqualityExpression
- ((RelationalExpression))
- ((EqualityExpression EQUALS RelationalExpression))
- ((EqualityExpression NOT_EQUAL RelationalExpression)))
- (BitwiseANDExpression
- ((EqualityExpression))
- ((BitwiseANDExpression BITWISE_AND EqualityExpression)))
- (BitwiseXORExpression
- ((BitwiseANDExpression))
- ((BitwiseXORExpression BITWISE_EXCLUSIVE_OR BitwiseANDExpression)))
- (BitwiseORExpression
- ((BitwiseXORExpression))
- ((BitwiseORExpression BITWISE_OR BitwiseXORExpression)))
- (LogicalANDExpression
- ((BitwiseORExpression))
- ((LogicalANDExpression LOGICAL_AND BitwiseORExpression)))
- (LogicalORExpression
- ((LogicalANDExpression))
- ((LogicalORExpression LOGICAL_OR LogicalANDExpression)))
- (ConditionalExpression
- ((LogicalORExpression))
- ((LogicalORExpression QUERY AssignmentExpression COLON AssignmentExpression)))
- (AssignmentExpression
- ((ConditionalExpression))
- ((LeftHandSideExpression AssignmentOperator AssignmentExpression)
- [LOWER_THAN_CLOSE_PARENTHESIS]))
- (AssignmentOperator
- ((ASSIGN_SYMBOL))
- ((MULTIPLY_EQUALS))
- ((DIV_EQUALS))
- ((MOD_EQUALS))
- ((PLUS_EQUALS))
- ((MINUS_EQUALS))
- ((BITWISE_SHIFT_LEFT_EQUALS))
- ((BITWISE_SHIFT_RIGHT_EQUALS))
- ((BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS))
- ((BITWISE_AND_EQUALS))
- ((BITWISE_EXCLUSIVE_OR_EQUALS))
- ((BITWISE_OR_EQUALS)))
- (Expression
- ((AssignmentExpression))
- ((Expression COMMA AssignmentExpression)))
- (OptionalExpression
- ((Expression))
- (nil)))
- '(Program FormalParameterList)))
- "Parser table.")
-
-(defun wisent-javascript-jv-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-javascript-jv-wy--parse-table
- semantic-debug-parser-source "js.wy"
- semantic-flex-keywords-obarray wisent-javascript-jv-wy--keyword-table
- semantic-lex-types-obarray wisent-javascript-jv-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" OPEN_PARENTHESIS PAREN_BLOCK)
- ("{" START_BLOCK BRACE_BLOCK)
- ("[" OPEN_SQ_BRACKETS BRACK_BLOCK))
- (")" CLOSE_PARENTHESIS)
- ("}" END_BLOCK)
- ("]" CLOSE_SQ_BRACKETS))
- )
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'VARIABLE)
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER)
-
-(define-lex-string-type-analyzer wisent-javascript-jv-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((ONES_COMPLIMENT . "~")
- (SEMICOLON . ";")
- (LINE_TERMINATOR . "\n")
- (LESS_THAN . "<")
- (DOT . ".")
- (COMMA . ",")
- (COLON . ":")
- (DIV . "/")
- (DECREMENT . "--")
- (INCREMENT . "++")
- (PLUS_EQUALS . "+=")
- (PLUS . "+")
- (MULTIPLY_EQUALS . "*=")
- (MULTIPLY . "*")
- (MOD_EQUALS . "%=")
- (MOD . "%")
- (MINUS_EQUALS . "-=")
- (MINUS . "-")
- (LS_EQUAL . "<=")
- (LOGICAL_NOT . "!!")
- (LOGICAL_OR . "||")
- (LOGICAL_AND . "&&")
- (GT_EQUAL . ">=")
- (GREATER_THAN . ">")
- (EQUALS . "==")
- (DIV_EQUALS . "/=")
- (NOT_EQUAL . "!=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS . ">>>=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL . ">>>")
- (BITWISE_SHIFT_RIGHT_EQUALS . ">>=")
- (BITWISE_SHIFT_RIGHT . ">>")
- (BITWISE_SHIFT_LEFT_EQUALS . "<<=")
- (BITWISE_SHIFT_LEFT . "<<")
- (BITWISE_OR_EQUALS . "|=")
- (BITWISE_OR . "|")
- (BITWISE_EXCLUSIVE_OR_EQUALS . "^=")
- (BITWISE_EXCLUSIVE_OR . "^")
- (BITWISE_AND_EQUALS . "&=")
- (BITWISE_AND . "&")
- (ASSIGN_SYMBOL . "="))
- 'punctuation)
-
-(define-lex-sexp-type-analyzer wisent-javascript-jv-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING)
-
-(define-lex-keyword-type-analyzer wisent-javascript-jv-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-;;here something like:
-;;(define-lex wisent-java-tags-lexer
-;; should go
-(define-lex javascript-lexer-jv
-"javascript thingy"
-;;std stuff
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
-
- ;;stuff generated from the wy file(one for each "type" declaration)
- wisent-javascript-jv-wy--<number>-regexp-analyzer
- wisent-javascript-jv-wy--<string>-sexp-analyzer
-
- wisent-javascript-jv-wy--<keyword>-keyword-analyzer
-
- wisent-javascript-jv-wy--<symbol>-regexp-analyzer
- wisent-javascript-jv-wy--<punctuation>-string-analyzer
- wisent-javascript-jv-wy--<block>-block-analyzer
-
-
- ;;;;more std stuff
- semantic-lex-default-action
- )
-
-(provide 'semantic/wisent/js-wy)
-
-;;; semantic/wisent/js-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/python-wy.el b/lisp/cedet/semantic/wisent/python-wy.el
deleted file mode 100644
index bfa96ff1a88..00000000000
--- a/lisp/cedet/semantic/wisent/python-wy.el
+++ /dev/null
@@ -1,847 +0,0 @@
-;;; semantic/wisent/python-wy.el --- Generated parser support file
-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
-;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Python Software Foundation; All Rights Reserved
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/python.wy.
-;; It is derived in part from the Python grammar, used under the
-;; following license:
-;;
-;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
-;; --------------------------------------------
-;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
-;; ("PSF"), and the Individual or Organization ("Licensee") accessing
-;; and otherwise using this software ("Python") in source or binary
-;; form and its associated documentation.
-;;
-;; 2. Subject to the terms and conditions of this License Agreement,
-;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
-;; license to reproduce, analyze, test, perform and/or display
-;; publicly, prepare derivative works, distribute, and otherwise use
-;; Python alone or in any derivative version, provided, however, that
-;; PSF's License Agreement and PSF's notice of copyright, i.e.,
-;; "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Python Software Foundation; All Rights Reserved" are
-;; retained in Python alone or in any derivative version prepared by
-;; Licensee.
-;;
-;; 3. In the event Licensee prepares a derivative work that is based
-;; on or incorporates Python or any part thereof, and wants to make
-;; the derivative work available to others as provided herein, then
-;; Licensee hereby agrees to include in any such work a brief summary
-;; of the changes made to Python.
-;;
-;; 4. PSF is making Python available to Licensee on an "AS IS"
-;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
-;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
-;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
-;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
-;; INFRINGE ANY THIRD PARTY RIGHTS.
-;;
-;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
-;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
-;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
-;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
-;;
-;; 6. This License Agreement will automatically terminate upon a
-;; material breach of its terms and conditions.
-;;
-;; 7. Nothing in this License Agreement shall be deemed to create any
-;; relationship of agency, partnership, or joint venture between PSF
-;; and Licensee. This License Agreement does not grant permission to
-;; use PSF trademarks or trade name in a trademark sense to endorse or
-;; promote products or services of Licensee, or any third party.
-;;
-;; 8. By copying, installing or otherwise using Python, Licensee
-;; agrees to be bound by the terms and conditions of this License
-;; Agreement.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function wisent-python-reconstitute-function-tag
- "semantic/wisent/python" (tag suite))
-(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python"
- (tag))
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-python-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("and" . AND)
- ("as" . AS)
- ("assert" . ASSERT)
- ("break" . BREAK)
- ("class" . CLASS)
- ("continue" . CONTINUE)
- ("def" . DEF)
- ("del" . DEL)
- ("elif" . ELIF)
- ("else" . ELSE)
- ("except" . EXCEPT)
- ("exec" . EXEC)
- ("finally" . FINALLY)
- ("for" . FOR)
- ("from" . FROM)
- ("global" . GLOBAL)
- ("if" . IF)
- ("import" . IMPORT)
- ("in" . IN)
- ("is" . IS)
- ("lambda" . LAMBDA)
- ("not" . NOT)
- ("or" . OR)
- ("pass" . PASS)
- ("print" . PRINT)
- ("raise" . RAISE)
- ("return" . RETURN)
- ("try" . TRY)
- ("while" . WHILE)
- ("with" . WITH)
- ("yield" . YIELD))
- '(("yield" summary "Create a generator function")
- ("with" summary "Start statement with an associated context object")
- ("while" summary "Start a 'while' loop")
- ("try" summary "Start of statements protected by exception handlers")
- ("return" summary "Return from a function")
- ("raise" summary "Raise an exception")
- ("print" summary "Print each argument to standard output")
- ("pass" summary "Statement that does nothing")
- ("or" summary "Binary logical 'or' operator")
- ("not" summary "Unary boolean negation operator")
- ("lambda" summary "Create anonymous function")
- ("is" summary "Binary operator that tests for object equality")
- ("in" summary "Part of 'for' statement ")
- ("import" summary "Load specified modules")
- ("if" summary "Start 'if' conditional statement")
- ("global" summary "Declare one or more symbols as global symbols")
- ("from" summary "Modify behavior of 'import' statement")
- ("for" summary "Start a 'for' loop")
- ("finally" summary "Specify code to be executed after 'try' statements whether or not an exception occurred")
- ("exec" summary "Dynamically execute Python code")
- ("except" summary "Specify exception handlers along with 'try' keyword")
- ("else" summary "Start the 'else' clause following an 'if' statement")
- ("elif" summary "Shorthand for 'else if' following an 'if' statement")
- ("del" summary "Delete specified objects, i.e., undo what assignment did")
- ("def" summary "Define a new function")
- ("continue" summary "Skip to the next iteration of enclosing 'for' or 'while' loop")
- ("class" summary "Define a new class")
- ("break" summary "Terminate 'for' or 'while' loop")
- ("assert" summary "Raise AssertionError exception if <expr> is false")
- ("as" summary "EXPR as NAME makes value of EXPR available as variable NAME")
- ("and" summary "Logical AND binary operator ... ")))
- "Table of language keywords.")
-
-(defconst wisent-python-wy--token-table
- (semantic-lex-make-type-table
- '(("symbol"
- (NAME))
- ("number"
- (NUMBER_LITERAL))
- ("string"
- (STRING_LITERAL))
- ("punctuation"
- (AT . "@")
- (BACKQUOTE . "`")
- (ASSIGN . "=")
- (COMMA . ",")
- (SEMICOLON . ";")
- (COLON . ":")
- (BAR . "|")
- (TILDE . "~")
- (PERIOD . ".")
- (MINUS . "-")
- (PLUS . "+")
- (MOD . "%")
- (DIV . "/")
- (MULT . "*")
- (AMP . "&")
- (GT . ">")
- (LT . "<")
- (HAT . "^")
- (NE . "!=")
- (LTGT . "<>")
- (HATEQ . "^=")
- (OREQ . "|=")
- (AMPEQ . "&=")
- (MODEQ . "%=")
- (DIVEQ . "/=")
- (MULTEQ . "*=")
- (MINUSEQ . "-=")
- (PLUSEQ . "+=")
- (LE . "<=")
- (GE . ">=")
- (EQ . "==")
- (EXPONENT . "**")
- (GTGT . ">>")
- (LTLT . "<<")
- (DIVDIV . "//")
- (DIVDIVEQ . "//=")
- (EXPEQ . "**=")
- (GTGTEQ . ">>=")
- (LTLTEQ . "<<="))
- ("close-paren"
- (RBRACK . "]")
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACK . "[")
- (LBRACE . "{")
- (LPAREN . "("))
- ("block"
- (BRACK_BLOCK . "(LBRACK RBRACK)")
- (BRACE_BLOCK . "(LBRACE RBRACE)")
- (PAREN_BLOCK . "(LPAREN RPAREN)"))
- ("indentation"
- (INDENT_BLOCK . "(INDENT DEDENT)")
- (DEDENT . "[^:INDENT:]")
- (INDENT . "^\\s-+"))
- ("newline"
- (NEWLINE . "\n"))
- ("charquote"
- (BACKSLASH . "\\")))
- '(("keyword" :declared t)
- ("symbol" :declared t)
- ("number" :declared t)
- ("punctuation" :declared t)
- ("block" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-python-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE AT STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE WITH YIELD)
- nil
- (goal
- ((NEWLINE))
- ((simple_stmt))
- ((compound_stmt)))
- (simple_stmt
- ((small_stmt_list semicolon_opt NEWLINE)))
- (small_stmt_list
- ((small_stmt))
- ((small_stmt_list SEMICOLON small_stmt)))
- (small_stmt
- ((expr_stmt))
- ((print_stmt))
- ((del_stmt))
- ((pass_stmt))
- ((flow_stmt))
- ((import_stmt))
- ((global_stmt))
- ((exec_stmt))
- ((assert_stmt)))
- (print_stmt
- ((PRINT print_stmt_trailer)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (print_stmt_trailer
- ((test_list_opt)
- nil)
- ((GTGT test trailing_test_list_with_opt_comma_opt)
- nil))
- (trailing_test_list_with_opt_comma_opt
- (nil)
- ((trailing_test_list comma_opt)
- nil))
- (trailing_test_list
- ((COMMA test)
- nil)
- ((trailing_test_list COMMA test)
- nil))
- (expr_stmt
- ((testlist expr_stmt_trailer)
- (if
- (and $2
- (stringp $1)
- (string-match "^\\(\\sw\\|\\s_\\)+$" $1))
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))))
- (expr_stmt_trailer
- ((augassign testlist))
- ((eq_testlist_zom)))
- (eq_testlist_zom
- (nil)
- ((eq_testlist_zom ASSIGN testlist)
- (identity $3)))
- (augassign
- ((PLUSEQ))
- ((MINUSEQ))
- ((MULTEQ))
- ((DIVEQ))
- ((MODEQ))
- ((AMPEQ))
- ((OREQ))
- ((HATEQ))
- ((LTLTEQ))
- ((GTGTEQ))
- ((EXPEQ))
- ((DIVDIVEQ)))
- (del_stmt
- ((DEL exprlist)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (exprlist
- ((expr_list comma_opt)
- nil))
- (expr_list
- ((expr)
- nil)
- ((expr_list COMMA expr)
- nil))
- (pass_stmt
- ((PASS)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (flow_stmt
- ((break_stmt))
- ((continue_stmt))
- ((return_stmt))
- ((raise_stmt))
- ((yield_stmt)))
- (break_stmt
- ((BREAK)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (continue_stmt
- ((CONTINUE)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (return_stmt
- ((RETURN testlist_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (testlist_opt
- (nil)
- ((testlist)
- nil))
- (yield_stmt
- ((YIELD)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((YIELD testlist)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (raise_stmt
- ((RAISE zero_one_two_or_three_tests)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (zero_one_two_or_three_tests
- (nil)
- ((test zero_one_or_two_tests)
- nil))
- (zero_one_or_two_tests
- (nil)
- ((COMMA test zero_or_one_comma_test)
- nil))
- (zero_or_one_comma_test
- (nil)
- ((COMMA test)
- nil))
- (import_stmt
- ((IMPORT dotted_as_name_list)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil)))
- ((FROM dotted_name IMPORT star_or_import_as_name_list)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil))))
- (dotted_as_name_list
- ((dotted_as_name_list COMMA dotted_as_name)
- (cons $3 $1))
- ((dotted_as_name)
- (list $1)))
- (star_or_import_as_name_list
- ((MULT)
- nil)
- ((import_as_name_list)
- nil))
- (import_as_name_list
- ((import_as_name)
- nil)
- ((import_as_name_list COMMA import_as_name)
- nil))
- (import_as_name
- ((NAME as_name_opt)
- nil))
- (dotted_as_name
- ((dotted_name as_name_opt)))
- (as_name_opt
- (nil)
- ((AS NAME)
- (identity $2)))
- (dotted_name
- ((NAME))
- ((dotted_name PERIOD NAME)
- (format "%s.%s" $1 $3)))
- (global_stmt
- ((GLOBAL comma_sep_name_list)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (comma_sep_name_list
- ((NAME))
- ((comma_sep_name_list COMMA NAME)))
- (exec_stmt
- ((EXEC expr exec_trailer)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (exec_trailer
- (nil)
- ((IN test comma_test_opt)
- nil))
- (comma_test_opt
- (nil)
- ((COMMA test)
- nil))
- (assert_stmt
- ((ASSERT test comma_test_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (compound_stmt
- ((if_stmt))
- ((while_stmt))
- ((for_stmt))
- ((try_stmt))
- ((with_stmt))
- ((funcdef))
- ((class_declaration)))
- (if_stmt
- ((IF test COLON suite elif_suite_pair_list else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (elif_suite_pair_list
- (nil)
- ((elif_suite_pair_list ELIF test COLON suite)
- nil))
- (else_suite_pair_opt
- (nil)
- ((ELSE COLON suite)
- nil))
- (suite
- ((simple_stmt)
- (list $1))
- ((NEWLINE indented_block)
- (progn $2)))
- (indented_block
- ((INDENT_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'indented_block_body 1)))
- (indented_block_body
- ((INDENT)
- nil)
- ((DEDENT)
- nil)
- ((simple_stmt))
- ((compound_stmt)))
- (while_stmt
- ((WHILE test COLON suite else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (for_stmt
- ((FOR exprlist IN testlist COLON suite else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (try_stmt
- ((TRY COLON suite except_clause_suite_pair_list else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((TRY COLON suite FINALLY COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (except_clause_suite_pair_list
- ((except_clause COLON suite)
- nil)
- ((except_clause_suite_pair_list except_clause COLON suite)
- nil))
- (except_clause
- ((EXCEPT zero_one_or_two_test)
- nil))
- (zero_one_or_two_test
- (nil)
- ((test zero_or_one_comma_test)
- nil))
- (with_stmt
- ((WITH test COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((WITH test with_var COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (with_var
- ((AS expr)
- nil))
- (decorator
- ((AT dotted_name varargslist_opt NEWLINE)
- (wisent-raw-tag
- (semantic-tag-new-function $2 "decorator" $3))))
- (decorators
- ((decorator)
- (list $1))
- ((decorator decorators)
- (cons $1 $2)))
- (funcdef
- ((DEF NAME function_parameter_list COLON suite)
- (wisent-python-reconstitute-function-tag
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3))
- $5))
- ((decorators DEF NAME function_parameter_list COLON suite)
- (wisent-python-reconstitute-function-tag
- (wisent-raw-tag
- (semantic-tag-new-function $3 nil $4 :decorators $1))
- $6)))
- (function_parameter_list
- ((PAREN_BLOCK)
- (let
- ((wisent-python-EXPANDING-block t))
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'function_parameters 1))))
- (function_parameters
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((function_parameter COMMA))
- ((function_parameter RPAREN)))
- (function_parameter
- ((fpdef_opt_test))
- ((MULT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil)))
- ((EXPONENT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil))))
- (class_declaration
- ((CLASS NAME paren_class_list_opt COLON suite)
- (wisent-python-reconstitute-class-tag
- (wisent-raw-tag
- (semantic-tag-new-type $2 $1 $5
- (cons $3 nil))))))
- (paren_class_list_opt
- (nil)
- ((paren_class_list)))
- (paren_class_list
- ((PAREN_BLOCK)
- (let
- ((wisent-python-EXPANDING-block t))
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'paren_classes 1)))))
- (paren_classes
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((paren_class COMMA)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil)))
- ((paren_class RPAREN)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))))
- (paren_class
- ((dotted_name)))
- (test
- ((test_test))
- ((lambdef)))
- (test_test
- ((and_test))
- ((test_test OR and_test)
- nil))
- (and_test
- ((not_test))
- ((and_test AND not_test)
- nil))
- (not_test
- ((NOT not_test)
- nil)
- ((comparison)))
- (comparison
- ((expr))
- ((comparison comp_op expr)
- nil))
- (comp_op
- ((LT))
- ((GT))
- ((EQ))
- ((GE))
- ((LE))
- ((LTGT))
- ((NE))
- ((IN))
- ((NOT IN))
- ((IS))
- ((IS NOT)))
- (expr
- ((xor_expr))
- ((expr BAR xor_expr)
- nil))
- (xor_expr
- ((and_expr))
- ((xor_expr HAT and_expr)
- nil))
- (and_expr
- ((shift_expr))
- ((and_expr AMP shift_expr)
- nil))
- (shift_expr
- ((arith_expr))
- ((shift_expr shift_expr_operators arith_expr)
- nil))
- (shift_expr_operators
- ((LTLT))
- ((GTGT)))
- (arith_expr
- ((term))
- ((arith_expr plus_or_minus term)
- nil))
- (plus_or_minus
- ((PLUS))
- ((MINUS)))
- (term
- ((factor))
- ((term term_operator factor)
- nil))
- (term_operator
- ((MULT))
- ((DIV))
- ((MOD))
- ((DIVDIV)))
- (factor
- ((prefix_operators factor)
- nil)
- ((power)))
- (prefix_operators
- ((PLUS))
- ((MINUS))
- ((TILDE)))
- (power
- ((atom trailer_zom exponent_zom)
- (concat $1
- (if $2
- (concat " " $2 " ")
- "")
- (if $3
- (concat " " $3)
- ""))))
- (trailer_zom
- (nil)
- ((trailer_zom trailer)
- nil))
- (exponent_zom
- (nil)
- ((exponent_zom EXPONENT factor)
- nil))
- (trailer
- ((PAREN_BLOCK)
- nil)
- ((BRACK_BLOCK)
- nil)
- ((PERIOD NAME)
- nil))
- (atom
- ((PAREN_BLOCK)
- nil)
- ((BRACK_BLOCK)
- nil)
- ((BRACE_BLOCK)
- nil)
- ((BACKQUOTE testlist BACKQUOTE)
- nil)
- ((NAME))
- ((NUMBER_LITERAL))
- ((one_or_more_string)))
- (test_list_opt
- (nil)
- ((testlist)
- nil))
- (testlist
- ((comma_sep_test_list comma_opt)))
- (comma_sep_test_list
- ((test))
- ((comma_sep_test_list COMMA test)
- (format "%s, %s" $1 $3)))
- (one_or_more_string
- ((STRING_LITERAL))
- ((one_or_more_string STRING_LITERAL)
- (concat $1 $2)))
- (lambdef
- ((LAMBDA varargslist_opt COLON test)
- (format "%s %s" $1
- (or $2 ""))))
- (varargslist_opt
- (nil)
- ((varargslist)))
- (varargslist
- ((fpdef_opt_test_list_comma_zom rest_args)
- (nconc $2 $1))
- ((fpdef_opt_test_list comma_opt)))
- (rest_args
- ((MULT NAME multmult_name_opt)
- nil)
- ((EXPONENT NAME)
- nil))
- (multmult_name_opt
- (nil)
- ((COMMA EXPONENT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 nil nil))))
- (fpdef_opt_test_list_comma_zom
- (nil)
- ((fpdef_opt_test_list_comma_zom fpdef_opt_test COMMA)
- (nconc $2 $1)))
- (fpdef_opt_test_list
- ((fpdef_opt_test))
- ((fpdef_opt_test_list COMMA fpdef_opt_test)
- (nconc $3 $1)))
- (fpdef_opt_test
- ((fpdef eq_test_opt)))
- (fpdef
- ((NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))))
- (fplist
- ((fpdef_list comma_opt)))
- (fpdef_list
- ((fpdef))
- ((fpdef_list COMMA fpdef)))
- (eq_test_opt
- (nil)
- ((ASSIGN test)
- nil))
- (comma_opt
- (nil)
- ((COMMA)))
- (semicolon_opt
- (nil)
- ((SEMICOLON))))
- '(goal function_parameter paren_class indented_block function_parameters paren_classes indented_block_body)))
- "Parser table.")
-
-(defun wisent-python-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-python-wy--parse-table
- semantic-debug-parser-source "python.wy"
- semantic-flex-keywords-obarray wisent-python-wy--keyword-table
- semantic-lex-types-obarray wisent-python-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-python-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" LPAREN PAREN_BLOCK)
- ("{" LBRACE BRACE_BLOCK)
- ("[" LBRACK BRACK_BLOCK))
- (")" RPAREN)
- ("}" RBRACE)
- ("]" RBRACK))
- )
-
-(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'NAME)
-
-(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER_LITERAL)
-
-(define-lex-string-type-analyzer wisent-python-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((AT . "@")
- (BACKQUOTE . "`")
- (ASSIGN . "=")
- (COMMA . ",")
- (SEMICOLON . ";")
- (COLON . ":")
- (BAR . "|")
- (TILDE . "~")
- (PERIOD . ".")
- (MINUS . "-")
- (PLUS . "+")
- (MOD . "%")
- (DIV . "/")
- (MULT . "*")
- (AMP . "&")
- (GT . ">")
- (LT . "<")
- (HAT . "^")
- (NE . "!=")
- (LTGT . "<>")
- (HATEQ . "^=")
- (OREQ . "|=")
- (AMPEQ . "&=")
- (MODEQ . "%=")
- (DIVEQ . "/=")
- (MULTEQ . "*=")
- (MINUSEQ . "-=")
- (PLUSEQ . "+=")
- (LE . "<=")
- (GE . ">=")
- (EQ . "==")
- (EXPONENT . "**")
- (GTGT . ">>")
- (LTLT . "<<")
- (DIVDIV . "//")
- (DIVDIVEQ . "//=")
- (EXPEQ . "**=")
- (GTGTEQ . ">>=")
- (LTLTEQ . "<<="))
- 'punctuation)
-
-(define-lex-keyword-type-analyzer wisent-python-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-
-(provide 'semantic/wisent/python-wy)
-
-;;; semantic/wisent/python-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 2c0ed5868ce..2dc3dd3c2ad 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,6 +1,6 @@
;;; wisent-python.el --- Semantic support for Python
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Richard Kim <emacs18@gmail.com>
;; Maintainer: Richard Kim <emacs18@gmail.com>
@@ -130,7 +130,7 @@ curly braces."
(defun wisent-python-forward-balanced-expression ()
"Move point to the end of the balanced expression at point.
-Here 'balanced expression' means anything matched by Emacs'
+Here “balanced expression” means anything matched by Emacs's
open/close parenthesis syntax classes. We can't use forward-sexp
for this because that Emacs built-in can't parse Python's
triple-quoted string syntax."
@@ -490,7 +490,7 @@ Return nil if there is nothing relevant."
;;
(define-mode-local-override semantic-format-tag-abbreviate python-mode (tag &optional parent color)
"Format an abbreviated tag for python.
-Shortens 'code' tags, but passes through for others."
+Shortens `code' tags, but passes through for others."
(cond ((semantic-tag-of-class-p tag 'code)
;; Just take the first line.
(let ((name (semantic-tag-name tag)))
@@ -534,9 +534,6 @@ Shortens 'code' tags, but passes through for others."
(code . "Code")))
)
-;;;###autoload
-(add-hook 'python-mode-hook 'wisent-python-default-setup)
-
;; Make sure the newer python modes pull in the same python
;; mode overrides.
(define-child-mode python-2-mode python-mode "Python 2 mode")
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index 8a3318cd00f..4c5274198dd 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
-;;; Copyright (C) 2002-2007, 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2007, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -44,11 +44,11 @@
"
/\\_.-^^^-._/\\ The GNU
\\_ _/
- ( `o ` (European ;-) Bison
- \\ ` /
+ ( \\=`o \\=` (European ;-) Bison
+ \\ \\=` /
( D ,\" for Emacs!
- ` ~ ,\"
- `\"\""
+ \\=` ~ ,\"
+ \\=`\"\""
:group 'semantic)
@@ -364,7 +364,7 @@ automaton has only one entry point."
- START specify the start symbol (nonterminal) used by the parser as
its goal. It defaults to the start symbol defined in the grammar
- \(see also `wisent-compile-grammar')."
+ (see also `wisent-compile-grammar')."
(run-hooks 'wisent-pre-parse-hook)
(let* ((actions (aref automaton 0))
(gotos (aref automaton 1))
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index 2e2cb8a3f80..c4f2c674af5 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,6 +1,6 @@
;;; srecode.el --- Semantic buffer evaluator.
-;;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el
index 6bc78295fa7..2cb2396092a 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -1,6 +1,6 @@
;;; srecode/args.el --- Provide some simple template arguments
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -101,35 +101,35 @@ do not contain any text from preceding or following text."
(defun srecode-semantic-handle-:time (dict)
"Add macros into the dictionary DICT based on the current :time."
;; DATE Values
- (srecode-dictionary-set-value
- dict "YEAR" (format-time-string "%Y" (current-time)))
- (srecode-dictionary-set-value
- dict "MONTHNAME" (format-time-string "%B" (current-time)))
- (srecode-dictionary-set-value
- dict "MONTH" (format-time-string "%m" (current-time)))
- (srecode-dictionary-set-value
- dict "DAY" (format-time-string "%d" (current-time)))
- (srecode-dictionary-set-value
- dict "WEEKDAY" (format-time-string "%a" (current-time)))
- ;; Time Values
- (srecode-dictionary-set-value
- dict "HOUR" (format-time-string "%H" (current-time)))
- (srecode-dictionary-set-value
- dict "HOUR12" (format-time-string "%l" (current-time)))
- (srecode-dictionary-set-value
- dict "AMPM" (format-time-string "%p" (current-time)))
- (srecode-dictionary-set-value
- dict "MINUTE" (format-time-string "%M" (current-time)))
- (srecode-dictionary-set-value
- dict "SECOND" (format-time-string "%S" (current-time)))
- (srecode-dictionary-set-value
- dict "TIMEZONE" (format-time-string "%Z" (current-time)))
- ;; Convenience pre-packed date/time
- (srecode-dictionary-set-value
- dict "DATE" (format-time-string "%D" (current-time)))
- (srecode-dictionary-set-value
- dict "TIME" (format-time-string "%X" (current-time)))
- )
+ (let ((now (current-time)))
+ (srecode-dictionary-set-value
+ dict "YEAR" (format-time-string "%Y" now))
+ (srecode-dictionary-set-value
+ dict "MONTHNAME" (format-time-string "%B" now))
+ (srecode-dictionary-set-value
+ dict "MONTH" (format-time-string "%m" now))
+ (srecode-dictionary-set-value
+ dict "DAY" (format-time-string "%d" now))
+ (srecode-dictionary-set-value
+ dict "WEEKDAY" (format-time-string "%a" now))
+ ;; Time Values
+ (srecode-dictionary-set-value
+ dict "HOUR" (format-time-string "%H" now))
+ (srecode-dictionary-set-value
+ dict "HOUR12" (format-time-string "%l" now))
+ (srecode-dictionary-set-value
+ dict "AMPM" (format-time-string "%p" now))
+ (srecode-dictionary-set-value
+ dict "MINUTE" (format-time-string "%M" now))
+ (srecode-dictionary-set-value
+ dict "SECOND" (format-time-string "%S" now))
+ (srecode-dictionary-set-value
+ dict "TIMEZONE" (format-time-string "%Z" now))
+ ;; Convenience pre-packed date/time
+ (srecode-dictionary-set-value
+ dict "DATE" (format-time-string "%D" now))
+ (srecode-dictionary-set-value
+ dict "TIME" (format-time-string "%X" now))))
;;; :file ARGUMENT HANDLING
;;
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 542fd49f8e5..c6b3b53f24d 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,6 +1,6 @@
;;; srecode/compile --- Compilation of srecode template files.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
@@ -34,6 +34,7 @@
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'srecode/table)
(require 'srecode/dictionary)
@@ -74,7 +75,7 @@ any incoming dictionaries values.")
:initform nil
:documentation
"During template insertion, this is the stack of active templates.
-The top-most template is the 'active' template. Use the accessor methods
+The top-most template is the `active' template. Use the accessor methods
for push, pop, and peek for the active template.")
(table :initarg :table
:documentation
@@ -87,10 +88,10 @@ for push, pop, and peek for the active template.")
Useful if something goes wrong in SRecode, and the active template
stack is broken."
(interactive)
- (if (oref srecode-template active)
+ (if (oref-default 'srecode-template active)
(when (y-or-n-p (format "%d active templates. Flush? "
- (length (oref srecode-template active))))
- (oset-default srecode-template active nil))
+ (length (oref-default 'srecode-template active))))
+ (oset-default 'srecode-template active nil))
(message "No active templates to flush."))
)
@@ -115,23 +116,23 @@ additional static argument data."))
Plain text strings are not handled via this baseclass."
:abstract t)
-(defmethod srecode-parse-input ((ins srecode-template-inserter)
- tag input STATE)
+(cl-defmethod srecode-parse-input ((_ins srecode-template-inserter)
+ _tag input _STATE)
"For the template inserter INS, parse INPUT.
Shorten input only by the amount needed.
Return the remains of INPUT.
STATE is the current compilation state."
input)
-(defmethod srecode-match-end ((ins srecode-template-inserter) name)
+(cl-defmethod srecode-match-end ((_ins srecode-template-inserter) _name)
"For the template inserter INS, do I end a section called NAME?"
nil)
-(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE)
+(cl-defmethod srecode-inserter-apply-state ((_ins srecode-template-inserter) _STATE)
"For the template inserter INS, apply information from STATE."
nil)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -158,7 +159,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
"Current state of the compile.")
-(defmethod srecode-compile-add-prompt ((state srecode-compile-state)
+(cl-defmethod srecode-compile-add-prompt ((state srecode-compile-state)
prompttag)
"Add PROMPTTAG to the current list of prompts."
(with-slots (prompts) state
@@ -289,7 +290,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
;; Continue
(setq tags (cdr tags)))
-
+
;; MSG - Before install since nreverse whacks our list.
(when (called-interactively-p 'interactive)
(message "%d templates compiled for %s"
@@ -414,7 +415,7 @@ If END-NAME is specified, and the input string"
(match-end 0)))
(namestart (match-end 0))
(junk (string-match regexend what namestart))
- end tail name key)
+ end tail name)
;; Add string to compiled output
(when (> (length prefix) 0)
(setq comp (cons prefix comp)))
@@ -452,8 +453,7 @@ If END-NAME is specified, and the input string"
(semantic-tag-name tag)))
)
;; Add string to compiled output
- (setq name (substring what namestart end)
- key nil)
+ (setq name (substring what namestart end))
;; Trim WHAT back.
(setq what (substring what tail))
;; Get the inserter
@@ -514,7 +514,7 @@ to the inserter constructor."
;;(message "Compile: %s %S" name props)
(if (not key)
(apply 'srecode-template-inserter-variable name props)
- (let ((classes (eieio-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.
@@ -522,7 +522,7 @@ to the inserter constructor."
(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))
+ (equal (oref-default (car classes) key) key))
;; Create the new class, and apply state.
(setq new (apply (car classes) name props))
(srecode-inserter-apply-state new STATE)
@@ -595,7 +595,7 @@ A list of defined variables VARS provides a variable table."
;; Dump out information about the current srecoder compiled templates.
;;
-(defmethod srecode-dump ((tmp srecode-template))
+(cl-defmethod srecode-dump ((tmp srecode-template))
"Dump the contents of the SRecode template tmp."
(princ "== Template \"")
(princ (eieio-object-name-string tmp))
@@ -641,7 +641,7 @@ Argument INDENT specifies the indentation level for the list."
(princ "\n"))))
)
-(defmethod srecode-dump ((ins srecode-template-inserter) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter) _indent)
"Dump the state of the SRecode template inserter INS."
(princ "INS: \"")
(princ (eieio-object-name-string ins))
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index fd500b6d9a3..e77e05c40b9 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -1,6 +1,6 @@
;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder
-;; Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Jan Moringen <scymtym@users.sourceforge.net>
@@ -84,7 +84,7 @@ HEADER - Shown section if in a header file."
;;;###autoload
(defun srecode-semantic-handle-:cpp (dict)
"Add macros into the dictionary DICT based on the current c file.
-Calls `srecode-semantic-handle-:c.
+Calls `srecode-semantic-handle-:c'.
Also adds the following:
- nothing -"
(srecode-semantic-handle-:c dict)
diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 0b15e733364..56433183c2b 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -1,6 +1,6 @@
;;; srecode/ctxt.el --- Derive a context from the source buffer.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index bbc791f09d8..b95d45ebc86 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -1,6 +1,6 @@
;;; srecode/dictionary.el --- Dictionary code for the semantic recoder.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -30,6 +30,7 @@
(eval-when-compile (require 'cl))
(require 'eieio)
+(require 'cl-generic)
(require 'srecode)
(require 'srecode/table)
(eval-when-compile (require 'semantic))
@@ -103,7 +104,7 @@ set NAME \"str\" macro \"OTHERNAME\"
with appending various parts together in a list.")
-(defmethod initialize-instance ((this srecode-dictionary-compound-variable)
+(cl-defmethod initialize-instance ((this srecode-dictionary-compound-variable)
&optional fields)
"Initialize the compound variable THIS.
Makes sure that :value is compiled."
@@ -120,7 +121,7 @@ Makes sure that :value is compiled."
;;(when (not state)
;; (error "Cannot create compound variable outside of sectiondictionary"))
- (call-next-method this (nreverse newfields))
+ (cl-call-next-method this (nreverse newfields))
(when (not (slot-boundp this 'compiled))
(let ((val (oref this :value))
(comp nil))
@@ -194,8 +195,8 @@ associated with a buffer or parent."
initfrombuff t)))
;; Create the new dictionary object.
- (let ((dict (srecode-dictionary
- major-mode
+ (let ((dict (make-instance
+ 'srecode-dictionary
:buffer buffer
:parent parent
:namehash (make-hash-table :test 'equal
@@ -215,7 +216,7 @@ associated with a buffer or parent."
))
dict))))
-(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
tpl)
"Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file."
@@ -235,7 +236,7 @@ TPL is an object representing a compiled template file."
(setq tabs (cdr tabs))))))
-(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value)
"In dictionary DICT, set NAME to have VALUE."
;; Validate inputs
@@ -247,7 +248,7 @@ TPL is an object representing a compiled template file."
(puthash name value namehash))
)
-(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
name &optional show-only force)
"In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.
@@ -299,7 +300,7 @@ inserted dictionaries."
;; Return the new sub-dictionary.
new))
-(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be exposed."
;; Validate inputs
(unless (stringp name)
@@ -310,7 +311,7 @@ inserted dictionaries."
(srecode-dictionary-add-section-dictionary dict name t)
nil)
-(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be hidden."
;; We need to find the has value, and then delete it.
;; Validate inputs
@@ -322,7 +323,7 @@ inserted dictionaries."
(remhash name namehash))
nil)
-(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state)
"Add ENTRIES to DICT.
@@ -373,7 +374,7 @@ values but STATE is nil."
(setq entries (nthcdr 2 entries)))
dict)
-(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
+(cl-defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
&optional force)
"Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are
@@ -405,7 +406,7 @@ OTHERDICT."
(srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash))))
-(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name &optional non-recursive)
"Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the
@@ -416,7 +417,7 @@ searched for NAME if it is not found in DICT. This recursive
lookup can be disabled by the optional argument NON-RECURSIVE.
This function derives values for some special NAMEs, such as
-'FIRST' and 'LAST'."
+`FIRST' and `LAST'."
(if (not (slot-boundp dict 'namehash))
nil
;; Get the value of this name from the dictionary or its parent
@@ -429,7 +430,7 @@ This function derives values for some special NAMEs, such as
(srecode-dictionary-lookup-name parent name)))))
)
-(defmethod srecode-root-dictionary ((dict srecode-dictionary))
+(cl-defmethod srecode-root-dictionary ((dict srecode-dictionary))
"For dictionary DICT, return the root dictionary.
The root dictionary is usually for a current or active insertion."
(let ((ans dict))
@@ -442,7 +443,7 @@ The root dictionary is usually for a current or active insertion."
;; Compound values must provide at least the toString method
;; for use in converting the compound value into something insertable.
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
function
dictionary)
"Convert the compound dictionary value CP to a string.
@@ -456,13 +457,13 @@ the value itself using `princ', or by detecting if the current
standard out is a buffer, and using `insert'."
(eieio-object-name cp))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent)
"Display information about this compound value."
(princ (eieio-object-name cp))
)
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
function
dictionary)
"Convert the compound dictionary variable value CP into a string.
@@ -471,7 +472,7 @@ FUNCTION and DICTIONARY are as for the baseclass."
(srecode-insert-code-stream (oref cp compiled) dictionary))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
&optional indent)
"Display information about this compound value."
(require 'srecode/compile)
@@ -501,7 +502,7 @@ Compound values allow a field to be stored in the dictionary for when
it is referenced a second time. This compound value can then be
inserted with a new editable field.")
-(defmethod srecode-compound-toString((cp srecode-field-value)
+(cl-defmethod srecode-compound-toString((cp srecode-field-value)
function
dictionary)
"Convert this field into an insertable string."
@@ -639,7 +640,7 @@ STATE is the current compiler state."
(srecode-dump dict))
))))
-(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
+(cl-defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
"Dump a dictionary."
(if (not indent) (setq indent 0))
(maphash (lambda (key entry)
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index 902eb6433b9..f0fe498cbba 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -1,6 +1,6 @@
;;; srecode/document.el --- Documentation (comment) generation
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -395,7 +395,7 @@ It is assumed that the comment occurs just in front of FCN-IN."
(beginning-of-line)
(forward-char -1)
- (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex))
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
(doctext
(srecode-document-function-name-comment fcn-in))
)
@@ -655,7 +655,7 @@ If there is only one tag in the region, complain."
"Create documentation for the function defined in TAG.
If we can identify a verb in the list followed by some
name part then check the return value to see if we can use that to
-finish off the sentence. That is, any function with 'alloc' in it will be
+finish off the sentence. That is, any function with `alloc' in it will be
allocating something based on its type."
(let ((al srecode-document-autocomment-return-first-alist)
(dropit nil)
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index cc6ee7298a7..7e91a612638 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -1,6 +1,6 @@
;;; srecode/el.el --- Emacs Lisp specific arguments
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -50,7 +50,7 @@ Adds the following:
(defun srecode-semantic-handle-:el-custom (dict)
"Add macros into the dictionary DICT based on the current Emacs Lisp file.
Adds the following:
- GROUP - The 'defgroup' name we guess you want for variables.
+ GROUP - The `defgroup' name we guess you want for variables.
FACEGROUP - The `defgroup' name you might want for faces."
(require 'semantic/db-find)
(let ((groups (semanticdb-strip-find-results
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index ddc4bebc7ad..205d207edda 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -1,6 +1,6 @@
;;; srecode/expandproto.el --- Expanding prototypes.
-;; Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 8ac379d12f4..027ae0c25dd 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -1,6 +1,6 @@
;;; srecode/extract.el --- Extract content from previously inserted macro.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -55,16 +55,16 @@
)
"The current extraction state.")
-(defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
+(cl-defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
"Set onto the extract state ST a new inserter INS and dictionary DICT."
(oset st lastinserter ins)
(oset st lastdict dict))
-(defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
+(cl-defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
"Reset the anchor point on extract state ST."
(oset st anchor (point)))
-(defmethod srecode-extract-state-extract ((st srecode-extract-state)
+(cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
endpoint)
"Perform an extraction on the extract state ST with ENDPOINT.
If there was no waiting inserter, do nothing."
@@ -94,7 +94,7 @@ the dictionary entries were for that block of text."
(srecode-extract-method template dict state)
dict))))
-(defmethod srecode-extract-method ((st srecode-template) dictionary
+(cl-defmethod srecode-extract-method ((st srecode-template) dictionary
state)
"Extract template ST and store extracted text in DICTIONARY.
Optional STARTRETURN is a symbol in which the start of the first
@@ -139,11 +139,11 @@ Uses STATE to maintain the current extraction state."
;;; Inserter Base Extractors
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
"Return non-nil if this inserter can extract values."
nil)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
start end dict state)
"Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing."
@@ -151,11 +151,11 @@ Return nil as this inserter will extract nothing."
;;; Variable extractor is simple and can extract later.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
"Return non-nil if this inserter can extract values."
'later)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
start end vdict state)
"Extract text from START/END and store in VDICT.
Return t if something was extracted.
@@ -169,11 +169,11 @@ Return nil if this inserter doesn't need to extract anything."
;;; Section Inserter
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
start end indict state)
"Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match.
@@ -203,11 +203,11 @@ Return nil if nothing was extracted."
;;; Include Extractor must extract now.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
start end dict state)
"Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match.
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index ea856f3a394..dd38b65d7bf 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,6 +1,6 @@
;;; srecode/fields.el --- Handling type-in fields in a buffer.
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -39,6 +39,7 @@
;; Keep this library independent of SRecode proper.
(require 'eieio)
+(require 'cl-generic)
;;; Code:
(defvar srecode-field-archive nil
@@ -74,7 +75,7 @@ The overlay will crossreference this object.")
"An object that gets automatically bound to an overlay.
Has virtual :start and :end initializers.")
-(defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
+(cl-defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
"Initialize OLAID, being sure it archived."
;; Extract :start and :end from the olaid list.
(let ((newargs nil)
@@ -107,11 +108,11 @@ Has virtual :start and :end initializers.")
(overlay-put olay 'srecode-init-only t)
(oset olaid overlay olay)
- (call-next-method olaid (nreverse newargs))
+ (cl-call-next-method olaid (nreverse newargs))
))
-(defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
+(cl-defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
"Activate the overlaid area."
(let* ((ola (oref olaid overlay))
(start (overlay-start ola))
@@ -128,23 +129,23 @@ Has virtual :start and :end initializers.")
))
-(defmethod srecode-delete ((olaid srecode-overlaid))
+(cl-defmethod srecode-delete ((olaid srecode-overlaid))
"Delete the overlay from OLAID."
(delete-overlay (oref olaid overlay))
(slot-makeunbound olaid 'overlay)
)
-(defmethod srecode-empty-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-empty-region-p ((olaid srecode-overlaid))
"Return non-nil if the region covered by OLAID is of length 0."
(= 0 (srecode-region-size olaid)))
-(defmethod srecode-region-size ((olaid srecode-overlaid))
+(cl-defmethod srecode-region-size ((olaid srecode-overlaid))
"Return the length of region covered by OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(- end start)))
-(defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
"Return non-nil if point is in the region of OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
@@ -161,7 +162,7 @@ Has virtual :start and :end initializers.")
(setq ol (cdr ol)))
(car (nreverse ret))))
-(defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
+(cl-defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
"Return the text under OLAID.
If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(let* ((ol (oref olaid overlay))
@@ -191,7 +192,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
)
"Manage a buffer region in which fields exist.")
-(defmethod initialize-instance ((ir srecode-template-inserted-region)
+(cl-defmethod initialize-instance ((ir srecode-template-inserted-region)
&rest args)
"Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields
@@ -199,10 +200,10 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(setq srecode-field-archive nil)
;; Initialize myself first.
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
"Activate the template area for IR."
;; Activate all our fields
@@ -210,7 +211,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(srecode-overlaid-activate F))
;; Activate our overlay.
- (call-next-method)
+ (cl-call-next-method)
;; Position the cursor at the first field
(let ((first (car (oref ir fields))))
@@ -223,21 +224,21 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(add-hook 'post-command-hook 'srecode-field-post-command t t)
)
-(defmethod srecode-delete ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-delete ((ir srecode-template-inserted-region))
"Call into our base, but also clear out the fields."
;; Clear us out of the baseclass.
(oset ir active-region nil)
;; Clear our fields.
(mapc 'srecode-delete (oref ir fields))
;; Call to our base
- (call-next-method)
+ (cl-call-next-method)
;; Clear our hook.
(remove-hook 'post-command-hook 'srecode-field-post-command t)
)
(defsubst srecode-active-template-region ()
"Return the active region for template fields."
- (oref srecode-template-inserted-region active-region))
+ (oref-default 'srecode-template-inserted-region active-region))
(defun srecode-field-post-command ()
"Srecode field handler in the post command hook."
@@ -285,15 +286,15 @@ Try to use this to provide useful completion when available.")
km)
"Keymap applied to field overlays.")
-(defmethod initialize-instance ((field srecode-field) &optional args)
+(cl-defmethod initialize-instance ((field srecode-field) &optional args)
"Initialize FIELD, being sure it archived."
(add-to-list 'srecode-field-archive field t)
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((field srecode-field))
+(cl-defmethod srecode-overlaid-activate ((field srecode-field))
"Activate the FIELD area."
- (call-next-method)
+ (cl-call-next-method)
(let* ((ol (oref field overlay))
(end nil)
@@ -314,13 +315,13 @@ Try to use this to provide useful completion when available.")
)
)
-(defmethod srecode-delete ((olaid srecode-field))
+(cl-defmethod srecode-delete ((olaid srecode-field))
"Delete our secondary overlay."
;; Remove our spare overlay
(delete-overlay (oref olaid tail))
(slot-makeunbound olaid 'tail)
;; Do our baseclass work.
- (call-next-method)
+ (cl-call-next-method)
)
(defvar srecode-field-replication-max-size 100
@@ -379,7 +380,7 @@ PRE-LEN is used in the after mode for the length of the changed text."
(srecode-field-mod-hook ol after start end pre-len))
))
-(defmethod srecode-field-goto ((field srecode-field))
+(cl-defmethod srecode-field-goto ((field srecode-field))
"Goto the FIELD."
(goto-char (overlay-start (oref field overlay))))
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index bdc7c42fa09..dc296dccf92 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -1,6 +1,6 @@
;;; srecode/filters.el --- Filters for use in template variables.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index 6384913192d..092f739df7d 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -1,6 +1,6 @@
;;;; srecode/find.el --- Tools for finding templates in the database.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -96,7 +96,7 @@ all template files for that application will be loaded."
;;
;; Find if a template table has a project set, and if so, is the
;; current buffer in that project.
-(defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
+(cl-defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
"Return non-nil if the table TAB can be used in the current project.
If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t."
@@ -113,7 +113,7 @@ If TAB is nil, then always return t."
;;
;; Find a given template based on name, and features of the current
;; buffer.
-(defmethod srecode-template-get-table ((tab srecode-template-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional
context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
@@ -129,7 +129,7 @@ The APPLICATION argument is unused."
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash)))))
-(defmethod srecode-template-get-table ((tab srecode-mode-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional
context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME.
@@ -157,7 +157,7 @@ tables that do not belong to an application will be searched."
;;
;; Find a given template based on a key binding.
;;
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-template-table) binding &optional context)
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
@@ -190,7 +190,7 @@ of a particular context."
(maphash hashfcn (oref tab namehash)))
keyout)))
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 617212759a1..07255af2bfe 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -1,6 +1,6 @@
;;; srecode/getset.el --- Package for inserting new get/set methods.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 0d647bb56c5..2ff3060ac51 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -1,6 +1,6 @@
;;; srecode/insert.el --- Insert srecode templates to an output stream.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -35,7 +35,6 @@
(require 'srecode/args)
(require 'srecode/filters)
-(defvar srecode-template-inserter-point)
(declare-function srecode-overlaid-activate "srecode/fields")
(declare-function srecode-template-inserted-region "srecode/fields")
@@ -46,9 +45,9 @@
Only the ASK style inserter will query the user for a value.
Dictionary value references that ask begin with the ? character.
Possible values are:
- 'ask - Prompt in the minibuffer as the value is inserted.
- 'field - Use the dictionary macro name as the inserted value,
- and place a field there. Matched fields change together.
+ `ask' - Prompt in the minibuffer as the value is inserted.
+ `field' - Use the dictionary macro name as the inserted value,
+ and place a field there. Matched fields change together.
NOTE: The field feature does not yet work with XEmacs."
:group 'srecode
@@ -145,7 +144,7 @@ has set everything up already."
)
(set-buffer standard-output)
(setq end-mark (point-marker))
- (goto-char (oref srecode-template-inserter-point point)))
+ (goto-char (oref-default 'srecode-template-inserter-point point)))
(oset-default 'srecode-template-inserter-point point eieio-unbound)
;; Return the end-mark.
@@ -211,13 +210,13 @@ insertions."
(propertize " (most recent at bottom)" 'face '(:slant italic))
":\n")
(data-debug-insert-stuff-list
- (reverse (oref srecode-template active)) "> ")
+ (reverse (oref-default 'srecode-template active)) "> ")
;; Show the current dictionary.
(insert (propertize "Dictionary" 'face '(:weight bold)) "\n")
(data-debug-insert-thing dictionary "" "> ")
;; Show the error message.
(insert (propertize "Error" 'face '(:weight bold)) "\n")
- (insert (apply #'format format args))
+ (insert (apply #'format-message format args))
(pop-to-buffer (current-buffer))))
(defun srecode-insert-report-error (dictionary format &rest args)
@@ -260,20 +259,19 @@ Optional argument TEMP is the template that is getting its arguments resolved."
;; Code managing the top-level insert method and the current
;; insertion stack.
;;
-(defmethod srecode-push ((st srecode-template))
+(cl-defmethod srecode-push ((st srecode-template))
"Push the srecoder template ST onto the active stack."
(oset st active (cons st (oref st active))))
-(defmethod srecode-pop :STATIC ((st srecode-template))
- "Pop the srecoder template ST onto the active stack.
-ST can be a class, or an object."
+(cl-defmethod srecode-pop ((st srecode-template))
+ "Pop the srecoder template ST onto the active stack."
(oset st active (cdr (oref st active))))
-(defmethod srecode-peek :STATIC ((st srecode-template))
- "Fetch the topmost active template record. ST can be a class."
+(cl-defmethod srecode-peek ((st srecode-template))
+ "Fetch the topmost active template record."
(car (oref st active)))
-(defmethod srecode-insert-method ((st srecode-template) dictionary)
+(cl-defmethod srecode-insert-method ((st srecode-template) dictionary)
"Insert the srecoder template ST."
;; Merge any template entries into the input dictionary.
;; This may happen twice since some templates arguments need
@@ -324,7 +322,7 @@ by themselves.")
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary)
"Insert the STI inserter."
;; To be safe, indent the previous line since the template will
@@ -363,9 +361,9 @@ occur in your template.")
((stringp i)
(princ i))))))
-(defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-newline) _indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(when (oref ins hard)
(princ " : hard")
))
@@ -379,16 +377,16 @@ Can't be blank, or it might be used by regular variable insertion.")
(where :initform 'begin
:initarg :where
:documentation
- "This should be 'begin or 'end, indicating where to insert a CR.
-When set to 'begin, it will insert a CR if we are not at 'bol'.
-When set to 'end it will insert a CR if we are not at 'eol'.")
+ "This should be `begin' or `end', indicating where to insert a CR.
+When `begin', insert a CR if not at 'bol'.
+When `end', insert a CR if not at 'eol'.")
;; @TODO - Add slot and control for the number of blank
;; lines before and after point.
)
"Insert a newline before and after a template, and possibly do indenting.
Specify the :blank argument to enable this inserter.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
dictionary)
"Make sure there is no text before or after point."
(let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
@@ -396,7 +394,7 @@ Specify the :blank argument to enable this inserter.")
(pm (point-marker)))
(when (and inbuff
;; Don't do this if we are not the active template.
- (= (length (oref srecode-template active)) 1))
+ (= (length (oref-default 'srecode-template active)) 1))
(when (and (eq i t) inbuff (not (eq (oref sti where) 'begin)))
(indent-according-to-mode)
@@ -425,8 +423,8 @@ Specify the :blank argument to enable this inserter.")
)
"Allow comments within template coding. This inserts nothing.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-comment))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -436,8 +434,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
- dictionary)
+(cl-defmethod srecode-insert-method ((_sti srecode-template-inserter-comment)
+ _dictionary)
"Don't insert anything for comment macros in STI."
nil)
@@ -453,7 +451,7 @@ If there is no entry, insert nothing.")
(defvar srecode-inserter-variable-current-dictionary nil
"The active dictionary when calling a variable filter.")
-(defmethod srecode-insert-variable-secondname-handler
+(cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-variable) dictionary value secondname)
"For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string.
@@ -471,7 +469,7 @@ If SECONDNAME is nil, return VALUE."
(object-print sti) secondname)))
value))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
dictionary)
"Insert the STI inserter."
;; Convert the name into a name/fcn pair
@@ -491,7 +489,7 @@ If SECONDNAME is nil, return VALUE."
(setq val (srecode-insert-variable-secondname-handler
sti dictionary val fcnpart)))
;; Compound data value
- ((srecode-dictionary-compound-value-child-p val)
+ ((cl-typep val 'srecode-dictionary-compound-value)
;; Force FCN to be a symbol
(when fcnpart (setq fcnpart (read fcnpart)))
;; Convert compound value to a string with the fcn.
@@ -502,7 +500,7 @@ If SECONDNAME is nil, return VALUE."
(setq do-princ nil)))
;; Dictionaries... not allowed in this style
- ((srecode-dictionary-child-p val)
+ ((cl-typep val 'srecode-dictionary)
(srecode-insert-report-error
dictionary
"Macro %s cannot insert a dictionary - use section macros instead"
@@ -541,7 +539,7 @@ If there is no entry, prompt the user for the value to use.
The prompt text used is derived from the previous PROMPT command in the
template file.")
-(defmethod srecode-inserter-apply-state
+(cl-defmethod srecode-inserter-apply-state
((ins srecode-template-inserter-ask) STATE)
"For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match."
@@ -561,14 +559,14 @@ Loop over the prompts to see if we have a match."
(setq prompts (cdr prompts)))
))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
dictionary)
"Insert the STI inserter."
(let ((val (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(if val
;; Does some extra work. Oh well.
- (call-next-method)
+ (cl-call-next-method)
;; How is our -ask value determined?
(if srecode-insert-with-fields-in-progress
@@ -585,9 +583,9 @@ Loop over the prompts to see if we have a match."
;; Now that this value is safely stowed in the dictionary,
;; we can do what regular inserters do.
- (call-next-method))))
+ (cl-call-next-method))))
-(defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
dictionary)
"Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
@@ -612,7 +610,7 @@ DICTIONARY is used to derive some values."
dictionary
"Unknown default for prompt: %S" defaultfcn)))))
-(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary)
"Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values."
@@ -646,7 +644,7 @@ Use DICTIONARY to resolve values."
val)
)
-(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
dictionary)
"Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values."
@@ -661,9 +659,9 @@ Use DICTIONARY to resolve values."
;; across multiple locations.
compound-value))
-(defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-ask) _indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ " : \"")
(princ (oref ins prompt))
(princ "\"")
@@ -681,8 +679,8 @@ Thus a specification of `10:left' will insert the value of A
to 10 characters, with spaces added to the left. Use `right' for adding
spaces to the right.")
-(defmethod srecode-insert-variable-secondname-handler
- ((sti srecode-template-inserter-width) dictionary value width)
+(cl-defmethod srecode-insert-variable-secondname-handler
+ ((_sti srecode-template-inserter-width) dictionary value width)
"For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
By default, treat as a function name."
@@ -714,8 +712,8 @@ By default, treat as a function name."
(concat padchars value)
(concat value padchars))))))
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-width))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -750,8 +748,8 @@ The cursor is placed at the ^ macro after insertion.
Some inserter macros, such as `srecode-template-inserter-include-wrap'
will place text at the ^ macro from the included macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-point))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -761,10 +759,10 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-point)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-point)
dictionary)
"Insert the STI inserter.
-Save point in the class allocated 'point' slot.
+Save point in the class allocated `point' slot.
If `srecode-template-inserter-point-override' non-nil then this
generalized marker will do something else. See
`srecode-template-inserter-include-wrap' as an example."
@@ -773,7 +771,7 @@ generalized marker will do something else. See
;; valid. Compare this to the actual template nesting depth and
;; maybe use the override function which is stored in the cdr.
(if (and srecode-template-inserter-point-override
- (<= (length (oref srecode-template active))
+ (<= (length (oref-default 'srecode-template active))
(car srecode-template-inserter-point-override)))
;; Disable the old override while we do this.
(let ((over (cdr srecode-template-inserter-point-override))
@@ -787,11 +785,11 @@ generalized marker will do something else. See
"Wrap a section of a template under the control of a macro."
:abstract t)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-subtemplate))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
- (call-next-method)
+ (cl-call-next-method)
(princ " Template Text to control")
(terpri)
(princ " ")
@@ -801,11 +799,11 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT."
;; Make sure that only dictionaries are used.
- (unless (srecode-dictionary-child-p dict)
+ (unless (cl-typep dict 'srecode-dictionary)
(srecode-insert-report-error
dict
"Only section dictionaries allowed for `%s'"
@@ -814,7 +812,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
;; Output the code from the sub-template.
(srecode-insert-method (slot-value sti slot) dict))
-(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot)
"Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation.
@@ -837,7 +835,7 @@ The template to insert is stored in SLOT."
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
dictionary)
"Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class."
@@ -858,7 +856,7 @@ The dictionary saved at the named dictionary entry will be
applied to the text between the section start and the
`srecode-template-inserter-section-end' macro.")
-(defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
tag input STATE)
"For the section inserter INS, parse INPUT.
Shorten input until the END token is found.
@@ -872,9 +870,9 @@ Return the remains of INPUT."
:code (cdr out)))
(car out)))
-(defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ "\n")
(srecode-dump-code-list (oref (oref ins template) code)
(concat indent " "))
@@ -889,12 +887,12 @@ Return the remains of INPUT."
"All template segments between the section-start and section-end
are treated specially.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
- dictionary)
+(cl-defmethod srecode-insert-method ((_sti srecode-template-inserter-section-end)
+ _dictionary)
"Insert the STI inserter."
)
-(defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
+(cl-defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
"For the template inserter INS, do I end a section called NAME?"
(string= name (oref ins :object-name)))
@@ -912,7 +910,7 @@ are treated specially.")
The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-include))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -923,7 +921,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
dictionary)
"For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
@@ -943,7 +941,7 @@ this template instance."
;; Calculate and store the discovered template
(let ((tmpl (srecode-template-get-table (srecode-table)
templatenamepart))
- (active (oref srecode-template active))
+ (active (oref-default 'srecode-template active))
ctxt)
(when (not tmpl)
;; If it isn't just available, scan back through
@@ -981,7 +979,7 @@ this template instance."
"No template \"%s\" found for include macro `%s'"
templatenamepart (oref sti :object-name)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary)
"Insert the STI inserter.
Finds the template with this macro function part, and inserts it
@@ -1017,7 +1015,7 @@ stored specified by this macro. If the included macro includes a ^ macro,
then the text between this macro and the end macro will be inserted at
the ^ macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-include-wrap))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -1035,7 +1033,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
dictionary)
"Insert the template STI.
This will first insert the include part via inheritance, then
@@ -1053,7 +1051,7 @@ template where a ^ inserter occurs."
(lexical-let ((inserter1 sti))
(cons
;; DEPTH
- (+ (length (oref srecode-template active)) 1)
+ (+ (length (oref-default 'srecode-template active)) 1)
;; FUNCTION
(lambda (dict)
(let ((srecode-template-inserter-point-override nil))
@@ -1067,7 +1065,7 @@ template where a ^ inserter occurs."
inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in
;; place.
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'srecode/insert)
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index 1b8922c2746..d812df1c935 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -1,6 +1,6 @@
;;; srecode/java.el --- Srecode Java support
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -40,16 +40,15 @@ FILENAME_AS_CLASS - file converted to a Java class name."
(fnox (file-name-sans-extension fsym))
(dir (file-name-directory (buffer-file-name)))
(fpak fsym)
+ (proj (ede-current-project))
+ (pths (ede-source-paths proj 'java-mode))
)
(while (string-match "\\.\\| " fpak)
(setq fpak (replace-match "_" t t fpak)))
;; 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))
+ (cond ((and proj pths)
+ (let* ((pth) (res))
(while (and (not res)
(setq pth (expand-file-name (car pths))))
(when (string-match pth dir)
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 1dd9ba4cf47..71ed835e4ff 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,6 +1,6 @@
;;; srecode/map.el --- Manage a template file map
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -67,11 +67,11 @@ Each app keys to an alist of files and modes (as above.)")
)
"A map of srecode templates.")
-(defmethod srecode-map-entry-for-file ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file ((map srecode-map) file)
"Return the entry in MAP for FILE."
(assoc file (oref map files)))
-(defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
+(cl-defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
"Return the entries in MAP for major MODE."
(let ((ans nil))
(dolist (f (oref map files))
@@ -79,12 +79,12 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-app ((map srecode-map) app)
- "Return the entry in MAP for APP'lication."
+(cl-defmethod srecode-map-entry-for-app ((map srecode-map) app)
+ "Return the entry in MAP for APP."
(assoc app (oref map apps))
)
-(defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
+(cl-defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
"Return the entries in MAP for major MODE."
(let ((ans nil)
(appentry (srecode-map-entry-for-app map app)))
@@ -93,7 +93,7 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
"Search in all entry points in MAP for FILE.
Return a list ( APP . FILE-ASSOC ) where APP is nil
in the global map."
@@ -112,13 +112,13 @@ in the global map."
;; Other?
))
-(defmethod srecode-map-delete-file-entry ((map srecode-map) file)
+(cl-defmethod srecode-map-delete-file-entry ((map srecode-map) file)
"Update MAP to exclude FILE from the file list."
(let ((entry (srecode-map-entry-for-file map file)))
(when entry
(object-remove-from-list map 'files entry))))
-(defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
+(cl-defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
"Update a MAP entry for FILE to be used with MODE.
Return non-nil if the MAP was changed."
(let ((entry (srecode-map-entry-for-file map file))
@@ -136,14 +136,14 @@ Return non-nil if the MAP was changed."
))
dirty))
-(defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
- "Delete from MAP the FILE entry within the APP'lication."
+(cl-defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
+ "Delete from MAP the FILE entry within the APP."
(let* ((appe (srecode-map-entry-for-app map app))
(fentry (assoc file (cdr appe))))
(setcdr appe (delete fentry (cdr appe))))
)
-(defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
+(cl-defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
"Update the MAP entry for FILE to be used with MODE within APP.
Return non-nil if the map was changed."
(let* ((appentry (srecode-map-entry-for-app map app))
@@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed."
(when (not srecode-current-map)
(condition-case nil
(setq srecode-current-map
- (eieio-persistent-read srecode-map-save-file srecode-map))
+ (eieio-persistent-read srecode-map-save-file 'srecode-map))
(error
;; There was an error loading the old map. Create a new one.
(setq srecode-current-map
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index e8e1c78198e..a6daff8be56 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -1,6 +1,6 @@
;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index c8b44c68d5d..0ea2ab4a5ff 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,6 +1,6 @@
;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -55,7 +55,7 @@
"Wrap up a collection of semantic tag information.
This class will be used to derive dictionary values.")
-(defmethod srecode-compound-toString((cp srecode-semantic-tag)
+(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
dictionary)
"Convert the compound dictionary value CP to a string.
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 2f43dc3872b..7fc35410b48 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -1,6 +1,6 @@
;;; srecode/srt-mode.el --- Major mode for writing screcode macros
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -188,6 +188,7 @@ we can tell font lock about them.")
;;;###autoload
(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
+ ;; FIXME: Shouldn't it derive from prog-mode?
"Major-mode for writing SRecode macros."
(set (make-local-variable 'comment-start) ";;")
(set (make-local-variable 'comment-end) "")
@@ -232,7 +233,7 @@ we can tell font lock about them.")
"Provide help for working with macros in a template."
(interactive)
(let* ((root 'srecode-template-inserter)
- (chl (eieio--class-children (class-v root)))
+ (chl (eieio-class-children root))
(ess (srecode-template-get-escape-start))
(ees (srecode-template-get-escape-end))
)
@@ -248,7 +249,7 @@ we can tell font lock about them.")
(showexample t)
)
(setq chl (cdr chl))
- (setq chl (append (eieio--class-children (class-v C)) chl))
+ (setq chl (append (eieio-class-children C) chl))
(catch 'skip
(when (eq C 'srecode-template-inserter-section-end)
@@ -257,9 +258,9 @@ we can tell font lock about them.")
(when (class-abstract-p C)
(throw 'skip nil))
- (princ "`")
+ (princ (substitute-command-keys "`"))
(princ name)
- (princ "'")
+ (princ (substitute-command-keys "'"))
(when (slot-exists-p C 'key)
(when key
(princ " - Character Key: ")
diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el
deleted file mode 100644
index 450f57d943c..00000000000
--- a/lisp/cedet/srecode/srt-wy.el
+++ /dev/null
@@ -1,306 +0,0 @@
-;;; srecode/srt-wy.el --- Generated parser support file
-
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/srecode-template.wy.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst srecode-template-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("set" . SET)
- ("show" . SHOW)
- ("macro" . MACRO)
- ("context" . CONTEXT)
- ("template" . TEMPLATE)
- ("sectiondictionary" . SECTIONDICTIONARY)
- ("section" . SECTION)
- ("end" . END)
- ("prompt" . PROMPT)
- ("default" . DEFAULT)
- ("defaultmacro" . DEFAULTMACRO)
- ("read" . READ)
- ("bind" . BIND))
- '(("bind" summary "bind \"<letter>\"")
- ("read" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("defaultmacro" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("default" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("prompt" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("end" summary "section ... end")
- ("section" summary "section <name>\\n <dictionary entries>\\n end")
- ("sectiondictionary" summary "sectiondictionary <name>\\n <dictionary entries>")
- ("template" summary "template <name>\\n <template definition>")
- ("context" summary "context <name>")
- ("macro" summary "... macro \"string\" ...")
- ("show" summary "show <name> ; to show a section")
- ("set" summary "set <name> <value>")))
- "Table of language keywords.")
-
-(defconst srecode-template-wy--token-table
- (semantic-lex-make-type-table
- '(("number"
- (number))
- ("string"
- (string))
- ("symbol"
- (symbol))
- ("property"
- (property))
- ("separator"
- (TEMPLATE_BLOCK . "^----"))
- ("newline"
- (newline)))
- '(("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("property" syntax ":\\(\\w\\|\\s_\\)*")
- ("property" :declared t)
- ("newline" :declared t)
- ("punctuation" syntax "\\s.+")
- ("punctuation" :declared t)
- ("keyword" :declared t)))
- "Table of lexical tokens.")
-
-(defconst srecode-template-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY SECTION END PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number)
- nil
- (template_file
- ((newline)
- nil)
- ((context))
- ((prompt))
- ((variable))
- ((template)))
- (context
- ((CONTEXT symbol newline)
- (wisent-raw-tag
- (semantic-tag $2 'context))))
- (prompt
- ((PROMPT symbol string opt-default-fcn opt-read-fcn newline)
- (wisent-raw-tag
- (semantic-tag $2 'prompt :text
- (read $3)
- :default $4 :read $5))))
- (opt-default-fcn
- ((DEFAULT symbol)
- (progn
- (read $2)))
- ((DEFAULT string)
- (progn
- (read $2)))
- ((DEFAULTMACRO string)
- (progn
- (cons 'macro
- (read $2))))
- (nil nil))
- (opt-read-fcn
- ((READ symbol)
- (progn
- (read $2)))
- (nil nil))
- (variable
- ((SET symbol insertable-string-list newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil $3)))
- ((SET symbol number newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil
- (list $3))))
- ((SHOW symbol newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil t))))
- (insertable-string-list
- ((insertable-string)
- (list $1))
- ((insertable-string-list insertable-string)
- (append $1
- (list $2))))
- (insertable-string
- ((string)
- (read $1))
- ((MACRO string)
- (cons 'macro
- (read $2))))
- (template
- ((TEMPLATE templatename opt-dynamic-arguments newline opt-string section-dictionary-list TEMPLATE_BLOCK newline opt-bind)
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3 :documentation $5 :code $7 :dictionaries $6 :binding $9))))
- (templatename
- ((symbol))
- ((PROMPT))
- ((CONTEXT))
- ((TEMPLATE))
- ((DEFAULT))
- ((MACRO))
- ((DEFAULTMACRO))
- ((READ))
- ((SET)))
- (opt-dynamic-arguments
- ((property opt-dynamic-arguments)
- (cons $1 $2))
- (nil nil))
- (opt-string
- ((string newline)
- (read $1))
- (nil nil))
- (section-dictionary-list
- (nil nil)
- ((section-dictionary-list flat-section-dictionary)
- (append $1
- (list $2)))
- ((section-dictionary-list section-dictionary)
- (append $1
- (list $2))))
- (flat-section-dictionary
- ((SECTIONDICTIONARY string newline flat-dictionary-entry-list)
- (cons
- (read $2)
- $4)))
- (flat-dictionary-entry-list
- (nil nil)
- ((flat-dictionary-entry-list flat-dictionary-entry)
- (append $1 $2)))
- (flat-dictionary-entry
- ((variable)
- (wisent-cook-tag $1)))
- (section-dictionary
- ((SECTION string newline dictionary-entry-list END newline)
- (cons
- (read $2)
- $4)))
- (dictionary-entry-list
- (nil nil)
- ((dictionary-entry-list dictionary-entry)
- (append $1 $2)))
- (dictionary-entry
- ((variable)
- (wisent-cook-tag $1))
- ((section-dictionary)
- (list $1)))
- (opt-bind
- ((BIND string newline)
- (read $2))
- (nil nil)))
- '(template_file)))
- "Parser table.")
-
-(defun srecode-template-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table srecode-template-wy--parse-table
- semantic-debug-parser-source "srecode-template.wy"
- semantic-flex-keywords-obarray srecode-template-wy--keyword-table
- semantic-lex-types-obarray srecode-template-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-regex-type-analyzer srecode-template-wy--<property>-regexp-analyzer
- "regexp analyzer for <property> tokens."
- ":\\(\\w\\|\\s_\\)*"
- nil
- 'property)
-
-(define-lex-regex-type-analyzer srecode-template-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'symbol)
-
-(define-lex-regex-type-analyzer srecode-template-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'number)
-
-(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\s.+"
- nil
- 'punctuation)
-
-(define-lex-sexp-type-analyzer srecode-template-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'string)
-
-(define-lex-keyword-type-analyzer srecode-template-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-(define-lex-simple-regex-analyzer srecode-template-property-analyzer
- "Detect and create a dynamic argument properties."
- ":\\(\\w\\|\\s_\\)*" 'property 0)
-
-(define-lex-regex-analyzer srecode-template-separator-block
- "Detect and create a template quote block."
- "^----\n"
- (semantic-lex-push-token
- (semantic-lex-token
- 'TEMPLATE_BLOCK
- (match-end 0)
- (semantic-lex-unterminated-syntax-protection 'TEMPLATE_BLOCK
- (goto-char (match-end 0))
- (re-search-forward "^----$")
- (match-beginning 0))))
- (setq semantic-lex-end-point (point)))
-
-
-(define-lex wisent-srecode-template-lexer
- "Lexical analyzer that handles SRecode Template buffers.
-It ignores whitespace, newlines and comments."
- semantic-lex-newline
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
- srecode-template-separator-block
- srecode-template-wy--<keyword>-keyword-analyzer
- srecode-template-property-analyzer
- srecode-template-wy--<number>-regexp-analyzer
- srecode-template-wy--<symbol>-regexp-analyzer
- srecode-template-wy--<string>-sexp-analyzer
- srecode-template-wy--<punctuation>-string-analyzer
- semantic-lex-default-action
- )
-
-(provide 'srecode/srt-wy)
-
-;;; srecode/srt-wy.el ends here
diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el
index 1fad31dafd6..f369e45a834 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -1,6 +1,6 @@
;;; srecode/srt.el --- argument handlers for SRT files
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 26163bd1e51..a2baa7b231f 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -1,6 +1,6 @@
;;; srecode/table.el --- Tables of Semantic Recoders
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -26,6 +26,7 @@
;;
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'mode-local)
(require 'srecode)
@@ -172,7 +173,7 @@ calculate all inherited templates from parent modes."
new))))
-(defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
+(cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE.
Return nil if there was none."
(object-assoc file 'file (oref mt modetables)))
@@ -235,7 +236,7 @@ Use PREDICATE is the same as for the `sort' function."
(srecode-dump tmp))
)))
-(defmethod srecode-dump ((tab srecode-mode-table))
+(cl-defmethod srecode-dump ((tab srecode-mode-table))
"Dump the contents of the SRecode mode table TAB."
(princ "MODE TABLE FOR ")
(princ (oref tab :major-mode))
@@ -248,7 +249,7 @@ Use PREDICATE is the same as for the `sort' function."
(setq subtab (cdr subtab)))
))
-(defmethod srecode-dump ((tab srecode-template-table))
+(cl-defmethod srecode-dump ((tab srecode-template-table))
"Dump the contents of the SRecode template table TAB."
(princ "Template Table for ")
(princ (eieio-object-name-string tab))
diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index e3241a2ef40..3a7c45e9e06 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -1,6 +1,6 @@
;;; srecode/template.el --- SRecoder template language parser support.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 9130c6ff863..38bdc9a2f72 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -1,6 +1,6 @@
;;; srecode/texi.el --- Srecode texinfo support.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -241,11 +241,11 @@ This is to take advantage of TeXinfo's markup symbols."
For instances where CLASS is the class being referenced, do not Xref
that class.
- `function' => @dfn{function}
- `variable' => @code{variable}
- `class' => @code{class} @xref{class}
- `unknown' => @code{unknown}
- \"text\" => ``text''
+ function => @dfn{function}
+ variable => @code{variable}
+ class => @code{class} @xref{class}
+ unknown => @code{unknown}
+ \"text\" => \\=`\\=`text\\='\\='
'quoteme => @code{quoteme}
non-nil => non-@code{nil}
t => @code{t}
@@ -253,7 +253,7 @@ that class.
[ stuff ] => @code{[ stuff ]}
Key => @kbd{Key} (key is C\\-h, M\\-h, SPC, RET, TAB and the like)
... => @dots{}"
- (while (string-match "`\\([-a-zA-Z0-9<>.]+\\)'" string)
+ (while (string-match "[`‘]\\([-a-zA-Z0-9<>.]+\\)['’]" string)
(let* ((vs (substring string (match-beginning 1) (match-end 1)))
(v (intern-soft vs)))
(setq string