mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Synch SRecode to CEDET 1.0.

Browse Source 
* lisp/cedet/cedet.el (cedet-version):
* lisp/cedet/srecode.el (srecode-version): Bump version to 1.0.

* lisp/cedet/pulse.el (pulse-momentary-highlight-overlay): If pulse-flag is
'never, disable all pulsing.

* lisp/cedet/srecode/compile.el (srecode-compile-templates): Fix directory
compare of built-in templates.  Give built-ins lower piority.
Support special variable "project".
(srecode-compile-template-table): Set :project slot of new tables.
(srecode-compile-one-template-tag): Use
srecode-create-dictionaries-from-tags.

* lisp/cedet/srecode/cpp.el (srecode-cpp): New defgroup.
(srecode-cpp-namespaces): New option.
(srecode-semantic-handle-:using-namespaces)
(srecode-cpp-apply-templates): New functions.
(srecode-semantic-apply-tag-to-dict): Handle template parameters
by calling `srecode-cpp-apply-templates'.

* lisp/cedet/srecode/dictionary.el (srecode-dictionary-add-template-table):
Do not add variables in tables not for the current project.
(srecode-compound-toString): Handle cases where the default value
is another compound value.
(srecode-dictionary-lookup-name): New optional argument
NON-RECURSIVE, which inhibits visiting dictionary parents.
(srecode-dictionary-add-section-dictionary)
(srecode-dictionary-merge): New optional argument FORCE adds
values even if an identically named entry exists.
(srecode-dictionary-add-entries): New method.
(srecode-create-dictionaries-from-tags): New function.

* lisp/cedet/srecode/fields.el (srecode-fields-exit-confirmation): New option.
(srecode-field-exit-ask): Use it.

* lisp/cedet/srecode/find.el (srecode-template-get-table)
(srecode-template-get-table-for-binding)
(srecode-all-template-hash): Skip if not in current project.
(srecode-template-table-in-project-p): New method.

* lisp/cedet/srecode/getset.el (srecode-insert-getset): Force tag table
update.  Don't query the class if it is empty.

* lisp/cedet/srecode/insert.el (srecode-insert-fcn): Merge template
dictionary before resolving arguments.
(srecode-insert-method-helper): Add error checking to make sure
that we only have dictionaries.
(srecode-insert-method): Check template nesting depth when using
point inserter override.
(srecode-insert-method): Install override with depth limit.

* lisp/cedet/srecode/map.el (srecode-map-update-map): Make map loading more
robust.

* lisp/cedet/srecode/mode.el (srecode-bind-insert): Call
srecode-load-tables-for-mode.
(srecode-minor-mode-templates-menu): Do not list templates that
are not in the current project.
(srecode-menu-bar): Add binding for srecode-macro-help.

* lisp/cedet/srecode/table.el (srecode-template-table): Add :project slot.
(srecode-dump): Dump it.

* lisp/cedet/srecode/texi.el (srecode-texi-insert-tag-as-doc): New function.
(semantic-insert-foreign-tag): Use it.
This commit is contained in:
Eric M. Ludlam 2010-09-21 18:11:23 -04:00 committed by Chong Yidong
parent fbb3da770f
commit b974955453
18 changed files with 722 additions and 309 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
etc/ChangeLog
View File

@ -1,3 +1,7 @@
2010-09-21 Eric Ludlam <zappo@gnu.org>
* srecode/java.srt: Make NAME be a prompt.
2010-08-22 Alex Harsanyi <harsanyi@mac.com> (tiny change)
* emacs3.py: Import imp module and use it (Bug#5756).

2
etc/srecode/java.srt
View File

@ -83,7 +83,7 @@ public Class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}impl
template include :blank
"An include statement."
----
import {{NAME}};
import {{?NAME}};
----
context misc

70
lisp/cedet/ChangeLog
View File

@ -1,3 +1,73 @@
2010-09-21 Eric Ludlam <zappo@gnu.org>
Synch SRecode to CEDET 1.0.
* pulse.el (pulse-momentary-highlight-overlay): If pulse-flag is
'never, disable all pulsing.
* cedet.el (cedet-version):
* srecode.el (srecode-version): Bump version to 1.0.
* srecode/texi.el (srecode-texi-insert-tag-as-doc): New function.
(semantic-insert-foreign-tag): Use it.
* srecode/mode.el (srecode-bind-insert): Call
srecode-load-tables-for-mode.
(srecode-minor-mode-templates-menu): Do not list templates that
are not in the current project.
(srecode-menu-bar): Add binding for srecode-macro-help.
* srecode/table.el (srecode-template-table): Add :project slot.
(srecode-dump): Dump it.
* srecode/map.el (srecode-map-update-map): Make map loading more
robust.
* srecode/insert.el (srecode-insert-fcn): Merge template
dictionary before resolving arguments.
(srecode-insert-method-helper): Add error checking to make sure
that we only have dictionaries.
(srecode-insert-method): Check template nesting depth when using
point inserter override.
(srecode-insert-method): Install override with depth limit.
* srecode/getset.el (srecode-insert-getset): Force tag table
update. Don't query the class if it is empty.
* srecode/find.el (srecode-template-get-table)
(srecode-template-get-table-for-binding)
(srecode-all-template-hash): Skip if not in current project.
(srecode-template-table-in-project-p): New method.
* srecode/fields.el (srecode-fields-exit-confirmation): New option.
(srecode-field-exit-ask): Use it.
* srecode/dictionary.el (srecode-dictionary-add-template-table):
Do not add variables in tables not for the current project.
(srecode-compound-toString): Handle cases where the default value
is another compound value.
(srecode-dictionary-lookup-name): New optional argument
NON-RECURSIVE, which inhibits visiting dictionary parents.
(srecode-dictionary-add-section-dictionary)
(srecode-dictionary-merge): New optional argument FORCE adds
values even if an identically named entry exists.
(srecode-dictionary-add-entries): New method.
(srecode-create-dictionaries-from-tags): New function.
* srecode/cpp.el (srecode-cpp): New defgroup.
(srecode-cpp-namespaces): New option.
(srecode-semantic-handle-:using-namespaces)
(srecode-cpp-apply-templates): New functions.
(srecode-semantic-apply-tag-to-dict): Handle template parameters
by calling `srecode-cpp-apply-templates'.
* srecode/compile.el (srecode-compile-templates): Fix directory
compare of built-in templates. Give built-ins lower piority.
Support special variable "project".
(srecode-compile-template-table): Set :project slot of new tables.
(srecode-compile-one-template-tag): Use
srecode-create-dictionaries-from-tags.
2010-09-21 Eric Ludlam <zappo@gnu.org>
Synch EDE to CEDET 1.0.

