procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge with CEDET upstream (rev. 8564).

Browse source
This commit is contained in:
David Engster 2013-06-02 18:39:32 +02:00
commit 6b7a9e0eb1
28 changed files with 2911 additions and 2460 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
admin/ChangeLog
View file

@ -1,3 +1,10 @@
2013-06-02 Eric Ludlam <zappo@gnu.org>
* grammars/srecode-template.wy (variable): Accept a single number
as a variable value. Allows the 'priority' to be set to a number.
(wisent-srecode-template-lexer): Move number up so it can be
created.
2013-05-16 Glenn Morris <rgm@gnu.org>
* cus-test.el (cus-test-cus-load-groups): New function.

6
admin/grammars/srecode-template.wy
View file

@ -125,6 +125,10 @@ opt-read-fcn
variable
: SET symbol insertable-string-list newline
(VARIABLE-TAG $2 nil $3)
| SET symbol number newline
;; This so a common error w/ priority works.
;; Note that "number" still has a string value in the lexer.
(VARIABLE-TAG $2 nil (list $3))
| SHOW symbol newline
(VARIABLE-TAG $2 nil t)
;
@ -260,8 +264,8 @@ It ignores whitespace, newlines and comments."
srecode-template-separator-block
srecode-template-wy--<keyword>-keyword-analyzer
srecode-template-property-analyzer
srecode-template-wy--<symbol>-regexp-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

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2013-06-02 Eric Ludlam <zappo@gnu.org>
* srecode/c.srt (header_guard): Add :c parameter so it works
standalone
2013-06-01 Alex Ott <alexott@gmail.com>
* tutorials/TUTORIAL.ru: Fix incorrectly translated wording.

2
etc/srecode/c.srt
View file

@ -44,7 +44,7 @@ template empty :time :user :file :c
{{/HEADER}}
----
template header_guard :file :blank
template header_guard :file :blank :c
----
#ifndef {{FILENAME_SYMBOL:upcase}}
#define {{FILENAME_SYMBOL:upcase}} 1

69
lisp/ChangeLog
View file

