# HG changeset patch # User Chong Yidong # Date 1285107083 14400 # Node ID 67ff8ad45bd5000d6af1d1f8b72d1b903fd275e7 # Parent 2d0eee1a24b906bc0f16800985bbb523eb06d6da Synch SRecode to CEDET 1.0. * 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. diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 etc/ChangeLog --- a/etc/ChangeLog Tue Sep 21 17:52:13 2010 +0200 +++ b/etc/ChangeLog Tue Sep 21 18:11:23 2010 -0400 @@ -1,3 +1,7 @@ +2010-09-21 Eric Ludlam + + * srecode/java.srt: Make NAME be a prompt. + 2010-08-22 Alex Harsanyi (tiny change) * emacs3.py: Import imp module and use it (Bug#5756). diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 etc/srecode/java.srt --- a/etc/srecode/java.srt Tue Sep 21 17:52:13 2010 +0200 +++ b/etc/srecode/java.srt Tue Sep 21 18:11:23 2010 -0400 @@ -83,7 +83,7 @@ template include :blank "An include statement." ---- -import {{NAME}}; +import {{?NAME}}; ---- context misc diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/ChangeLog --- a/lisp/cedet/ChangeLog Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/ChangeLog Tue Sep 21 18:11:23 2010 -0400 @@ -1,3 +1,73 @@ +2010-09-21 Eric Ludlam + + 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 Synch EDE to CEDET 1.0. diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/cedet.el --- a/lisp/cedet/cedet.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/cedet.el Tue Sep 21 18:11:23 2010 -0400 @@ -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"))) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/pulse.el --- a/lisp/cedet/pulse.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/pulse.el Tue Sep 21 18:11:23 2010 -0400 @@ -3,6 +3,7 @@ ;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam +;; 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 @@ 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." diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode.el --- a/lisp/cedet/srecode.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode.el Tue Sep 21 18:11:23 2010 -0400 @@ -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: diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/compile.el --- a/lisp/cedet/srecode/compile.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/compile.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ (mode nil) (application nil) (priority nil) + (project nil) (vars nil) ) @@ -256,6 +255,8 @@ (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 @@ ;; 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 @@ 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 @@ (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 @@ (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 @@ :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 diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/cpp.el --- a/lisp/cedet/srecode/cpp.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/cpp.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ ) ) +(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 @@ (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 @@ ;; 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 @@ 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 @@ ;; 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: diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/dictionary.el --- a/lisp/cedet/srecode/dictionary.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/dictionary.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ 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 @@ 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 @@ 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 @@ (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 @@ (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 @@ "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 @@ (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 @@ (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. diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/fields.el --- a/lisp/cedet/srecode/fields.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/fields.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ "*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 @@ (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 @@ (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)))) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/find.el --- a/lisp/cedet/srecode/find.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/find.el Tue Sep 21 18:11:23 2010 -0400 @@ -92,6 +92,23 @@ )) )) +;;; 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 @@ 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 @@ "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 @@ ) (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) ) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/getset.el --- a/lisp/cedet/srecode/getset.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/getset.el Tue Sep 21 18:11:23 2010 -0400 @@ -55,8 +55,9 @@ (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) ) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/insert.el --- a/lisp/cedet/srecode/insert.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/insert.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ 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 @@ (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 @@ ;; 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 @@ ;; 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 @@ (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 @@ ;; 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 @@ ;; (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 @@ 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 @@ ) (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 @@ 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 @@ 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 @@ ;; 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 @@ 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) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/map.el --- a/lisp/cedet/srecode/map.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/map.el Tue Sep 21 18:11:23 2010 -0400 @@ -295,8 +295,14 @@ ;; 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)))) ) ) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/mode.el --- a/lisp/cedet/srecode/mode.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/mode.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ (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. + (when (srecode-template-table-in-project-p (car subtab)) + (setq ltab (oref (car subtab) templates)) + (while ltab + (setq temp (car ltab)) - (let* ((ctxt (oref temp context)) - (ctxtcons (assoc ctxt alltabs)) - (bind (if (slot-boundp temp 'binding) - (oref temp binding))) - (name (object-name-string temp))) + ;; 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)))) + (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 @@ 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 diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/semantic.el --- a/lisp/cedet/srecode/semantic.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/semantic.el Tue Sep 21 18:11:23 2010 -0400 @@ -91,7 +91,7 @@ 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 @@ ;;; :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 @@ 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 @@ (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)) diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/table.el --- a/lisp/cedet/srecode/table.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/table.el Tue Sep 21 18:11:23 2010 -0400 @@ -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 @@ 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 @@ (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 diff -r 2d0eee1a24b9 -r 67ff8ad45bd5 lisp/cedet/srecode/texi.el --- a/lisp/cedet/srecode/texi.el Tue Sep 21 17:52:13 2010 +0200 +++ b/lisp/cedet/srecode/texi.el Tue Sep 21 18:11:23 2010 -0400 @@ -175,10 +175,17 @@ (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")))