14
lisp/cedet/cedet.el
View File

@ -36,19 +36,19 @@
(declare-function inversion-find-version "inversion")
(defconst cedet-version "1.0pre7"
(defconst cedet-version "1.0"
"Current version of CEDET.")
(defconst cedet-packages
`(
;;PACKAGE MIN-VERSION
(cedet ,cedet-version)
(eieio "1.2")
(semantic "2.0pre7")
(srecode "1.0pre7")
(ede "1.0pre7")
(speedbar "1.0.3"))
"Table of CEDET packages to install.")
(eieio "1.3")
(semantic "2.0")
(srecode "1.0")
(ede "1.0")
(speedbar "1.0"))
"Table of CEDET packages installed.")
(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu")
(let ((map (make-sparse-keymap "CEDET menu")))

44
lisp/cedet/pulse.el
View File

@ -3,6 +3,7 @@
;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 1.0
;; This file is part of GNU Emacs.
@ -57,10 +58,14 @@
(error nil)))
(defcustom pulse-flag (pulse-available-p)
"*Non-nil means to pulse the overlay face for momentary highlighting.
Pulsing involves a bright highlight that slowly shifts to the background
color. Non-nil just means to highlight with an unchanging color for a short
time.
"Whether to use pulsing for momentary highlighting.
Pulsing involves a bright highlight that slowly shifts to the
background color.
If the value is nil, highlight with an unchanging color until a
key is pressed.
If the value is `never', do no coloring at all.
Any other value means to the default pulsing behavior.
If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
this flag is ignored."
@ -178,22 +183,23 @@ Be sure to call `pulse-reset-face' after calling pulse."
Optional argument FACE specifies the fact to do the highlighting."
(overlay-put o 'original-face (overlay-get o 'face))
(add-to-list 'pulse-momentary-overlay o)
(if (or (not pulse-flag) (not (pulse-available-p)))
;; Provide a face... clear on next command
(progn
(overlay-put o 'face (or face 'pulse-highlight-start-face))
(add-hook 'pre-command-hook
'pulse-momentary-unhighlight)
)
;; pulse it.
(unwind-protect
(if (eq pulse-flag 'never)
nil
(if (or (not pulse-flag) (not (pulse-available-p)))
;; Provide a face... clear on next command
(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))))
(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)))))
(defun pulse-momentary-unhighlight ()
"Unhighlight a line recently highlighted."

2
lisp/cedet/srecode.el
View File

@ -40,7 +40,7 @@
(require 'mode-local)
(load "srecode/loaddefs" nil 'nomessage)
(defvar srecode-version "1.0pre7"
(defvar srecode-version "1.0"
"Current version of the Semantic Recoder.")
;;; Code:

129
lisp/cedet/srecode/compile.el
View File

@ -35,19 +35,17 @@
(require 'semantic)
(require 'eieio)
(require 'eieio-base)
(require 'srecode)
(require 'srecode/table)
(require 'srecode/dictionary)
(declare-function srecode-template-inserter-newline-child-p "srecode/insert"
t t)
(declare-function srecode-create-section-dictionary "srecode/dictionary")
(declare-function srecode-dictionary-compound-variable "srecode/dictionary")
;;; Code:
;;; Template Class
;;
;; Templatets describe a patter of text that can be inserted into a
;; Templates describe a pattern of text that can be inserted into a
;; buffer.
;;
(defclass srecode-template (eieio-named)
@ -213,6 +211,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(mode nil)
(application nil)
(priority nil)
(project nil)
(vars nil)
)
@ -256,6 +255,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(setq application (read firstvalue)))
((string= name "priority")
(setq priority (read firstvalue)))
((string= name "project")
(setq project firstvalue))
(t
;; Assign this into some table of variables.
(setq vars (cons (cons name firstvalue) vars))
@ -297,12 +298,19 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
;; Calculate priority
;;
(if (not priority)
(let ((d (file-name-directory (buffer-file-name)))
(sd (file-name-directory (locate-library "srecode")))
(defaultdelta (if (eq mode 'default) 20 0)))
(if (string= d sd)
(setq priority (+ 80 defaultdelta))
(setq priority (+ 30 defaultdelta)))
(let ((d (expand-file-name (file-name-directory (buffer-file-name))))
(sd (expand-file-name (file-name-directory (locate-library "srecode"))))
(defaultdelta (if (eq mode 'default) 0 10)))
;; @TODO : WHEN INTEGRATING INTO EMACS
;; The location of Emacs default templates needs to be specified
;; here to also have a lower priority.
(if (string-match (concat "^" sd) d)
(setq priority (+ 30 defaultdelta))
;; If the user created template is for a project, then
;; don't add as much as if it is unique to just some user.
(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))
@ -311,56 +319,56 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
priority))
;; Save it up!
(srecode-compile-template-table table mode priority application vars)
(srecode-compile-template-table table mode priority application project vars)
)
)
(defun srecode-compile-one-template-tag (tag STATE)
"Compile a template tag TAG into an srecode template class.
STATE is the current compile state as an object `srecode-compile-state'."
(require 'srecode/dictionary)
(let* ((context (oref STATE context))
(codeout (srecode-compile-split-code
tag (semantic-tag-get-attribute tag :code)
STATE))
(code (cdr codeout))
(args (semantic-tag-function-arguments tag))
(binding (semantic-tag-get-attribute tag :binding))
(rawdicts (semantic-tag-get-attribute tag :dictionaries))
(sdicts (srecode-create-section-dictionary rawdicts STATE))
(addargs nil)
)
; (message "Compiled %s to %d codes with %d args and %d prompts."
; (semantic-tag-name tag)
; (length code)
; (length args)
; (length prompts))
(while args
(setq addargs (cons (intern (car args)) addargs))
(when (eq (car addargs) :blank)
;; If we have a wrap, then put wrap inserters on both
;; ends of the code.
(setq code (append
(list (srecode-compile-inserter "BLANK"
"\r"
STATE
:secondname nil
:where 'begin))
code
(list (srecode-compile-inserter "BLANK"
"\r"
STATE
:secondname nil
:where 'end))
)))
(setq args (cdr args)))
(defun srecode-compile-one-template-tag (tag state)
"Compile a template tag TAG into a srecode template object.
STATE is the current compile state as an object of class
`srecode-compile-state'."
(let* ((context (oref state context))
(code (cdr (srecode-compile-split-code
tag (semantic-tag-get-attribute tag :code)
state)))
(args (semantic-tag-function-arguments tag))
(binding (semantic-tag-get-attribute tag :binding))
(dict-tags (semantic-tag-get-attribute tag :dictionaries))
(root-dict (when dict-tags
(srecode-create-dictionaries-from-tags
dict-tags state)))
(addargs))
;; Examine arguments.
(dolist (arg args)
(let ((symbol (intern arg)))
(push symbol addargs)
;; If we have a wrap, then put wrap inserters on both ends of
;; the code.
(when (eq symbol :blank)
(setq code (append
(list (srecode-compile-inserter
"BLANK"
"\r"
state
:secondname nil
:where 'begin))
code
(list (srecode-compile-inserter
"BLANK"
"\r"
state
:secondname nil
:where 'end)))))))
;; Construct and return the template object.
(srecode-template (semantic-tag-name tag)
:context context
:args (nreverse addargs)
:dictionary sdicts
:binding binding
:code code)
))
:context context
:args (nreverse addargs)
:dictionary root-dict
:binding binding
:code code))
)
(defun srecode-compile-do-hard-newline-p (comp)
"Examine COMP to decide if the upcoming newline should be hard.
@ -514,12 +522,13 @@ to the inserter constructor."
(if (not new) (error "SRECODE: Unknown macro code %S" key))
new)))
(defun srecode-compile-template-table (templates mode priority application vars)
(defun srecode-compile-template-table (templates mode priority application project vars)
"Compile a list of TEMPLATES into an semantic recode table.
The table being compiled is for MODE, or the string \"default\".
PRIORITY is a numerical value that indicates this tables location
in an ordered search.
APPLICATION is the name of the application these templates belong to.
PROJECT is a directory name which these templates scope to.
A list of defined variables VARS provides a variable table."
(let ((namehash (make-hash-table :test 'equal
:size (length templates)))
@ -549,6 +558,9 @@ A list of defined variables VARS provides a variable table."
(setq lp (cdr lp))))
(when (stringp project)
(setq project (expand-file-name project)))
(let* ((table (srecode-mode-table-new mode (buffer-file-name)
:templates (nreverse templates)
:namehash namehash
@ -556,7 +568,8 @@ A list of defined variables VARS provides a variable table."
:variables vars
:major-mode mode
:priority priority
:application application))
:application application
:project project))
(tmpl (oref table templates)))
;; Loop over all the templates, and xref.
(while tmpl

82
lisp/cedet/srecode/cpp.el
View File

@ -26,6 +26,27 @@
;;; Code:
(require 'srecode)
(require 'srecode/dictionary)
(require 'srecode/semantic)
(require 'semantic/tag)
;;; Customization
;;
(defgroup srecode-cpp nil
"C++-specific Semantic Recoder settings."
:group 'srecode)
(defcustom srecode-cpp-namespaces
'("std" "boost")
"List expansion candidates for the :using-namespaces argument.
A dictionary entry of the named PREFIX_NAMESPACE with the value
NAMESPACE:: is created for each namespace unless the current
buffer contains a using NAMESPACE; statement "
:group 'srecode-cpp
:type '(repeat string))
;;; :cpp ARGUMENT HANDLING
;;
;; When a :cpp argument is required, fill the dictionary with
@ -33,10 +54,6 @@
;;
;; Error if not in a C++ mode.
(require 'srecode)
(require 'srecode/dictionary)
(require 'srecode/semantic)
;;;###autoload
(defun srecode-semantic-handle-:cpp (dict)
"Add macros into the dictionary DICT based on the current c++ file.
@ -59,6 +76,23 @@ HEADER - Shown section if in a header file."
)
)
(defun srecode-semantic-handle-:using-namespaces (dict)
"Add macros into the dictionary DICT based on used namespaces.
Adds the following:
PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'."
(let ((tags (semantic-find-tags-by-class
'using (semantic-fetch-tags))))
(dolist (name srecode-cpp-namespaces)
(let ((variable (format "PREFIX_%s" (upcase name)))
(prefix (format "%s::" name)))
(srecode-dictionary-set-value dict variable prefix)
(dolist (tag tags)
(when (and (eq (semantic-tag-get-attribute tag :kind)
'namespace)
(string= (semantic-tag-name tag) name))
(srecode-dictionary-set-value dict variable ""))))))
)
(define-mode-local-override srecode-semantic-apply-tag-to-dict
c++-mode (tag-wrapper dict)
"Apply C++ specific features from TAG-WRAPPER into DICT.
@ -97,6 +131,7 @@ special behavior for tag of classes include, using and function."
(srecode-semantic-tag (semantic-tag-name value-tag)
:prime value-tag)
value-dict))
;; Discriminate using statements referring to namespaces and
;; types.
(when (eq (semantic-tag-get-attribute tag :kind) 'namespace)
@ -111,7 +146,8 @@ special behavior for tag of classes include, using and function."
;; when they make sense. My best bet would be
;; (semantic-tag-function-parent tag), but it is not there, when
;; the function is defined in the scope of a class.
(let ((member 't)
(let ((member t)
(templates (semantic-tag-get-attribute tag :template))
(modifiers (semantic-tag-modifiers tag)))
;; Add modifiers into the dictionary
@ -120,6 +156,9 @@ special behavior for tag of classes include, using and function."
dict "MODIFIERS")))
(srecode-dictionary-set-value modifier-dict "NAME" modifier)))
;; Add templates into child dictionaries.
(srecode-cpp-apply-templates dict templates)
;; When the function is a member function, it can have
;; additional modifiers.
(when member
@ -133,11 +172,40 @@ special behavior for tag of classes include, using and function."
;; entry.
(when (semantic-tag-get-attribute tag :pure-virtual-flag)
(srecode-dictionary-show-section dict "PURE"))
)
))
)))
;;
;; CLASS
;;
((eq class 'type)
;; For classes, add template parameters.
(when (or (semantic-tag-of-type-p tag "class")
(semantic-tag-of-type-p tag "struct"))
;; Add templates into child dictionaries.
(let ((templates (semantic-tag-get-attribute tag :template)))
(srecode-cpp-apply-templates dict templates))))
))
)
;;; Helper functions
;;
(defun srecode-cpp-apply-templates (dict templates)
"Add section dictionaries for TEMPLATES to DICT."
(when templates
(let ((templates-dict (srecode-dictionary-add-section-dictionary
dict "TEMPLATES")))
(dolist (template templates)
(let ((template-dict (srecode-dictionary-add-section-dictionary
templates-dict "ARGS")))
(srecode-semantic-apply-tag-to-dict
(srecode-semantic-tag (semantic-tag-name template)
:prime template)
template-dict)))))
)
(provide 'srecode/cpp)
;; Local variables:

299
lisp/cedet/srecode/dictionary.el
View File

@ -37,6 +37,7 @@
(declare-function srecode-compile-parse-inserter "srecode/compile")
(declare-function srecode-dump-code-list "srecode/compile")
(declare-function srecode-load-tables-for-mode "srecode/find")
(declare-function srecode-template-table-in-project-p "srecode/find")
(declare-function srecode-insert-code-stream "srecode/insert")
(declare-function data-debug-new-buffer "data-debug")
(declare-function data-debug-insert-object-slots "eieio-datadebug")
@ -157,40 +158,49 @@ buffer's table.
If BUFFER-OR-PARENT is t, then this dictionary should not be
associated with a buffer or parent."
(save-excursion
;; Handle the parent
(let ((parent nil)
(buffer nil)
(origin nil)
(initfrombuff nil))
(cond ((bufferp buffer-or-parent)
(set-buffer buffer-or-parent)
(setq buffer buffer-or-parent
origin (buffer-name buffer-or-parent)
initfrombuff t))
((srecode-dictionary-child-p buffer-or-parent)
(setq parent buffer-or-parent
buffer (oref buffer-or-parent buffer)
origin (concat (object-name buffer-or-parent) " in "
(if buffer (buffer-name buffer)
"no buffer")))
(when buffer
(set-buffer buffer)))
((eq buffer-or-parent t)
(setq buffer nil
origin "Unspecified Origin"))
(t
(setq buffer (current-buffer)
origin (concat "Unspecified. Assume "
(buffer-name buffer))
initfrombuff t)
)
)
(cond
;; Parent is a buffer
((bufferp buffer-or-parent)
(set-buffer buffer-or-parent)
(setq buffer buffer-or-parent
origin (buffer-name buffer-or-parent)
initfrombuff t))
;; Parent is another dictionary
((srecode-dictionary-child-p buffer-or-parent)
(setq parent buffer-or-parent
buffer (oref buffer-or-parent buffer)
origin (concat (object-name buffer-or-parent) " in "
(if buffer (buffer-name buffer)
"no buffer")))
(when buffer
(set-buffer buffer)))
;; No parent
((eq buffer-or-parent t)
(setq buffer nil
origin "Unspecified Origin"))
;; Default to unspecified parent
(t
(setq buffer (current-buffer)
origin (concat "Unspecified. Assume "
(buffer-name buffer))
initfrombuff t)))
;; Create the new dictionary object.
(let ((dict (srecode-dictionary
major-mode
:buffer buffer
:parent parent
:namehash (make-hash-table :test 'equal
:size 20)
:origin origin)))
:buffer buffer
:parent parent
:namehash (make-hash-table :test 'equal
:size 20)
:origin origin)))
;; Only set up the default variables if we are being built
;; directroy for a particular buffer.
(when initfrombuff
@ -211,34 +221,37 @@ associated with a buffer or parent."
TPL is an object representing a compiled template file."
(when tpl
(let ((tabs (oref tpl :tables)))
(require 'srecode/find) ; For srecode-template-table-in-project-p
(while tabs
(let ((vars (oref (car tabs) variables)))
(while vars
(srecode-dictionary-set-value
dict (car (car vars)) (cdr (car vars)))
(setq vars (cdr vars))))
(setq tabs (cdr tabs))))))
(when (srecode-template-table-in-project-p (car tabs))
(let ((vars (oref (car tabs) variables)))
(while vars
(srecode-dictionary-set-value
dict (car (car vars)) (cdr (car vars)))
(setq vars (cdr vars)))))
(setq tabs (cdr tabs))))))
(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value)
"In dictionary DICT, set NAME to have VALUE."
;; Validate inputs
(if (not (stringp name))
(signal 'wrong-type-argument (list name 'stringp)))
(unless (stringp name)
(signal 'wrong-type-argument (list name 'stringp)))
;; Add the value.
(with-slots (namehash) dict
(puthash name value namehash))
)
(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
name &optional show-only)
name &optional show-only force)
"In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.
You can add several dictionaries to the same section macro.
For each dictionary added to a macro, the block of codes in the
template will be repeated.
You can add several dictionaries to the same section entry.
For each dictionary added to a variable, the block of codes in
the template will be repeated.
If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary
if there is already one in place. Also, don't add FIRST/LAST entries.
@ -255,10 +268,11 @@ which will enable SECTIONS to be enabled.
Adding a new dictionary will alter these values in previously
inserted dictionaries."
;; Validate inputs
(if (not (stringp name))
(signal 'wrong-type-argument (list name 'stringp)))
(unless (stringp name)
(signal 'wrong-type-argument (list name 'stringp)))
(let ((new (srecode-create-dictionary dict))
(ov (srecode-dictionary-lookup-name dict name)))
(ov (srecode-dictionary-lookup-name dict name t)))
(when (not show-only)
;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries.
@ -275,7 +289,9 @@ inserted dictionaries."
(srecode-dictionary-show-section new "LAST"))
)
(when (or (not show-only) (null ov))
(when (or force
(not show-only)
(null ov))
(srecode-dictionary-set-value dict name (append ov (list new))))
;; Return the new sub-dictionary.
new))
@ -283,8 +299,9 @@ inserted dictionaries."
(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be exposed."
;; Validate inputs
(if (not (stringp name))
(signal 'wrong-type-argument (list name 'stringp)))
(unless (stringp name)
(signal 'wrong-type-argument (list name 'stringp)))
;; Showing a section is just like making a section dictionary, but
;; with no dictionary values to add.
(srecode-dictionary-add-section-dictionary dict name t)
@ -294,51 +311,120 @@ inserted dictionaries."
"In dictionary DICT, indicate that the section NAME should be hidden."
;; We need to find the has value, and then delete it.
;; Validate inputs
(if (not (stringp name))
(signal 'wrong-type-argument (list name 'stringp)))
(unless (stringp name)
(signal 'wrong-type-argument (list name 'stringp)))
;; Add the value.
(with-slots (namehash) dict
(remhash name namehash))
nil)
(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict)
"Merge into DICT the dictionary entries from OTHERDICT."
(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state)
"Add ENTRIES to DICT.
ENTRIES is a list of even length of dictionary entries to
add. ENTRIES looks like this:
(NAME_1 VALUE_1 NAME_2 VALUE_2 ...)
The following rules apply:
* NAME_N is a string
and for values
* If VALUE_N is t, the section NAME_N is shown.
* If VALUE_N is a string, an ordinary value is inserted.
* If VALUE_N is a dictionary, it is inserted as entry NAME_N.
* Otherwise, a compound variable is created for VALUE_N.
The optional argument STATE has to non-nil when compound values
are inserted. An error is signaled if ENTRIES contains compound
values but STATE is nil."
(while entries
(let ((name (nth 0 entries))
(value (nth 1 entries)))
(cond
;; Value is t; show a section.
((eq value t)
(srecode-dictionary-show-section dict name))
;; Value is a simple string; create an ordinary dictionary
;; entry
((stringp value)
(srecode-dictionary-set-value dict name value))
;; Value is a dictionary; insert as child dictionary.
((srecode-dictionary-child-p value)
(srecode-dictionary-merge
(srecode-dictionary-add-section-dictionary dict name)
value t))
;; Value is some other object; create a compound value.
(t
(unless state
(error "Cannot insert compound values without state."))
(srecode-dictionary-set-value
dict name
(srecode-dictionary-compound-variable
name :value value :state state)))))
(setq entries (nthcdr 2 entries)))
dict)
(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
not modified, even if there are values of the same names in
OTHERDICT."
(when otherdict
(maphash
(lambda (key entry)
;; Only merge in the new values if there was no old value.
;; The new values is only merged in if there was no old value
;; or FORCE is non-nil.
;;
;; This protects applications from being whacked, and basically
;; makes these new section dictionary entries act like
;; "defaults" instead of overrides.
(when (not (srecode-dictionary-lookup-name dict key))
(cond ((and (listp entry) (srecode-dictionary-p (car entry)))
;; A list of section dictionaries.
;; We need to merge them in.
(while entry
(let ((new-sub-dict
(srecode-dictionary-add-section-dictionary
dict key)))
(srecode-dictionary-merge new-sub-dict (car entry)))
(setq entry (cdr entry)))
)
(when (or force
(not (srecode-dictionary-lookup-name dict key t)))
(cond
;; A list of section dictionaries. We need to merge them in.
((and (listp entry)
(srecode-dictionary-p (car entry)))
(dolist (sub-dict entry)
(srecode-dictionary-merge
(srecode-dictionary-add-section-dictionary
dict key t t)
sub-dict force)))
(t
(srecode-dictionary-set-value dict key entry)))
))
;; Other values can be set directly.
(t
(srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash))))
(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name)
"Return information about the current DICT's value for NAME."
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
name of an entry in the dictionary. If such an entry exists, its
value is returned. Otherwise, nil is returned. Normally, the
lookup is recursive in the sense that the parent of DICT is
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'."
(if (not (slot-boundp dict 'namehash))
nil
;; Get the value of this name from the dictionary
(or (with-slots (namehash) dict
(gethash name namehash))
(and (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST")))
(oref dict parent)
(srecode-dictionary-lookup-name (oref dict parent) name))
)))
;; Get the value of this name from the dictionary or its parent
;; unless the lookup should be non-recursive.
(with-slots (namehash parent) dict
(or (gethash name namehash)
(and (not non-recursive)
(not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST")))
parent
(srecode-dictionary-lookup-name parent name)))))
)
(defmethod srecode-root-dictionary ((dict srecode-dictionary))
"For dictionary DICT, return the root dictionary.
@ -431,10 +517,22 @@ inserted with a new editable field.")
(start (point))
(name (oref sti :object-name)))
(if (or (not dv) (string= dv ""))
(insert name)
(insert dv))
(cond
;; No default value.
((not dv) (insert name))
;; A compound value as the default? Recurse.
((srecode-dictionary-compound-value-child-p dv)
(srecode-compound-toString dv function dictionary))
;; A string that is empty? Use the name.
((and (stringp dv) (string= dv ""))
(insert name))
;; Insert strings
((stringp dv) (insert dv))
;; Some other issue
(t
(error "Unknown default value for value %S" name)))
;; Create a field from the inserter.
(srecode-field name :name name
:start start
:end (point)
@ -482,6 +580,53 @@ STATE is the current compiler state."
(setq sectiondicts (cdr sectiondicts)))
new)))
(defun srecode-create-dictionaries-from-tags (tags state)
"Create a dictionary with entries according to TAGS.
TAGS should be in the format produced by the template file
grammar. That is
TAGS = (ENTRY_1 ENTRY_2 ...)
where
ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG
where TAG is a semantic tag of class 'variable. The (NAME ... )
form creates a child dictionary which is stored under the name
NAME. The TAG form creates a value entry or section dictionary
entry whose name is the name of the tag.
STATE is the current compiler state."
(let ((dict (srecode-create-dictionary t))
(entries (apply #'append
(mapcar
(lambda (entry)
(cond
;; Entry is a tag
((semantic-tag-p entry)
(let ((name (semantic-tag-name entry))
(value (semantic-tag-variable-default entry)))
(list name
(if (and (listp value)
(= (length value) 1)
(stringp (car value)))
(car value)
value))))
;; Entry is a nested dictionary
(t
(let ((name (car entry))
(entries (cdr entry)))
(list name
(srecode-create-dictionaries-from-tags
entries state))))))
tags))))
(srecode-dictionary-add-entries
dict entries state)
dict)
)
;;; DUMP DICTIONARY
;;
;; Make a dictionary, and dump it's contents.

16
lisp/cedet/srecode/fields.el
View File

@ -35,6 +35,8 @@
;; Each field has 2 overlays. The second overlay allows control in
;; the character just after the field, but does not highlight it.
;; @TODO - Cancel an old field array if a new one is about to be created!
;; Keep this library independent of SRecode proper.
(require 'eieio)
@ -43,6 +45,10 @@
"While inserting a set of fields, collect in this variable.
Once an insertion set is done, these fields will be activated.")
;;; Customization
;;
(defface srecode-field-face
'((((class color) (background dark))
(:underline "green"))
@ -51,6 +57,11 @@ Once an insertion set is done, these fields will be activated.")
"*Face used to specify editable fields from a template."
:group 'semantic-faces)
(defcustom srecode-fields-exit-confirmation nil
"Ask for confirmation before leaving field editing mode."
:group 'srecode
:type 'boolean)
;;; BASECLASS
;;
;; Fields and the template region share some basic overlay features.
@ -237,7 +248,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(remove-hook 'post-command-hook 'srecode-field-post-command t)
(if (srecode-point-in-region-p ar)
nil ;; Keep going
;; We moved out of the temlate. Cancel the edits.
;; We moved out of the template. Cancel the edits.
(srecode-delete ar)))
))
@ -429,7 +440,8 @@ PRE-LEN is used in the after mode for the length of the changed text."
(defun srecode-field-exit-ask ()
"Ask if the user wants to exit field-editing mini-mode."
(interactive)
(when (y-or-n-p "Exit field-editing mode? ")
(when (or (not srecode-fields-exit-confirmation)
(y-or-n-p "Exit field-editing mode? "))
(srecode-delete (srecode-active-template-region))))

88
lisp/cedet/srecode/find.el
View File

@ -92,6 +92,23 @@ all template files for that application will be loaded."
))
))
;;; PROJECT
;;
;; 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))
"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."
(let ((proj (oref tab :project)))
;; Return t if the project wasn't set.
(if (not proj) t
;; If the project directory was set, lets check it.
(let ((dd (expand-file-name default-directory))
(projexp (regexp-quote (directory-file-name proj))))
(if (string-match (concat "^" projexp) dd)
t nil)))))
;;; SEARCH
;;
;; Find a given template based on name, and features of the current
@ -103,13 +120,14 @@ all template files for that application will be loaded."
Optional argument CONTEXT specifies that the template should part
of a particular context.
The APPLICATION argument is unused."
(if context
;; If a context is specified, then look it up there.
(let ((ctxth (gethash context (oref tab contexthash))))
(when ctxth
(gethash template-name ctxth)))
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash))))
(when (srecode-template-table-in-project-p tab)
(if context
;; If a context is specified, then look it up there.
(let ((ctxth (gethash context (oref tab contexthash))))
(when ctxth
(gethash template-name ctxth)))
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash)))))
(defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional
@ -144,32 +162,33 @@ tables that do not belong to an application will be searched."
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
of a particular context."
(let* ((keyout nil)
(hashfcn (lambda (key value)
(when (and (slot-boundp value 'binding)
(oref value binding)
(= (aref (oref value binding) 0) binding))
(setq keyout key))))
(contextstr (cond ((listp context)
(car-safe context))
((stringp context)
context)
(t nil)))
)
(if context
(let ((ctxth (gethash contextstr (oref tab contexthash))))
(when ctxth
;; If a context is specified, then look it up there.
(maphash hashfcn ctxth)
;; Context hashes EXCLUDE the context prefix which
;; we need to include, so concat it here
(when keyout
(setq keyout (concat contextstr ":" keyout)))
)))
(when (not keyout)
;; No context, or binding in context. Try full hash.
(maphash hashfcn (oref tab namehash)))
keyout))
(when (srecode-template-table-in-project-p tab)
(let* ((keyout nil)
(hashfcn (lambda (key value)
(when (and (slot-boundp value 'binding)
(oref value binding)
(= (aref (oref value binding) 0) binding))
(setq keyout key))))
(contextstr (cond ((listp context)
(car-safe context))
((stringp context)
context)
(t nil)))
)
(if context
(let ((ctxth (gethash contextstr (oref tab contexthash))))
(when ctxth
;; If a context is specified, then look it up there.
(maphash hashfcn ctxth)
;; Context hashes EXCLUDE the context prefix which
;; we need to include, so concat it here
(when keyout
(setq keyout (concat contextstr ":" keyout)))
)))
(when (not keyout)
;; No context, or binding in context. Try full hash.
(maphash hashfcn (oref tab namehash)))
keyout)))
(defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
@ -220,7 +239,8 @@ Optional argument HASH is the hash table to fill in."
)
(while tabs
;; Exclude templates for a perticular application.
(when (not (oref (car tabs) :application))
(when (and (not (oref (car tabs) :application))
(srecode-template-table-in-project-p (car tabs)))
(maphash (lambda (key temp)
(puthash key temp mhash)
)

3
lisp/cedet/srecode/getset.el
View File

@ -55,8 +55,9 @@ will be derived."
(error "No templates for inserting get/set"))
;; Step 1: Try to derive the tag for the class we will use
(semantic-fetch-tags)
(let* ((class (or class-in (srecode-auto-choose-class (point))))
(tagstart (semantic-tag-start class))
(tagstart (when class (semantic-tag-start class)))
(inclass (eq (semantic-current-tag-of-class 'type) class))
(field nil)
)

162
lisp/cedet/srecode/insert.el
View File

@ -26,6 +26,9 @@
;; Manage the insertion process for a template.
;;
(eval-when-compile
(require 'cl)) ;; for `lexical-let'
(require 'srecode/compile)
(require 'srecode/find)
(require 'srecode/dictionary)
@ -49,7 +52,7 @@ Possible values are:
NOTE: The field feature does not yet work with XEmacs."
:group 'srecode
:type '(choice (const :tag "Ask" ask)
(cons :tag "Field" field)))
(const :tag "Field" field)))
(defvar srecode-insert-with-fields-in-progress nil
"Non-nil means that we are actively inserting a template with fields.")
@ -86,7 +89,6 @@ DICT-ENTRIES are additional dictionary values to add."
(car dict-entries)
(car (cdr dict-entries)))
(setq dict-entries (cdr (cdr dict-entries))))
;;(srecode-resolve-arguments temp newdict)
(srecode-insert-fcn temp newdict)
;; Don't put code here. We need to return the end-mark
;; for this insertion step.
@ -100,6 +102,10 @@ has set everything up already."
;; Perform the insertion.
(let ((standard-output (or stream (current-buffer)))
(end-mark nil))
;; Merge any template entries into the input dictionary.
(when (slot-boundp template 'dictionary)
(srecode-dictionary-merge dictionary (oref template dictionary)))
(unless skipresolver
;; Make sure the semantic tags are up to date.
(semantic-fetch-tags)
@ -110,7 +116,7 @@ has set everything up already."
;; If there is a buffer, turn off various hooks. This will cause
;; the mod hooks to be buffered up during the insert, but
;; prevent tools like font-lock from fontifying mid-template.
;; Especialy important during insertion of complex comments that
;; Especially important during insertion of complex comments that
;; cause the new font-lock to comment-color stuff after the inserted
;; comment.
;;
@ -239,6 +245,9 @@ ST can be a class, or an object."
(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
;; these dictionary values earlier, but these values always
;; need merging for template inserting in other templates.
(when (slot-boundp st 'dictionary)
(srecode-dictionary-merge dictionary (oref st dictionary)))
;; Do an insertion.
@ -264,7 +273,7 @@ Use DICTIONARY to resolve any macros."
;; Specific srecode inserters.
;; The base class is from srecode-compile.
;;
;; Each inserter handles various macro codes from the temlate.
;; Each inserter handles various macro codes from the template.
;; The `code' slot specifies a character used to identify which
;; inserter is to be created.
;;
@ -471,7 +480,7 @@ If SECONDNAME is nil, return VALUE."
;; (setq val (format "%S" val))))
))
;; Output the dumb thing unless the type of thing specifically
;; did the inserting forus.
;; did the inserting for us.
(when do-princ
(princ val))))
@ -498,7 +507,8 @@ 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 ((ins srecode-template-inserter-ask) STATE)
(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."
(let ((prompts (oref STATE prompts))
@ -669,7 +679,13 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
(defvar srecode-template-inserter-point-override nil
"When non-nil, the point inserter will do this function instead.")
"Point-positioning method for the SRecode template inserter.
When nil, perform normal point-positioning behavior.
When the value is a cons cell (DEPTH . FUNCTION), call FUNCTION
instead, unless the template nesting depth, measured
by (length (oref srecode-template active)), is greater than
DEPTH.")
(defclass srecode-template-inserter-point (srecode-template-inserter)
((key :initform ?^
@ -702,15 +718,20 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
dictionary)
"Insert the STI inserter.
Save point in the class allocated 'point' slot.
If `srecode-template-inserter-point-override' then this generalized
marker will do something else. See `srecode-template-inserter-include-wrap'
as an example."
(if srecode-template-inserter-point-override
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."
;; If `srecode-template-inserter-point-override' is non-nil, its car
;; is the maximum template nesting depth for which the override is
;; 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))
(car srecode-template-inserter-point-override)))
;; Disable the old override while we do this.
(let ((over srecode-template-inserter-point-override)
(let ((over (cdr srecode-template-inserter-point-override))
(srecode-template-inserter-point-override nil))
(funcall over dictionary)
)
(funcall over dictionary))
(oset sti point (point-marker))
))
@ -751,9 +772,15 @@ Loops over the embedded CODE which was saved here during compilation.
The template to insert is stored in SLOT."
(let ((dicts (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(when (not (listp dicts))
(error "Cannot insert section %S from non-section variable."
(oref sti :object-name)))
;; If there is no section dictionary, then don't output anything
;; from this section.
(while dicts
(when (not (srecode-dictionary-p (car dicts)))
(error "Cannot insert section %S from non-section variable."
(oref sti :object-name)))
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
@ -853,39 +880,44 @@ this template instance."
;; If there was no template name, throw an error
(if (not templatenamepart)
(error "Include macro %s needs a template name" (oref sti :object-name)))
;; Find the template by name, and save it.
(if (or (not (slot-boundp sti 'includedtemplate))
(not (oref sti includedtemplate)))
(let ((tmpl (srecode-template-get-table (srecode-table)
templatenamepart))
(active (oref srecode-template active))
ctxt)
;; NOTE: We used to cache the template and not look it up a second time,
;; but changes in the template tables can change which template is
;; eventually discovered, so now we always lookup that template.
;; Calculate and store the discovered template
(let ((tmpl (srecode-template-get-table (srecode-table)
templatenamepart))
(active (oref srecode-template active))
ctxt)
(when (not tmpl)
;; If it isn't just available, scan back through
;; the active template stack, searching for a matching
;; context.
(while (and (not tmpl) active)
(setq ctxt (oref (car active) context))
(setq tmpl (srecode-template-get-table (srecode-table)
templatenamepart
ctxt))
(when (not tmpl)
;; If it isn't just available, scan back through
;; the active template stack, searching for a matching
;; context.
(while (and (not tmpl) active)
(setq ctxt (oref (car active) context))
(setq tmpl (srecode-template-get-table (srecode-table)
templatenamepart
ctxt))
(when (not tmpl)
(when (slot-boundp (car active) 'table)
(let ((app (oref (oref (car active) table) application)))
(when app
(setq tmpl (srecode-template-get-table
(srecode-table)
templatenamepart
ctxt app)))
)))
(setq active (cdr active)))
(when (not tmpl)
;; If it wasn't in this context, look to see if it
;; defines its own context
(setq tmpl (srecode-template-get-table (srecode-table)
templatenamepart)))
)
(oset sti :includedtemplate tmpl)))
(when (slot-boundp (car active) 'table)
(let ((app (oref (oref (car active) table) application)))
(when app
(setq tmpl (srecode-template-get-table
(srecode-table)
templatenamepart
ctxt app)))
)))
(setq active (cdr active)))
(when (not tmpl)
;; If it wasn't in this context, look to see if it
;; defines it's own context
(setq tmpl (srecode-template-get-table (srecode-table)
templatenamepart)))
)
;; Store the found template into this object for later use.
(oset sti :includedtemplate tmpl))
(if (not (oref sti includedtemplate))
;; @todo - Call into a debugger to help find the template in question.
@ -955,23 +987,31 @@ insert the section it wraps into the location in the included
template where a ^ inserter occurs."
;; Step 1: Look up the included inserter
(srecode-insert-include-lookup sti dictionary)
;; Step 2: Temporarilly override the point inserter.
(let* ((vaguely-unique-name sti)
(srecode-template-inserter-point-override
(lambda (dict2)
(if (srecode-dictionary-lookup-name
dict2 (oref vaguely-unique-name :object-name))
;; Insert our sectional part with looping.
(srecode-insert-method-helper
vaguely-unique-name dict2 'template)
;; Insert our sectional part just once.
(srecode-insert-subtemplate vaguely-unique-name
dict2 'template))
)))
;; Step 2: Temporarily override the point inserter.
;; We bind `srecode-template-inserter-point-override' to a cons cell
;; (DEPTH . FUNCTION) that has the maximum template nesting depth,
;; for which the override is valid, in DEPTH and a lambda function
;; which implements the wrap insertion behavior in FUNCTION. The
;; maximum valid nesting depth is just the current depth + 1.
(let ((srecode-template-inserter-point-override
(lexical-let ((inserter1 sti))
(cons
;; DEPTH
(+ (length (oref srecode-template active)) 1)
;; FUNCTION
(lambda (dict)
(let ((srecode-template-inserter-point-override nil))
(if (srecode-dictionary-lookup-name
dict (oref inserter1 :object-name))
;; Insert our sectional part with looping.
(srecode-insert-method-helper
inserter1 dict 'template)
;; Insert our sectional part just once.
(srecode-insert-subtemplate
inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in
;; place.
(call-next-method)
))
(call-next-method)))
(provide 'srecode/insert)

10
lisp/cedet/srecode/map.el
View File

@ -295,8 +295,14 @@ if that file is NEW, otherwise assume the mode has not changed."
;; 2) Do we not have a current map? If so load.
(when (not srecode-current-map)
(setq srecode-current-map
(eieio-persistent-read srecode-map-save-file))
(condition-case nil
(setq srecode-current-map
(eieio-persistent-read srecode-map-save-file))
(error
;; There was an error loading the old map. Create a new one.
(setq srecode-current-map
(srecode-map "SRecode Map"
:file srecode-map-save-file))))
)
)

72
lisp/cedet/srecode/mode.el
View File

@ -125,7 +125,13 @@
["Dump Dictionary"
srecode-dictionary-dump
:active t
:help "Calculate a dump a dictionary for point."
:help "Calculate and dump a dictionary for point."
])
(semantic-menu-item
["Show Macro Help"
srecode-macro-help
:active t
:help "Display the different types of macros available."
])
)
)
@ -223,43 +229,44 @@ MENU-DEF is the menu to bind this into."
(setq context (car-safe (srecode-calculate-context)))
(while subtab
(setq ltab (oref (car subtab) templates))
(while ltab
(setq temp (car ltab))
(when (srecode-template-table-in-project-p (car subtab))
(setq ltab (oref (car subtab) templates))
(while ltab
(setq temp (car ltab))
;; Do something with this template.
;; Do something with this template.
(let* ((ctxt (oref temp context))
(ctxtcons (assoc ctxt alltabs))
(bind (if (slot-boundp temp 'binding)
(oref temp binding)))
(name (object-name-string temp)))
(let* ((ctxt (oref temp context))
(ctxtcons (assoc ctxt alltabs))
(bind (if (slot-boundp temp 'binding)
(oref temp binding)))
(name (object-name-string temp)))
(when (not ctxtcons)
(if (string= context ctxt)
;; If this context is not in the current list of contexts
;; is equal to the current context, then manage the
;; active list instead
(setq active
(setq ctxtcons (or active (cons ctxt nil))))
;; This is not an active context, add it to alltabs.
(setq ctxtcons (cons ctxt nil))
(setq alltabs (cons ctxtcons alltabs))))
(when (not ctxtcons)
(if (string= context ctxt)
;; If this context is not in the current list of contexts
;; is equal to the current context, then manage the
;; active list instead
(setq active
(setq ctxtcons (or active (cons ctxt nil))))
;; This is not an active context, add it to alltabs.
(setq ctxtcons (cons ctxt nil))
(setq alltabs (cons ctxtcons alltabs))))
(let ((new (vector
(if bind
(concat name " (" bind ")")
name)
`(lambda () (interactive)
(srecode-insert (concat ,ctxt ":" ,name)))
t)))
(let ((new (vector
(if bind
(concat name " (" bind ")")
name)
`(lambda () (interactive)
(srecode-insert (concat ,ctxt ":" ,name)))
t)))
(setcdr ctxtcons (cons
new
(cdr ctxtcons)))))
(setcdr ctxtcons (cons
new
(cdr ctxtcons)))))
(setq ltab (cdr ltab)))
(setq subtab (cdr subtab)))
(setq ltab (cdr ltab))))
(setq subtab (cdr subtab)))
;; Now create the menu
(easy-menu-filter-return
@ -300,6 +307,7 @@ MENU-DEF is the menu to bind this into."
This command will insert whichever srecode template has a binding
to the current key."
(interactive)
(srecode-load-tables-for-mode major-mode)
(let* ((k last-command-event)
(ctxt (srecode-calculate-context))
;; Find the template with the binding K

10
lisp/cedet/srecode/semantic.el
View File

@ -91,7 +91,7 @@ The hook is called with two arguments, the TAG and DICT
to be augmented.")
(define-overload srecode-semantic-apply-tag-to-dict (tagobj dict)
"Insert fewatures of TAGOBJ into the dictionary DICT.
"Insert features of TAGOBJ into the dictionary DICT.
TAGOBJ is an object of class `srecode-semantic-tag'. This class
is a compound inserter value.
DICT is a dictionary object.
@ -195,7 +195,7 @@ variable default values, and other things."
;;; :tag ARGUMENT HANDLING
;;
;; When a :tag argument is required, identify the current :tag,
;; and apply it's parts into the dictionary.
;; and apply its parts into the dictionary.
(defun srecode-semantic-handle-:tag (dict)
"Add macros into the dictionary DICT based on the current :tag."
;; We have a tag, start adding "stuff" into the dictionary.
@ -305,8 +305,8 @@ or `code'.
For various conditions, this function looks for a template with
the name CLASS-tag, where CLASS is the tag class. If it cannot
find that, it will look for that template in the
`declaration'context (if the current context was not `declaration').
find that, it will look for that template in the `declaration'
context (if the current context was not `declaration').
If PROTOTYPE is specified, it will first look for templates with
the name CLASS-tag-prototype, or CLASS-prototype as above.
@ -382,7 +382,7 @@ as `function' will leave point where code might be inserted."
(error "Cannot find template %s in %s for inserting tag %S"
errtype top (semantic-format-tag-summarize tag)))
;; Resolve Arguments
;; Resolve arguments
(let ((srecode-semantic-selected-tag tag))
(srecode-resolve-arguments temp dict))

13
lisp/cedet/srecode/table.el
View File

@ -31,6 +31,7 @@
(require 'srecode)
(declare-function srecode-load-tables-for-mode "srecode/find")
(declare-function srecode-template-table-in-project-p "srecode/find")
;;; Code:
@ -74,6 +75,12 @@ Emacs Lisp code to fill in the dictionary.")
When there are multiple template files with similar names, templates with
the highest priority are scanned last, allowing them to override values in
previous template files.")
(project :initarg :project
:type (or null string)
:documentation
"Scope some project files to a specific project.
The value is a directory which forms the root of a particular project,
or a subset of a particular project.")
;;
;; Parsed Data from the template file
;;
@ -224,6 +231,12 @@ Use PREDICATE is the same as for the `sort' function."
(when (oref tab :application)
(princ "\nApplication: ")
(princ (oref tab :application)))
(when (oref tab :project)
(require 'srecode/find) ; For srecode-template-table-in-project-p
(princ "\nProject Directory: ")
(princ (oref tab :project))
(when (not (srecode-template-table-in-project-p tab))
(princ "\n ** Not Usable in this file. **")))
(princ "\n\nVariables:\n")
(let ((vars (oref tab variables)))
(while vars

11
lisp/cedet/srecode/texi.el
View File

@ -175,10 +175,17 @@ Adds the following:
(define-mode-local-override semantic-insert-foreign-tag
texinfo-mode (foreign-tag)
"Insert TAG from a foreign buffer in TAGFILE.
"Insert FOREIGN-TAG from a foreign buffer in TAGFILE.
Assume TAGFILE is a source buffer, and create a documentation
thingy from it using the `document' tool."
(let ((srecode-semantic-selected-tag foreign-tag))
(srecode-texi-insert-tag-as-doc foreign-tag))
(defun srecode-texi-insert-tag-as-doc (tag)
"Insert TAG into the current buffer with SRecode."
(when (not (eq major-mode 'texinfo-mode))
(error "Can only insert tags into texinfo in texinfo mode"))
(let ((srecode-semantic-selected-tag tag))
(srecode-load-tables-for-mode major-mode)
;; @todo - choose of the many types of tags to insert,
;; or put all that logic into srecode.
(srecode-insert "declaration:function")))