@ -1,3 +1,72 @@
2013-06-02 Eric Ludlam <zappo@gnu.org>
* emacs-lisp/eieio.el (eieio--defalias, eieio-hook)
(eieio-error-unsupported-class-tags, eieio-skip-typecheck)
(eieio-optimize-primary-methods-flag, eieio-initializing-object)
(eieio-unbound, eieio-default-superclass)
(eieio--define-field-accessors, method-static, method-before)
(method-primary, method-after, method-num-lists)
(method-generic-before, method-generic-primary)
(method-generic-after, method-num-slots)
(eieio-specialized-key-to-generic-key)
(eieio--check-type, class-v, class-p)
(eieio-class-name, define-obsolete-function-alias)
(eieio-class-parents-fast, eieio-class-children-fast)
(same-class-fast-p, class-constructor, generic-p)
(generic-primary-only-p, generic-primary-only-one-p)
(class-option-assoc, class-option, eieio-object-p)
(class-abstract-p, class-method-invocation-order)
(eieio-defclass-autoload-map, eieio-defclass-autoload)
(eieio-class-un-autoload, eieio-defclass)
(eieio-eval-default-p, eieio-perform-slot-validation-for-default)
(eieio-add-new-slot, eieio-copy-parents-into-subclass)
(eieio--defgeneric-init-form, eieio-defgeneric-form)
(eieio-defgeneric-reset-generic-form)
(eieio-defgeneric-form-primary-only)
(eieio-defgeneric-reset-generic-form-primary-only)
(eieio-defgeneric-form-primary-only-one)
(eieio-defgeneric-reset-generic-form-primary-only-one)
(eieio-unbind-method-implementations)
(eieio--defmethod, eieio--typep)
(eieio-perform-slot-validation, eieio-validate-slot-value)
(eieio-validate-class-slot-value, eieio-barf-if-slot-unbound)
(eieio-oref, eieio-oref-default, eieio-default-eval-maybe)
(eieio-oset, eieio-oset-default, eieio-slot-originating-class-p)
(eieio-slot-name-index, eieio-class-slot-name-index)
(eieio-set-defaults, eieio-initarg-to-attribute)
(eieio-attribute-to-initarg, eieio-c3-candidate)
(eieio-c3-merge-lists, eieio-class-precedence-c3)
(eieio-class-precedence-dfs, eieio-class-precedence-bfs)
(eieio-class-precedence-list, eieio-generic-call-methodname)
(eieio-generic-call-arglst, eieio-generic-call-key)
(eieio-generic-call-next-method-list)
(eieio-pre-method-execution-functions, eieio-generic-call)
(eieio-generic-call-primary-only, eieiomt-method-list)
(eieiomt-optimizing-obarray, eieiomt-install)
(eieiomt-add, eieiomt-next, eieiomt-sym-optimize)
(eieio-generic-form, eieio-defmethod, make-obsolete)
(eieio-defgeneric, make-obsolete): Moved to eieio-core.el
(defclass): Remove `eval-and-compile' from macro.
(call-next-method, shared-initialize): Instead of using
`scoped-class' variable, use new eieio--scoped-class, and
eieio--with-scoped-class.
(initialize-instance): Rename local variable 'scoped-class' to
'this-class' to remove ambiguitity from old global.
* emacs-lisp/eieio-core.el: New file. Derived from key parts of
eieio.el.
(eieio--scoped-class-stack): New variable
(eieio--scoped-class): New fcn
(eieio--with-scoped-class): New scoping macro.
(eieio-defclass): Use pushnew instead of add-to-list.
(eieio-defgeneric-form-primary-only-one, eieio-oset-default)
(eieio-slot-name-index, eieio-set-defaults, eieio-generic-call)
(eieio-generic-call-primary-only, eieiomt-add): Instead of using
`scoped-class' variable, use new eieio--scoped-class, and
eieio--with-scoped-class.
* emacs-lisp/eieio-base.el (cl-lib): Require during compile.
2013-06-02 Tassilo Horn <tsdh@gnu.org>
* eshell/esh-ext.el (eshell-external-command): Pass args to

82
lisp/cedet/ChangeLog
View file

@ -1,3 +1,85 @@
2013-06-02 Eric Ludlam <zappo@gnu.org>
* semantic/edit.el (semantic-change-function): Use
`save-match-data' around running hooks.
* semantic/decorate/mode.el
(semantic-decorate-style-predicate-default)
(semantic-decorate-style-highlighter-default): New.
(semantic-decoration-mode): Do not require
`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
functions so that code is loaded when the mode is used.
(semantic-decoration-on-includes): New autoload definition for
highlighting includes.
* semantic/bovine/c.el (semantic-lex-c-ifdef): Allow some misc
characters to appear after the tested variable.
* semantic/ede-grammar.el (project-compile-target): Calculate full
src name via ede-expand-filename instead of the crutch of the
current buffer. Enables this target to compile in batch mode.
* semantic/idle.el
(semantic-idle-symbol-maybe-highlight): Wrap highlighting of
remote symbol with `save-excursion'.
(semantic-idle-scheduler-work-parse-neighboring-files): Instead of
using directory-files on each found mode pattern, collect all the
patterns for the current mode, and then for each file, see if it
matches any of them. If it does, parse the file. (Patch
inspiration from Tomasz Gajewski.)
* 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.
(footer): Add local variable for loaddefs.
* semantic/db.el (semanticdb-file-table-object): Add new filter,
only checking for regular files too.
* semantic/wisent/python.el
(semantic-format-tag-abbreviate): New override. Cuts back on size
of code tags.
* srecode/compile.el (srecode-compile-templates): Fix warning
punctuation. Remove status messages to clean up testing output
* ede/base.el (ede-project-placeholder-cache-file): Update doc to
mention 'nil' value.
(ede-save-cache): Disable cache save if file is nil.
* ede.el (ede-initialize-state-current-buffer): Flush deleted
projects.
(global-ede-mode): Always append our find-file-hook to the end.
(ede-flush-deleted-projects): New command.
* ede/cpp-root.el (ede-preprocessor-map): Protect against init
problems.
* ede/proj.el (ede-proj-target): Added a new "custom" option for
custom symbols representing a compiler or linker instead of
restricting things to only the predefined compilers and linkers.
2013-06-02 David Engster <dengste@eml.cc>
* semantic.el (semantic-mode-map): To avoid showing showing
Development menu twice, only disable menu item if menu-bar is
actually enabled, otherwise the popup 'global menu' might display
a disabled Development menu.
* srecode/srt-wy.el: Regenerate.
2013-06-02 Pete Beardmore <elbeardmorez@msn.com>
* semantic/complete.el
(semantic-displayor-show-request): Fix which slot in obj is set to
the max tags.
2013-06-01 Glenn Morris <rgm@gnu.org>
* semantic/grammar.el (semantic-grammar-complete):

21
lisp/cedet/ede.el
View file

