+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).
template include :blank
"An include statement."
----
-import {{NAME}};
+import {{?NAME}};
----
context misc
+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.
(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")))
;;; 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.
(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."
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."
(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:
(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)
(mode nil)
(application nil)
(priority nil)
+ (project nil)
(vars nil)
)
(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))
;; 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))
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.
(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)))
(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
: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
;;; 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
;;
;; 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.
)
)
+(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.
(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)
;; 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
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
;; 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))))
))
)
+\f
+;;; 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:
(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")
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
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.
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.
(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))
(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)
"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)))
- )
-
- (t
- (srecode-dictionary-set-value dict key 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)))
+
+ ;; 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.
(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)
(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.
;; 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)
"While inserting a set of fields, collect in this variable.
Once an insertion set is done, these fields will be activated.")
+\f
+;;; Customization
+;;
+
(defface srecode-field-face
'((((class color) (background dark))
(:underline "green"))
"*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.
(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)))
))
(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))))
))
))
+;;; 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
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
"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)
)
(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)
)
(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)
)
;; Manage the insertion process for a template.
;;
+(eval-when-compile
+ (require 'cl)) ;; for `lexical-let'
+
(require 'srecode/compile)
(require 'srecode/find)
(require 'srecode/dictionary)
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.")
(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.
;; 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)
;; 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.
;;
(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.
;; 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.
;;
;; (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))))
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))
)
(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 ?^
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))
))
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)))))
;; 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.
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)
;; 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))))
)
)
["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."
])
)
)
(setq context (car-safe (srecode-calculate-context)))
(while subtab
- (setq ltab (oref (car subtab) templates))
- (while ltab
- (setq temp (car ltab))
-
- ;; 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)))
-
- (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)))
-
- (setcdr ctxtcons (cons
- new
- (cdr ctxtcons)))))
-
- (setq ltab (cdr ltab)))
- (setq subtab (cdr subtab)))
+ (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.
+
+ (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))))
+
+ (let ((new (vector
+ (if bind
+ (concat name " (" bind ")")
+ name)
+ `(lambda () (interactive)
+ (srecode-insert (concat ,ctxt ":" ,name)))
+ t)))
+
+ (setcdr ctxtcons (cons
+ new
+ (cdr ctxtcons)))))
+
+ (setq ltab (cdr ltab))))
+ (setq subtab (cdr subtab)))
;; Now create the menu
(easy-menu-filter-return
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
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.
;;; :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.
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.
(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))
(require 'srecode)
(declare-function srecode-load-tables-for-mode "srecode/find")
+(declare-function srecode-template-table-in-project-p "srecode/find")
;;; Code:
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
;;
(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
(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")))
projects / emacs.git / commitdiff