@ -494,6 +494,11 @@ provided `global-ede-mode' is enabled."
(defun ede-initialize-state-current-buffer ()
"Initialize the current buffer's state for EDE.
Sets buffer local variables for EDE."
;; due to inode recycling, make sure we don't
;; we flush projects deleted off the system.
(ede-flush-deleted-projects)
;; Init the buffer.
(let* ((ROOT nil)
(proj (ede-directory-get-open-project default-directory
'ROOT))
@ -569,7 +574,9 @@ an EDE controlled project."
(add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
(add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
(add-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
(add-hook 'find-file-hook 'ede-turn-on-hook)
;; Append our hook to the end. This allows mode-local to finish
;; it's stuff before we start doing misc file loads, etc.
(add-hook 'find-file-hook 'ede-turn-on-hook t)
(add-hook 'dired-mode-hook 'ede-turn-on-hook)
(add-hook 'kill-emacs-hook 'ede-save-cache)
(ede-load-cache)
@ -1057,6 +1064,18 @@ On success, return the added project."
(add-to-list 'ede-projects proj)
proj)
(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)))
(add-to-list 'dead P)))
(dolist (D dead)
(setq ede-projects (remove D ede-projects)))
))
(defun ede-load-project-file (dir &optional rootreturn)
"Project file independent way to read a project in from DIR.
Optional ROOTRETURN will return the root project for DIR."

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

@ -306,7 +306,8 @@ All specific project types must derive from this project."
;;
(defcustom ede-project-placeholder-cache-file
(locate-user-emacs-file "ede-projects.el" ".projects.ede")
"File containing the list of projects EDE has viewed."
"File containing the list of projects EDE has viewed.
If set to nil, then the cache is not saved."
:group 'ede
:type 'file)
@ -316,38 +317,39 @@ All specific project types must derive from this project."
(defun ede-save-cache ()
"Save a cache of EDE objects that Emacs has seen before."
(interactive)
(let ((p ede-projects)
(c ede-project-cache-files)
(recentf-exclude '( (lambda (f) t) ))
)
(condition-case nil
(progn
(set-buffer (find-file-noselect ede-project-placeholder-cache-file t))
(erase-buffer)
(insert ";; EDE project cache file.
;; This contains a list of projects you have visited.\n(")
(while p
(when (and (car p) (ede-project-p p))
(let ((f (oref (car p) file)))
(when (file-exists-p f)
(insert "\n \"" f "\""))))
(setq p (cdr p)))
(while c
(insert "\n \"" (car c) "\"")
(setq c (cdr c)))
(insert "\n)\n")
(condition-case nil
(save-buffer 0)
(error
(message "File %s could not be saved."
ede-project-placeholder-cache-file)))
(kill-buffer (current-buffer))
(when ede-project-placeholder-cache-file
(let ((p ede-projects)
(c ede-project-cache-files)
(recentf-exclude '( (lambda (f) t) ))
)
(error
(message "File %s could not be read."
ede-project-placeholder-cache-file))
(condition-case nil
(progn
(set-buffer (find-file-noselect ede-project-placeholder-cache-file t))
(erase-buffer)
(insert ";; EDE project cache file.
;; This contains a list of projects you have visited.\n(")
(while p
(when (and (car p) (ede-project-p p))
(let ((f (oref (car p) file)))
(when (file-exists-p f)
(insert "\n \"" f "\""))))
(setq p (cdr p)))
(while c
(insert "\n \"" (car c) "\"")
(setq c (cdr c)))
(insert "\n)\n")
(condition-case nil
(save-buffer 0)
(error
(message "File %s could not be saved."
ede-project-placeholder-cache-file)))
(kill-buffer (current-buffer))
)
(error
(message "File %s could not be read."
ede-project-placeholder-cache-file))
)))
))))
(defun ede-load-cache ()
"Load the cache of EDE projects."

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

@ -507,7 +507,10 @@ This is for project include paths and spp source files."
(lambda (F)
(let* ((expfile (ede-expand-filename root F))
(table (when expfile
(semanticdb-file-table-object expfile)))
;; Disable EDE init on preprocessor file load
;; otherwise we recurse, cause errs, etc.
(let ((ede-constructing t))
(semanticdb-file-table-object expfile))))
)
(cond
((not (file-exists-p expfile))

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

@ -104,6 +104,7 @@ distributed, and each should have a corresponding rule to build it.")
:initform nil
:type (or null symbol)
:custom (choice (const :tag "None" nil)
(symbol :tag "Custom Compiler Symbol")
:slotofchoices availablecompilers)
:label "Compiler for building sources"
:group make
@ -116,6 +117,7 @@ of these compiler resources, and global customization thereof.")
:initform nil
:type (or null symbol)
:custom (choice (const :tag "None" nil)
(symbol :tag "Custom Linker Symbol")
:slotofchoices availablelinkers)
:label "Linker for combining intermediate object files."
:group make

3
lisp/cedet/semantic.el
View file

@ -899,7 +899,8 @@ Throw away all the old tags, and recreate the tag database."
;; and Semantic are both enabled. Is there a better way?
(define-key map [menu-bar cedet-menu]
(list 'menu-item "Development" cedet-menu-map
:enable (quote (not (bound-and-true-p global-ede-mode)))))
:enable (quote (not (and menu-bar-mode
(bound-and-true-p global-ede-mode))))))
;; (define-key km "-" 'senator-fold-tag)
;; (define-key km "+" 'senator-unfold-tag)
map))

2
lisp/cedet/semantic/bovine/c.el
View file

@ -529,7 +529,7 @@ code to parse."
(define-lex-regex-analyzer semantic-lex-c-ifdef
"Code blocks wrapped up in #ifdef.
Uses known macro tables in SPP to determine what block to skip."
"^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)$"
"^\\s-*#\\s-*\\(ifndef\\|ifdef\\)\\s-+\\(\\(\\sw\\|\\s_\\)+\\)\\([ \t\C-m].*\\)?$"
(semantic-c-do-lex-ifdef))
(defun semantic-c-do-lex-ifdef ()

9
lisp/cedet/semantic/bovine/el.el
View file

@ -940,8 +940,11 @@ ELisp variables can be pretty long, so track this one too.")
(define-child-mode lisp-mode emacs-lisp-mode
"Make `lisp-mode' inherit mode local behavior from `emacs-lisp-mode'.")
;;;###autoload
(defun semantic-default-elisp-setup ()
"Setup hook function for Emacs Lisp files and Semantic."
;; This is here mostly to get this file loaded when a .el file is
;; loaded into Emacs.
)
(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
@ -960,6 +963,12 @@ ELisp variables can be pretty long, so track this one too.")
'(require 'semantic/db-el)
)
(provide 'semantic/bovine/el)
;; Local variables:
;; generated-autoload-file: "../loaddefs.el"
;; generated-autoload-load-name: "semantic/bovine/el"
;; End:
;;; semantic/bovine/el.el ends here

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

@ -1667,7 +1667,7 @@ Display mechanism using tooltip for a list of possible completions.")
(setq msg "...")))
((eq mode 'verbose)
;; Always show extended match set.
(oset obj max-tags semantic-displayor-tooltip-max-tags)
(oset obj max-tags-initial semantic-displayor-tooltip-max-tags)
(setq max-tags semantic-displayor-tooltip-max-tags)))
(unless msg
(oset obj shown t)

83
lisp/cedet/semantic/ctxt.el
View file

@ -357,6 +357,87 @@ beginning and end of a command."
(def-edebug-spec semantic-with-buffer-narrowed-to-command
(def-body))))
(define-overloadable-function semantic-ctxt-end-of-symbol (&optional point)
"Move point to the end of the current symbol under POINT.
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.")
(defun semantic-ctxt-end-of-symbol-default (&optional point)
"Move poin to the end of the current symbol under POINT.
This will move past type/field names when applicable.
Depends on `semantic-type-relation-separator-character', and will
work on C like languages."
(if point (goto-char point))
(let* ((fieldsep1 (mapconcat (lambda (a) (regexp-quote a))
semantic-type-relation-separator-character
"\\|"))
;; NOTE: The [ \n] expression below should used \\s-, but that
;; doesn't work in C since \n means end-of-comment, and isn't
;; really whitespace.
(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)"))
(case-fold-search semantic-case-fold)
(continuesearch t)
(end nil)
)
(with-syntax-table semantic-lex-syntax-table
(cond ((looking-at "\\w\\|\\s_")
;; In the middle of a symbol, move to the end.
(forward-sexp 1))
((looking-at fieldsep1)
;; We are in a fine spot.. do nothing.
nil
)
((save-excursion
(and (condition-case nil
(progn (forward-sexp -1)
(forward-sexp 1)
t)
(error nil))
(looking-at fieldsep1)))
(setq symlist (list ""))
(forward-sexp -1)
;; Skip array expressions.
(while (looking-at "\\s(") (forward-sexp -1))
(forward-sexp 1))
)
;; Set the current end marker.
(setq end (point))
;; Cursor is at the safe end of some symbol. Look until we
;; find the logical end of this current complex symbol.
(condition-case nil
(while continuesearch
;; If there are functional arguments, arrays, etc, skip them.
(when (looking-at "\\s(")
(forward-sexp 1))
;; If there is a field separator, then skip that, plus
;; the next expected symbol.
(if (not (looking-at fieldsep1))
;; We hit the end.
(error nil)
;; Skip the separator and the symbol.
(goto-char (match-end 0))
(if (looking-at "\\w\\|\\s_")
;; Skip symbols
(forward-sexp 1)
;; No symbol, exit the search...
(setq continuesearch nil))
(setq end (point)))
;; Cont...
)
;; Restore position if we go to far....
(error (goto-char end)) )
)))
(define-overloadable-function semantic-ctxt-current-symbol (&optional point)
"Return the current symbol the cursor is on at POINT in a list.
@ -391,7 +472,7 @@ Depends on `semantic-type-relation-separator-character'."
;; In the middle of a symbol, move to the end.
(forward-sexp 1))
((looking-at fieldsep1)
;; We are in a find spot.. do nothing.
;; We are in a fine spot.. do nothing.
nil
)
((save-excursion

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

@ -899,7 +899,7 @@ If file does not have tags available, and DONTLOAD is nil,
then load the tags for FILE, and create a new table object for it.
DONTLOAD does not affect the creation of new database objects."
;; (message "Object Translate: %s" file)
(when (and file (file-exists-p file))
(when (and file (file-exists-p file) (file-regular-p file))
(let* ((default-directory (file-name-directory file))
(tab (semanticdb-file-table-object-from-hash file))
(fullfile nil))

44
lisp/cedet/semantic/decorate/mode.el
View file

@ -64,6 +64,14 @@ add items to this list."
"Return the STYLE's highlighter function."
(intern (format "%s-highlight" style)))
(defsubst semantic-decorate-style-predicate-default (style)
"Return the STYLE's predicate function."
(intern (format "%s-p-default" style)))
(defsubst semantic-decorate-style-highlighter-default (style)
"Return the STYLE's highlighter function."
(intern (format "%s-highlight-default" style)))
;;; Base decoration API
;;
(defsubst semantic-decoration-p (object)
@ -265,8 +273,6 @@ minor mode is enabled."
(semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook)
(add-hook 'semantic-after-toplevel-cache-change-hook
'semantic-decorate-tags-after-full-reparse nil t)
;; Decorate includes by default
(require 'semantic/decorate/include)
;; 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)))
@ -325,6 +331,8 @@ Return non-nil if the decoration style is enabled."
(flag (if arg
(> (prefix-numeric-value arg) 0)
(not (cdr style)))))
(when (null style)
(error "Unknown decoration style %s" name))
(unless (eq (cdr style) flag)
;; Store the new flag.
(setcdr style flag)
@ -368,7 +376,8 @@ DOC is a documentation string describing the decoration style NAME.
It is appended to auto-generated doc strings.
An Optional list of FLAGS can also be specified. Flags are:
:enabled <value> - specify the default enabled value for NAME.
:load <value> - specify a feature (as a string) with the rest of
the definition for decoration mode NAME.
This defines two new overload functions respectively called `NAME-p'
and `NAME-highlight', for which you must provide a default
@ -386,9 +395,14 @@ To add other kind of decorations on a tag, `NAME-highlight' must use
decoration API found in this library."
(let ((predicate (semantic-decorate-style-predicate name))
(highlighter (semantic-decorate-style-highlighter name))
(predicatedef (semantic-decorate-style-predicate-default name))
(highlighterdef (semantic-decorate-style-highlighter-default name))
(defaultenable (if (plist-member flags :enabled)
(plist-get flags :enabled)
t))
(loadfile (if (plist-member flags :load)
(plist-get flags :load)
nil))
)
`(progn
;; Clear the menu cache so that new items are added when
@ -408,7 +422,19 @@ decoration API found in this library."
(add-to-list 'semantic-decoration-styles
(cons ',(symbol-name name)
,defaultenable))
)))
;; If there is a load file, then create the autload tokens for
;; those functions to load the token, but only if the fsym
;; doesn't exist yet.
(when (stringp ,loadfile)
(unless (fboundp ',predicatedef)
(autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG."
nil 'function))
(unless (fboundp ',highlighterdef)
(autoload ',highlighterdef ',loadfile "Decorate TAG."
nil 'function))
))
))
;;; Predefined decoration styles
;;
@ -514,6 +540,16 @@ Use a primary decoration."
(semantic-set-tag-face
tag 'semantic-decoration-on-protected-members-face))
;;; Decoration Modes in other files
;;
(define-semantic-decoration-style semantic-decoration-on-includes
"Highlight class members that are includes.
This mode provides a nice context menu on the include statements."
:enabled t
:load "semantic/decorate/include")
(provide 'semantic/decorate/mode)
;; Local variables:

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

@ -146,7 +146,7 @@ Lays claim to all -by.el, and -wy.el files."
(let* ((package (semantic-grammar-create-package))
(fname (progn (string-match ".*/\\(.+\\.el\\)" package)
(match-string 1 package)))
(src (with-current-buffer fname (buffer-file-name)))
(src (ede-expand-filename obj fname))
(csrc (concat (file-name-sans-extension src) ".elc")))
(if (< emacs-major-version 24)
;; Does not have `byte-recompile-file'

5
lisp/cedet/semantic/edit.el
View file

@ -141,8 +141,9 @@ Argument START, END, and LENGTH specify the bounds of the change."
(setq semantic-unmatched-syntax-cache-check t)
(let ((inhibit-point-motion-hooks t)
)
(run-hook-with-args 'semantic-change-functions start end length)
))
(save-match-data
(run-hook-with-args 'semantic-change-functions start end length)
)))
(defun semantic-changes-in-region (start end &optional buffer)
"Find change overlays which exist in whole or in part between START and END.

54
lisp/cedet/semantic/idle.el
View file

@ -434,16 +434,27 @@ datasets."
(defun semantic-idle-scheduler-work-parse-neighboring-files ()
"Parse all the files in similar directories to buffers being edited."
;; Let's check to see if EDE matters.
(let ((ede-auto-add-method 'never))
(dolist (a auto-mode-alist)
(when (eq (cdr a) major-mode)
(dolist (file (directory-files default-directory t (car a) t))
(semantic-throw-on-input 'parsing-mode-buffers)
(save-excursion
(semanticdb-file-table-object file)
))))
))
;; Let's tell EDE to ignore all the files we're about to load
(let ((ede-auto-add-method 'never)
(matching-auto-mode-patterns nil))
;; Collect all patterns matching files of the same mode we edit.
(mapc (lambda (pat) (and (eq (cdr pat) major-mode)
(push (car pat) matching-auto-mode-patterns)))
auto-mode-alist)
;; Loop over all files, and if one matches our mode, we force its
;; table to load.
(dolist (file (directory-files default-directory t ".*" t))
(catch 'found
(mapc (lambda (pat)
(semantic-throw-on-input 'parsing-mode-buffers)
;; We use string-match instead of passing the pattern
;; into directory files, because some patterns don't
;; work with directory files.
(and (string-match pat file)
(save-excursion
(semanticdb-file-table-object file))
(throw 'found t)))
matching-auto-mode-patterns)))))
;;; REPARSING
@ -840,17 +851,18 @@ visible, then highlight it."
)
(cond ((semantic-overlay-p region)
(with-current-buffer (semantic-overlay-buffer region)
(goto-char (semantic-overlay-start region))
(when (pos-visible-in-window-p
(point) (get-buffer-window (current-buffer) 'visible))
(if (< (semantic-overlay-end region) (point-at-eol))
(pulse-momentary-highlight-overlay
region semantic-idle-symbol-highlight-face)
;; Not the same
(pulse-momentary-highlight-region
(semantic-overlay-start region)
(point-at-eol)
semantic-idle-symbol-highlight-face)))
(save-excursion
(goto-char (semantic-overlay-start region))
(when (pos-visible-in-window-p
(point) (get-buffer-window (current-buffer) 'visible))
(if (< (semantic-overlay-end region) (point-at-eol))
(pulse-momentary-highlight-overlay
region semantic-idle-symbol-highlight-face)
;; Not the same
(pulse-momentary-highlight-region
(semantic-overlay-start region)
(point-at-eol)
semantic-idle-symbol-highlight-face))))
))
((vectorp region)
(let ((start (aref region 0))

14
lisp/cedet/semantic/wisent/python.el
View file

@ -485,6 +485,20 @@ Return a list as per `semantic-ctxt-current-symbol'.
Return nil if there is nothing relevant."
nil)
;;; Tag Formatting
;;
(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."
(cond ((semantic-tag-of-class-p tag 'code)
;; Just take the first line.
(let ((name (semantic-tag-name tag)))
(when (string-match "\n" name)
(setq name (substring name 0 (match-beginning 0))))
name))
(t
(semantic-format-tag-abbreviate-default tag parent color))))
;;; Enable Semantic in `python-mode'.
;;

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

@ -200,10 +200,11 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
"Compile a semantic recode template file into a mode-local variable."
(interactive)
(unless (semantic-active-p)
(error "You have to activate semantic-mode to compile SRecode templates."))
(error "You have to activate semantic-mode to compile SRecode templates"))
(require 'srecode/insert)
(message "Compiling template %s..."
(file-name-nondirectory (buffer-file-name)))
(when (called-interactively-p 'interactive)
(message "Compiling template %s..."
(file-name-nondirectory (buffer-file-name))))
(let ((tags (semantic-fetch-tags))
(tag nil)
(class nil)
@ -288,10 +289,11 @@ 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.
(message "%d templates compiled for %s"
(length table) mode)
(when (called-interactively-p 'interactive)
(message "%d templates compiled for %s"
(length table) mode))
;;
;; APPLY TO MODE
@ -316,12 +318,14 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(if (stringp project)
(setq priority (+ 50 defaultdelta))
(setq priority (+ 80 defaultdelta))))
(message "Templates %s has estimated priority of %d"
(file-name-nondirectory (buffer-file-name))
priority))
(message "Compiling templates %s priority %d... done!"
(file-name-nondirectory (buffer-file-name))
priority))
(when (called-interactively-p 'interactive)
(message "Templates %s has estimated priority of %d"
(file-name-nondirectory (buffer-file-name))
priority)))
(when (called-interactively-p 'interactive)
(message "Compiling templates %s priority %d... done!"
(file-name-nondirectory (buffer-file-name))
priority)))
;; Save it up!
(srecode-compile-template-table table mode priority application framework project vars)

6
lisp/cedet/srecode/srt-wy.el
View file

@ -131,6 +131,10 @@
((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))))
@ -290,8 +294,8 @@ It ignores whitespace, newlines and comments."
srecode-template-separator-block
srecode-template-wy--<keyword>-keyword-analyzer
srecode-template-property-analyzer
srecode-template-wy--<symbol>-regexp-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

1
lisp/emacs-lisp/eieio-base.el
View file

@ -31,6 +31,7 @@
;;; Code:
(require 'eieio)
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
;;; eieio-instance-inheritor
;;

2264
lisp/emacs-lisp/eieio-core.el Normal file
View file

File diff suppressed because it is too large Load diff

2234
lisp/emacs-lisp/eieio.el
View file

File diff suppressed because it is too large Load diff

9
lisp/gnus/ChangeLog
View file

@ -1,3 +1,12 @@
2013-06-02 David Engster <deng@randomsample.de>
* registry.el (initialize-instance, registry-lookup)
(registry-lookup-breaks-before-lexbind, registry-lookup-secondary)
(registry-lookup-secondary-value, registry-search, registry-delete)
(registry-insert, registry-reindex, registry-size, registry-prune): Do
not wrap methods in `eval-and-compile'. This breaks due to latest
changes in EIEIO (introduction of eieio-core.el).
2013-05-30 Glenn Morris <rgm@gnu.org>
* nnmail.el (nnmail-fancy-expiry-target):

346
lisp/gnus/registry.el
View file

@ -119,60 +119,59 @@
:type hash-table
:documentation "The data hashtable.")))
(eval-and-compile
(defmethod initialize-instance :AFTER ((this registry-db) slots)
"Set value of data slot of THIS after initialization."
(with-slots (data tracker) this
(unless (member :data slots)
(setq data
(make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)))
(unless (member :tracker slots)
(setq tracker (make-hash-table :size 100 :rehash-size 2.0)))))
(defmethod initialize-instance :AFTER ((this registry-db) slots)
"Set value of data slot of THIS after initialization."
(with-slots (data tracker) this
(unless (member :data slots)
(setq data
(make-hash-table :size 10000 :rehash-size 2.0 :test 'equal)))
(unless (member :tracker slots)
(setq tracker (make-hash-table :size 100 :rehash-size 2.0)))))
(defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
(defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
(let ((data (oref db :data)))
(delq nil
(mapcar
(lambda (k)
(when (gethash k data)
(list k (gethash k data))))
keys))))
(let ((data (oref db :data)))
(delq nil
(mapcar
(lambda (k)
(when (gethash k data)
(list k (gethash k data))))
keys))))
(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
(let ((data (oref db :data)))
(delq nil
(loop for key in keys
when (gethash key data)
collect (list key (gethash key data))))))
(let ((data (oref db :data)))
(delq nil
(loop for key in keys
when (gethash key data)
collect (list key (gethash key data))))))
(defmethod registry-lookup-secondary ((db registry-db) tracksym
&optional create)
"Search for TRACKSYM in the registry-db THIS.
(defmethod registry-lookup-secondary ((db registry-db) tracksym
&optional create)
"Search for TRACKSYM in the registry-db THIS.
When CREATE is not nil, create the secondary index hashtable if needed."
(let ((h (gethash tracksym (oref db :tracker))))
(if h
h
(when create
(puthash tracksym
(make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
(oref db :tracker))
(gethash tracksym (oref db :tracker))))))
(let ((h (gethash tracksym (oref db :tracker))))
(if h
h
(when create
(puthash tracksym
(make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
(oref db :tracker))
(gethash tracksym (oref db :tracker))))))
(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
"Search for TRACKSYM with value VAL in the registry-db THIS.
(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
"Search for TRACKSYM with value VAL in the registry-db THIS.
When SET is not nil, set it for VAL (use t for an empty list)."
;; either we're asked for creation or there should be an existing index
(when (or set (registry-lookup-secondary db tracksym))
;; set the entry if requested,
(when set
(puthash val (if (eq t set) '() set)
(registry-lookup-secondary db tracksym t)))
(gethash val (registry-lookup-secondary db tracksym)))))
;; either we're asked for creation or there should be an existing index
(when (or set (registry-lookup-secondary db tracksym))
;; set the entry if requested,
(when set
(puthash val (if (eq t set) '() set)
(registry-lookup-secondary db tracksym t)))
(gethash val (registry-lookup-secondary db tracksym))))
(defun registry--match (mode entry check-list)
;; for all members
@ -194,166 +193,165 @@ When SET is not nil, set it for VAL (use t for an empty list)."
(or found
(registry--match mode entry (cdr-safe check-list))))))
(eval-and-compile
(defmethod registry-search ((db registry-db) &rest spec)
"Search for SPEC across the registry-db THIS.
(defmethod registry-search ((db registry-db) &rest spec)
"Search for SPEC across the registry-db THIS.
For example calling with :member '(a 1 2) will match entry '((a 3 1)).
Calling with :all t (any non-nil value) will match all.
Calling with :regex '\(a \"h.llo\") will match entry '((a \"hullo\" \"bye\").
The test order is to check :all first, then :member, then :regex."
(when db
(let ((all (plist-get spec :all))
(member (plist-get spec :member))
(regex (plist-get spec :regex)))
(loop for k being the hash-keys of (oref db :data)
using (hash-values v)
when (or
;; :all non-nil returns all
all
;; member matching
(and member (registry--match :member v member))
;; regex matching
(and regex (registry--match :regex v regex)))
collect k))))
(when db
(let ((all (plist-get spec :all))
(member (plist-get spec :member))
(regex (plist-get spec :regex)))
(loop for k being the hash-keys of (oref db :data)
using (hash-values v)
when (or
;; :all non-nil returns all
all
;; member matching
(and member (registry--match :member v member))
;; regex matching
(and regex (registry--match :regex v regex)))
collect k))))
(defmethod registry-delete ((db registry-db) keys assert &rest spec)
"Delete KEYS from the registry-db THIS.
(defmethod registry-delete ((db registry-db) keys assert &rest spec)
"Delete KEYS from the registry-db THIS.
If KEYS is nil, use SPEC to do a search.
Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
(let* ((data (oref db :data))
(keys (or keys
(apply 'registry-search db spec)))
(tracked (oref db :tracked)))
(let* ((data (oref db :data))
(keys (or keys
(apply 'registry-search db spec)))
(tracked (oref db :tracked)))
(dolist (key keys)
(let ((entry (gethash key data)))
(when assert
(assert entry nil
"Key %s does not exists in database" key))
;; clean entry from the secondary indices
(dolist (tr tracked)
;; is this tracked symbol indexed?
(when (registry-lookup-secondary db tr)
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value
db tr val)))
(when (member key value-keys)
;; override the previous value
(registry-lookup-secondary-value
db tr val
;; with the indexed keys MINUS the current key
;; (we pass t when the list is empty)
(or (delete key value-keys) t)))))))
(remhash key data)))
keys))
(dolist (key keys)
(let ((entry (gethash key data)))
(when assert
(assert entry nil
"Key %s does not exists in database" key))
;; clean entry from the secondary indices
(dolist (tr tracked)
;; is this tracked symbol indexed?
(when (registry-lookup-secondary db tr)
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value
db tr val)))
(when (member key value-keys)
;; override the previous value
(registry-lookup-secondary-value
db tr val
;; with the indexed keys MINUS the current key
;; (we pass t when the list is empty)
(or (delete key value-keys) t)))))))
(remhash key data)))
keys))
(defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
(defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
This is the key count of the :data slot."
(hash-table-count (oref db :data)))
(hash-table-count (oref db :data)))
(defmethod registry-full ((db registry-db))
"Checks if registry-db THIS is full."
(>= (registry-size db)
(oref db :max-hard)))
(defmethod registry-full ((db registry-db))
"Checks if registry-db THIS is full."
(>= (registry-size db)
(oref db :max-hard)))
(defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
(defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
Updates the secondary ('tracked') indices as well.
Errors out if the key exists already."
(assert (not (gethash key (oref db :data))) nil
"Key already exists in database")
(assert (not (gethash key (oref db :data))) nil
"Key already exists in database")
(assert (not (registry-full db))
nil
"registry max-hard size limit reached")
(assert (not (registry-full db))
nil
"registry max-hard size limit reached")
;; store the entry
(puthash key entry (oref db :data))
;; store the entry
(puthash key entry (oref db :data))
;; store the secondary indices
;; store the secondary indices
(dolist (tr (oref db :tracked))
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(pushnew key value-keys :test 'equal)
(registry-lookup-secondary-value db tr val value-keys))))
entry)
(defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
(expected (* (length (oref db :tracked)) (registry-size db))))
(dolist (tr (oref db :tracked))
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(pushnew key value-keys :test 'equal)
(registry-lookup-secondary-value db tr val value-keys))))
entry)
(let (values)
(maphash
(lambda (key v)
(incf count)
(when (and (< 0 expected)
(= 0 (mod count 1000)))
(message "reindexing: %d of %d (%.2f%%)"
count expected (/ (* 100 count) expected)))
(dolist (val (cdr-safe (assq tr v)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(push key value-keys)
(registry-lookup-secondary-value db tr val value-keys))))
(oref db :data))))))
(defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
(expected (* (length (oref db :tracked)) (registry-size db))))
(dolist (tr (oref db :tracked))
(let (values)
(maphash
(lambda (key v)
(incf count)
(when (and (< 0 expected)
(= 0 (mod count 1000)))
(message "reindexing: %d of %d (%.2f%%)"
count expected (/ (* 100 count) expected)))
(dolist (val (cdr-safe (assq tr v)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(push key value-keys)
(registry-lookup-secondary-value db tr val value-keys))))
(oref db :data))))))
(defmethod registry-prune ((db registry-db) &optional sortfun)
"Prunes the registry-db object THIS.
(defmethod registry-prune ((db registry-db) &optional sortfun)
"Prunes the registry-db object THIS.
Removes only entries without the :precious keys if it can,
then removes oldest entries first.
Returns the number of deleted entries.
If SORTFUN is given, tries to keep entries that sort *higher*.
SORTFUN is passed only the two keys so it must look them up directly."
(dolist (collector '(registry-prune-soft-candidates
registry-prune-hard-candidates))
(let* ((size (registry-size db))
(collected (funcall collector db))
(limit (nth 0 collected))
(candidates (nth 1 collected))
;; sort the candidates if SORTFUN was given
(candidates (if sortfun (sort candidates sortfun) candidates))
(candidates-count (length candidates))
;; are we over max-soft?
(prune-needed (> size limit)))
(dolist (collector '(registry-prune-soft-candidates
registry-prune-hard-candidates))
(let* ((size (registry-size db))
(collected (funcall collector db))
(limit (nth 0 collected))
(candidates (nth 1 collected))
;; sort the candidates if SORTFUN was given
(candidates (if sortfun (sort candidates sortfun) candidates))
(candidates-count (length candidates))
;; are we over max-soft?
(prune-needed (> size limit)))
;; while we have more candidates than we need to remove...
(while (and (> candidates-count (- size limit)) candidates)
(decf candidates-count)
(setq candidates (cdr candidates)))
;; while we have more candidates than we need to remove...
(while (and (> candidates-count (- size limit)) candidates)
(decf candidates-count)
(setq candidates (cdr candidates)))
(registry-delete db candidates nil)
(length candidates))))
(registry-delete db candidates nil)
(length candidates))))
(defmethod registry-prune-soft-candidates ((db registry-db))
"Collects pruning candidates from the registry-db object THIS.
(defmethod registry-prune-soft-candidates ((db registry-db))
"Collects pruning candidates from the registry-db object THIS.
Proposes only entries without the :precious keys."
(let* ((precious (oref db :precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
(data (oref db :data))
(limit (oref db :max-soft))
(candidates (loop for k being the hash-keys of data
using (hash-values v)
when (notany precious-p v)
collect k)))
(list limit candidates)))
(let* ((precious (oref db :precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
(data (oref db :data))
(limit (oref db :max-soft))
(candidates (loop for k being the hash-keys of data
using (hash-values v)
when (notany precious-p v)
collect k)))
(list limit candidates)))
(defmethod registry-prune-hard-candidates ((db registry-db))
"Collects pruning candidates from the registry-db object THIS.
(defmethod registry-prune-hard-candidates ((db registry-db))
"Collects pruning candidates from the registry-db object THIS.
Proposes any entries over the max-hard limit minus size * prune-factor."
(let* ((data (oref db :data))
;; prune to (size * prune-factor) below the max-hard limit so
;; we're not pruning all the time
(limit (max 0 (- (oref db :max-hard)
(* (registry-size db) (oref db :prune-factor)))))
(candidates (loop for k being the hash-keys of data
collect k)))
(list limit candidates))))
(let* ((data (oref db :data))
;; prune to (size * prune-factor) below the max-hard limit so
;; we're not pruning all the time
(limit (max 0 (- (oref db :max-hard)
(* (registry-size db) (oref db :prune-factor)))))
(candidates (loop for k being the hash-keys of data
collect k)))
(list limit candidates)))
(provide 'registry)
;;; registry.el ends here