diff options
Diffstat (limited to 'lisp/cedet/srecode')
-rw-r--r-- | lisp/cedet/srecode/compile.el | 13 | ||||
-rw-r--r-- | lisp/cedet/srecode/cpp.el | 55 | ||||
-rw-r--r-- | lisp/cedet/srecode/dictionary.el | 43 | ||||
-rw-r--r-- | lisp/cedet/srecode/find.el | 45 | ||||
-rw-r--r-- | lisp/cedet/srecode/getset.el | 8 | ||||
-rw-r--r-- | lisp/cedet/srecode/insert.el | 179 | ||||
-rw-r--r-- | lisp/cedet/srecode/java.el | 20 | ||||
-rw-r--r-- | lisp/cedet/srecode/map.el | 2 | ||||
-rw-r--r-- | lisp/cedet/srecode/mode.el | 20 | ||||
-rw-r--r-- | lisp/cedet/srecode/semantic.el | 6 | ||||
-rw-r--r-- | lisp/cedet/srecode/srt-mode.el | 8 | ||||
-rw-r--r-- | lisp/cedet/srecode/srt-wy.el | 64 | ||||
-rw-r--r-- | lisp/cedet/srecode/table.el | 59 |
13 files changed, 332 insertions, 190 deletions
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index d5389a97f03..8a1291f8d72 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -210,6 +210,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (buffer-file-name)))) (mode nil) (application nil) + (framework nil) (priority nil) (project nil) (vars nil) @@ -253,6 +254,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." ) ((string= name "application") (setq application (read firstvalue))) + ((string= name "framework") + (setq framework (read firstvalue))) ((string= name "priority") (setq priority (read firstvalue))) ((string= name "project") @@ -319,7 +322,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." priority)) ;; Save it up! - (srecode-compile-template-table table mode priority application project vars) + (srecode-compile-template-table table mode priority application framework project vars) ) ) @@ -376,8 +379,8 @@ It is hard if the previous inserter is a newline object." (while (and comp (stringp (car comp))) (setq comp (cdr comp))) (or (not comp) - (require 'srecode/insert) - (srecode-template-inserter-newline-child-p (car comp)))) + (progn (require 'srecode/insert) + (srecode-template-inserter-newline-child-p (car comp))))) (defun srecode-compile-split-code (tag str STATE &optional end-name) @@ -522,12 +525,13 @@ to the inserter constructor." (if (not new) (error "SRECODE: Unknown macro code %S" key)) new))) -(defun srecode-compile-template-table (templates mode priority application project vars) +(defun srecode-compile-template-table (templates mode priority application framework 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. +FRAMEWORK is the name of the framework 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 @@ -569,6 +573,7 @@ A list of defined variables VARS provides a variable table." :major-mode mode :priority priority :application application + :framework framework :project project)) (tmpl (oref table templates))) ;; Loop over all the templates, and xref. diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 12bfd3af903..d63e1a7a49f 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -47,16 +47,16 @@ buffer contains a using NAMESPACE; statement " :group 'srecode-cpp :type '(repeat string)) -;;; :cpp ARGUMENT HANDLING +;;; :c ARGUMENT HANDLING ;; -;; When a :cpp argument is required, fill the dictionary with -;; information about the current C++ file. +;; When a :c argument is required, fill the dictionary with +;; information about the current C file. ;; -;; Error if not in a C++ mode. +;; Error if not in a C mode. ;;;###autoload -(defun srecode-semantic-handle-:cpp (dict) - "Add macros into the dictionary DICT based on the current c++ file. +(defun srecode-semantic-handle-:c (dict) + "Add macros into the dictionary DICT based on the current c file. Adds the following: FILENAME_SYMBOL - filename converted into a C compat symbol. HEADER - Shown section if in a header file." @@ -76,6 +76,21 @@ HEADER - Shown section if in a header file." ) ) +;;; :cpp ARGUMENT HANDLING +;; +;; When a :cpp argument is required, fill the dictionary with +;; information about the current C++ file. +;; +;; Error if not in a C++ mode. +;;;###autoload +(defun srecode-semantic-handle-:cpp (dict) + "Add macros into the dictionary DICT based on the current c file. +Calls `srecode-semantic-handle-:c. +Also adds the following: + - nothing -" + (srecode-semantic-handle-:c dict) + ) + (defun srecode-semantic-handle-:using-namespaces (dict) "Add macros into the dictionary DICT based on used namespaces. Adds the following: @@ -94,10 +109,15 @@ PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'." ) (define-mode-local-override srecode-semantic-apply-tag-to-dict - c++-mode (tag-wrapper dict) - "Apply C++ specific features from TAG-WRAPPER into DICT. + c-mode (tag-wrapper dict) + "Apply C and C++ specific features from TAG-WRAPPER into DICT. Calls `srecode-semantic-apply-tag-to-dict-default' first. Adds -special behavior for tag of classes include, using and function." +special behavior for tag of classes include, using and function. + +This function cannot be split into C and C++ specific variants, as +the way the tags are created from the parser does not distinguish +either. The side effect is that you could get some C++ tag properties +specified in a C file." ;; Use default implementation to fill in the basic properties. (srecode-semantic-apply-tag-to-dict-default tag-wrapper dict) @@ -150,14 +170,20 @@ special behavior for tag of classes include, using and function." (templates (semantic-tag-get-attribute tag :template)) (modifiers (semantic-tag-modifiers tag))) - ;; Add modifiers into the dictionary + ;; Mark constructors and destructors as such. + (when (semantic-tag-function-constructor-p tag) + (srecode-dictionary-show-section dict "CONSTRUCTOR")) + (when (semantic-tag-function-destructor-p tag) + (srecode-dictionary-show-section dict "DESTRUCTOR")) + + ;; Add modifiers into the dictionary. (dolist (modifier modifiers) (let ((modifier-dict (srecode-dictionary-add-section-dictionary dict "MODIFIERS"))) (srecode-dictionary-set-value modifier-dict "NAME" modifier))) ;; Add templates into child dictionaries. - (srecode-cpp-apply-templates dict templates) + (srecode-c-apply-templates dict templates) ;; When the function is a member function, it can have ;; additional modifiers. @@ -171,8 +197,7 @@ special behavior for tag of classes include, using and function." ;; If the member function is pure virtual, add a dictionary ;; entry. (when (semantic-tag-get-attribute tag :pure-virtual-flag) - (srecode-dictionary-show-section dict "PURE")) - ))) + (srecode-dictionary-show-section dict "PURE"))))) ;; ;; CLASS @@ -184,7 +209,7 @@ special behavior for tag of classes include, using and function." ;; Add templates into child dictionaries. (let ((templates (semantic-tag-get-attribute tag :template))) - (srecode-cpp-apply-templates dict templates)))) + (srecode-c-apply-templates dict templates)))) )) ) @@ -192,7 +217,7 @@ special behavior for tag of classes include, using and function." ;;; Helper functions ;; -(defun srecode-cpp-apply-templates (dict templates) +(defun srecode-c-apply-templates (dict templates) "Add section dictionaries for TEMPLATES to DICT." (when templates (let ((templates-dict (srecode-dictionary-add-section-dictionary diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index 5b65284660f..6262383c397 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -117,8 +117,8 @@ Makes sure that :value is compiled." (cons (car fields) newfields)))) (setq fields (cdr (cdr fields)))) - (when (not state) - (error "Cannot create compound variable without :state")) + ;;(when (not state) + ;; (error "Cannot create compound variable outside of sectiondictionary")) (call-next-method this (nreverse newfields)) (when (not (slot-boundp this 'compiled)) @@ -220,7 +220,10 @@ associated with a buffer or parent." "Insert into DICT the variables found in table TPL. TPL is an object representing a compiled template file." (when tpl - (let ((tabs (oref tpl :tables))) + ;; Tables are sorted with highest priority first, useful for looking + ;; up templates, but this means we need to install the variables in + ;; reverse order so higher priority variables override lower ones. + (let ((tabs (reverse (oref tpl :tables)))) (require 'srecode/find) ; For srecode-template-table-in-project-p (while tabs (when (srecode-template-table-in-project-p (car tabs)) @@ -546,40 +549,6 @@ inserted with a new editable field.") ;;; Higher level dictionary functions ;; -(defun srecode-create-section-dictionary (sectiondicts STATE) - "Create a dictionary with section entries for a template. -The format for SECTIONDICTS is what is emitted from the template parsers. -STATE is the current compiler state." - (when sectiondicts - (let ((new (srecode-create-dictionary t))) - ;; Loop over each section. The section is a macro w/in the - ;; template. - (while sectiondicts - (let* ((sect (car (car sectiondicts))) - (entries (cdr (car sectiondicts))) - (subdict (srecode-dictionary-add-section-dictionary new sect)) - ) - ;; Loop over each entry. This is one variable in the - ;; section dictionary. - (while entries - (let ((tname (semantic-tag-name (car entries))) - (val (semantic-tag-variable-default (car entries)))) - (if (eq val t) - (srecode-dictionary-show-section subdict tname) - (cond - ((and (stringp (car val)) - (= (length val) 1)) - (setq val (car val))) - (t - (setq val (srecode-dictionary-compound-variable - tname :value val :state STATE)))) - (srecode-dictionary-set-value - subdict tname val)) - (setq entries (cdr entries)))) - ) - (setq sectiondicts (cdr sectiondicts))) - new))) - (defun srecode-create-dictionaries-from-tags (tags state) "Create a dictionary with entries according to TAGS. diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index befdb4731c2..f621c5e82d5 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -220,32 +220,37 @@ tables that do not belong to an application will be searched." (defvar srecode-read-template-name-history nil "History for completing reads for template names.") -(defun srecode-all-template-hash (&optional mode hash) +(defun srecode-user-template-p (template) + "Non-nil if TEMPLATE is intended for user insertion. +Templates not matching this predicate are used for code +generation or other internal purposes." + t) + +(defun srecode-all-template-hash (&optional mode hash predicate) "Create a hash table of all the currently available templates. Optional argument MODE is the major mode to look for. -Optional argument HASH is the hash table to fill in." - (let* ((mhash (or hash (make-hash-table :test 'equal))) - (mmode (or mode major-mode)) - (mp (get-mode-local-parent mmode)) - ) +Optional argument HASH is the hash table to fill in. +Optional argument PREDICATE can be used to filter the returned +templates." + (let* ((mhash (or hash (make-hash-table :test 'equal))) + (mmode (or mode major-mode)) + (parent-mode (get-mode-local-parent mmode))) ;; Get the parent hash table filled into our current hash. - (when (not (eq mode 'default)) - (if mp - (srecode-all-template-hash mp mhash) - (srecode-all-template-hash 'default mhash))) + (unless (eq mode 'default) + (srecode-all-template-hash (or parent-mode 'default) mhash)) + ;; Load up the hash table for our current mode. - (let* ((mt (srecode-get-mode-table mmode)) - (tabs (when mt (oref mt :tables))) - ) - (while tabs + (let* ((mt (srecode-get-mode-table mmode)) + (tabs (when mt (oref mt :tables)))) + (dolist (tab tabs) ;; Exclude templates for a particular application. - (when (and (not (oref (car tabs) :application)) - (srecode-template-table-in-project-p (car tabs))) + (when (and (not (oref tab :application)) + (srecode-template-table-in-project-p tab)) (maphash (lambda (key temp) - (puthash key temp mhash) - ) - (oref (car tabs) namehash))) - (setq tabs (cdr tabs))) + (when (or (not predicate) + (funcall predicate temp)) + (puthash key temp mhash))) + (oref tab namehash)))) mhash))) (defun srecode-calculate-default-template-string (hash) diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el index 5155044e386..49d913a099a 100644 --- a/lisp/cedet/srecode/getset.el +++ b/lisp/cedet/srecode/getset.el @@ -298,10 +298,10 @@ Base selection on the field related to POINT." (let* ((kids (semantic-find-tags-by-class 'variable (semantic-tag-type-members class))) (sel (completing-read "Use Field: " kids)) - ) - - (or (semantic-find-tags-by-name sel kids) - sel) + (fields (semantic-find-tags-by-name sel kids))) + (if fields + (car fields) + sel) )) (defun srecode-auto-choose-class (point) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index 7d300614c08..726aa41cffd 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -195,6 +195,32 @@ Buffer based features related to change hooks is handled one level up." ;; area. Return value is not important. )) +(defun srecode-insert-show-error-report (dictionary format &rest args) + "Display an error report based on DICTIONARY, FORMAT and ARGS. +This is intended to diagnose problems with failed template +insertions." + (with-current-buffer (data-debug-new-buffer "*SRECODE INSERTION ERROR*") + (erase-buffer) + ;; Insert the stack of templates that are currently being + ;; inserted. + (insert (propertize "Template Stack" 'face '(:weight bold)) + (propertize " (most recent at bottom)" 'face '(:slant italic)) + ":\n") + (data-debug-insert-stuff-list + (reverse (oref srecode-template active)) "> ") + ;; Show the current dictionary. + (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") + (data-debug-insert-thing dictionary "" "> ") + ;; Show the error message. + (insert (propertize "Error" 'face '(:weight bold)) "\n") + (insert (apply #'format format args)) + (pop-to-buffer (current-buffer)))) + +(defun srecode-insert-report-error (dictionary format &rest args) + ;; TODO only display something when inside an interactive call? + (srecode-insert-show-error-report dictionary format args) + (apply #'error format args)) + ;;; TEMPLATE ARGUMENTS ;; ;; Some templates have arguments. Each argument is associated with @@ -435,8 +461,10 @@ If SECONDNAME is nil, return VALUE." (let ((srecode-inserter-variable-current-dictionary dictionary)) (funcall fcnpart value)) ;; Else, warn. - (error "Variable insertion second arg %s is not a function" - secondname))) + (srecode-insert-report-error + dictionary + "Variable inserter %s: second argument `%s' is not a function" + (object-print sti) secondname))) value)) (defmethod srecode-insert-method ((sti srecode-template-inserter-variable) @@ -467,19 +495,20 @@ If SECONDNAME is nil, return VALUE." ;; If the value returned is nil, then it may be a special ;; field inserter that requires us to set do-princ to nil. (when (not val) - (setq do-princ nil) - ) - ) + (setq do-princ nil))) + ;; Dictionaries... not allowed in this style ((srecode-dictionary-child-p val) - (error "Macro %s cannot insert a dictionary - use section macros instead" - name)) + (srecode-insert-report-error + dictionary + "Macro %s cannot insert a dictionary - use section macros instead" + name)) + ;; Other stuff... convert (t - (error "Macro %s cannot insert arbitrary data" name) - ;;(if (and val (not (stringp val))) - ;; (setq val (format "%S" val)))) - )) + (srecode-insert-report-error + dictionary + "Macro %s cannot insert arbitrary data" name))) ;; Output the dumb thing unless the type of thing specifically ;; did the inserting for us. (when do-princ @@ -559,19 +588,25 @@ Loop over the prompts to see if we have a match." "Derive the default value for an askable inserter STI. DICTIONARY is used to derive some values." (let ((defaultfcn (oref sti :defaultfcn))) - (cond ((stringp defaultfcn) - defaultfcn) - ((functionp defaultfcn) - (funcall defaultfcn)) - ((and (listp defaultfcn) - (eq (car defaultfcn) 'macro)) - (srecode-dictionary-lookup-name - dictionary (cdr defaultfcn))) - ((null defaultfcn) - "") - (t - (error "Unknown default for prompt: %S" - defaultfcn))))) + (cond + ((stringp defaultfcn) + defaultfcn) + + ((functionp defaultfcn) + (funcall defaultfcn)) + + ((and (listp defaultfcn) + (eq (car defaultfcn) 'macro)) + (srecode-dictionary-lookup-name + dictionary (cdr defaultfcn))) + + ((null defaultfcn) + "") + + (t + (srecode-insert-report-error + dictionary + "Unknown default for prompt: %S" defaultfcn))))) (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask) dictionary) @@ -647,26 +682,33 @@ spaces to the right.") "For VALUE handle WIDTH behaviors for this variable inserter. Return the result as a string. By default, treat as a function name." - (if width - ;; Trim or pad to new length - (let* ((split (split-string width ":")) - (width (string-to-number (nth 0 split))) - (second (nth 1 split)) - (pad (cond ((or (null second) (string= "right" second)) - 'right) - ((string= "left" second) - 'left) - (t - (error "Unknown pad type %s" second))))) - (if (>= (length value) width) - ;; Simple case - too long. - (substring value 0 width) - ;; We need to pad on one side or the other. - (let ((padchars (make-string (- width (length value)) ? ))) - (if (eq pad 'left) - (concat padchars value) - (concat value padchars))))) - (error "Width not specified for variable/width inserter"))) + ;; Cannot work without width. + (unless width + (srecode-insert-report-error + dictionary + "Width not specified for variable/width inserter")) + + ;; Trim or pad to new length + (let* ((split (split-string width ":")) + (width (string-to-number (nth 0 split))) + (second (nth 1 split)) + (pad (cond + ((or (null second) (string= "right" second)) + 'right) + ((string= "left" second) + 'left) + (t + (srecode-insert-report-error + dictionary + "Unknown pad type %s" second))))) + (if (>= (length value) width) + ;; Simple case - too long. + (substring value 0 width) + ;; We need to pad on one side or the other. + (let ((padchars (make-string (- width (length value)) ? ))) + (if (eq pad 'left) + (concat padchars value) + (concat value padchars)))))) (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width) escape-start escape-end) @@ -758,13 +800,15 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate) dict slot) "Insert a subtemplate for the inserter STI with dictionary DICT." - ;; make sure that only dictionaries are used. - (when (not (srecode-dictionary-child-p dict)) - (error "Only section dictionaries allowed for %s" - (object-name-string sti))) + ;; Make sure that only dictionaries are used. + (unless (srecode-dictionary-child-p dict) + (srecode-insert-report-error + dict + "Only section dictionaries allowed for `%s'" + (object-name-string sti))) + ;; Output the code from the sub-template. - (srecode-insert-method (slot-value sti slot) dict) - ) + (srecode-insert-method (slot-value sti slot) dict)) (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate) dictionary slot) @@ -774,14 +818,18 @@ 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))) + (srecode-insert-report-error + dictionary + "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-report-error + dictionary + "Cannot insert section %S from non-section variable." + (oref sti :object-name))) (srecode-insert-subtemplate sti (car dicts) slot) (setq dicts (cdr dicts))))) @@ -876,11 +924,13 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." "For the template inserter STI, lookup the template to include. Finds the template with this macro function part and stores it in this template instance." - (let* ((templatenamepart (oref sti :secondname)) - ) - ;; If there was no template name, throw an error - (if (not templatenamepart) - (error "Include macro %s needs a template name" (oref sti :object-name))) + (let ((templatenamepart (oref sti :secondname))) + ;; If there was no template name, throw an error. + (unless templatenamepart + (srecode-insert-report-error + dictionary + "Include macro `%s' needs a template name" + (oref sti :object-name))) ;; 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 @@ -920,11 +970,12 @@ this template instance." ;; 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. - (error "No template \"%s\" found for include macro `%s'" - templatenamepart (oref sti :object-name))) - )) + (unless (oref sti includedtemplate) + ;; @todo - Call into a debugger to help find the template in question. + (srecode-insert-report-error + dictionary + "No template \"%s\" found for include macro `%s'" + templatenamepart (oref sti :object-name))))) (defmethod srecode-insert-method ((sti srecode-template-inserter-include) dictionary) diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 58d8efc41e2..3635a39d383 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -26,6 +26,10 @@ ;;; Code: (require 'srecode/dictionary) +(require 'semantic/tag) + +(eval-when-compile + (require 'semantic/find)) ;;;###autoload (defun srecode-semantic-handle-:java (dict) @@ -33,7 +37,7 @@ Adds the following: FILENAME_AS_PACKAGE - file/dir converted into a java package name. FILENAME_AS_CLASS - file converted to a Java class name." - ;; A symbol representing + ;; Symbols needed by empty files. (let* ((fsym (file-name-nondirectory (buffer-file-name))) (fnox (file-name-sans-extension fsym)) (dir (file-name-directory (buffer-file-name))) @@ -44,12 +48,18 @@ FILENAME_AS_CLASS - file converted to a Java class name." (if (string-match "src/" dir) (setq dir (substring dir (match-end 0))) (setq dir (file-name-nondirectory (directory-file-name dir)))) + (setq dir (directory-file-name dir)) (while (string-match "/" dir) - (setq dir (replace-match "_" t t dir))) - (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE" - (concat dir "." fpak)) + (setq dir (replace-match "." t t dir))) + (srecode-dictionary-set-value dict "FILENAME_AS_PACKAGE" dir) (srecode-dictionary-set-value dict "FILENAME_AS_CLASS" fnox) - )) + ) + ;; Symbols needed for most other files with stuff in them. + (let ((pkg (semantic-find-tags-by-class 'package (current-buffer)))) + (when pkg + (srecode-dictionary-set-value dict "CURRENT_PACKAGE" (semantic-tag-name (car pkg))) + )) + ) (provide 'srecode/java) diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 3f891092d7d..d6613ee1b02 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -297,7 +297,7 @@ if that file is NEW, otherwise assume the mode has not changed." (when (not srecode-current-map) (condition-case nil (setq srecode-current-map - (eieio-persistent-read srecode-map-save-file)) + (eieio-persistent-read srecode-map-save-file srecode-map)) (error ;; There was an error loading the old map. Create a new one. (setq srecode-current-map diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index e2c07a0863e..805e324a8bd 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -32,8 +32,11 @@ (require 'srecode/map) (require 'semantic/decorate) (require 'semantic/wisent) +(require 'semantic/senator) +(require 'semantic/wisent) -(eval-when-compile (require 'semantic/find)) +(eval-when-compile + (require 'semantic/find)) ;;; Code: @@ -154,13 +157,22 @@ minor mode is enabled. :keymap srecode-mode-map ;; If we are turning things on, make sure we have templates for ;; this mode first. - (when srecode-minor-mode - (when (not (apply + (if srecode-minor-mode + (if (not (apply 'append (mapcar (lambda (map) (srecode-map-entries-for-mode map major-mode)) (srecode-get-maps)))) - (setq srecode-minor-mode nil)))) + (setq srecode-minor-mode nil) + ;; Else, we have success, do stuff + (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t) + ) + (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t) + ) + ;; Run hooks if we are turning this on. + (when srecode-minor-mode + (run-hooks 'srecode-minor-mode-hook)) + srecode-minor-mode) ;;;###autoload (define-minor-mode global-srecode-minor-mode diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 827979f786a..877f6796c76 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -351,6 +351,12 @@ as `function' will leave point where code might be inserted." (setq temp (srecode-semantic-find-template "variable-const" prototype ctxt)) ) + + ((and (semantic-tag-of-class-p tag 'include) + (semantic-tag-get-attribute tag :system-flag)) + (setq temp (srecode-semantic-find-template + "system-include" prototype ctxt)) + ) ) (when (not temp) diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 48eeab2408f..12fc08b90e4 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -70,13 +70,17 @@ (3 font-lock-builtin-face )) ("^\\(sectiondictionary\\)\\s-+\"" (1 font-lock-keyword-face)) + ("^\\s\s*\\(section\\)\\s-+\"" + (1 font-lock-keyword-face)) + ("^\\s\s*\\(end\\)" + (1 font-lock-keyword-face)) ("^\\(bind\\)\\s-+\"" (1 font-lock-keyword-face)) ;; Variable type setting - ("^\\(set\\)\\s-+\\(\\w+\\)\\s-+" + ("^\\s\s*\\(set\\)\\s-+\\(\\w+\\)\\s-+" (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) - ("^\\(show\\)\\s-+\\(\\w+\\)\\s-*$" + ("^\\s\s*\\(show\\)\\s-+\\(\\w+\\)\\s-*$" (1 font-lock-keyword-face) (2 font-lock-variable-name-face)) ("\\<\\(macro\\)\\s-+\"" diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el index 8beeb04940d..6f5d73aa312 100644 --- a/lisp/cedet/srecode/srt-wy.el +++ b/lisp/cedet/srecode/srt-wy.el @@ -24,6 +24,7 @@ ;;; Code: (require 'semantic/lex) +(eval-when-compile (require 'semantic/bovine)) ;;; Prologue ;; @@ -38,6 +39,8 @@ ("context" . CONTEXT) ("template" . TEMPLATE) ("sectiondictionary" . SECTIONDICTIONARY) + ("section" . SECTION) + ("end" . END) ("prompt" . PROMPT) ("default" . DEFAULT) ("defaultmacro" . DEFAULTMACRO) @@ -48,6 +51,8 @@ ("defaultmacro" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") ("default" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") ("prompt" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]") + ("end" summary "section ... end") + ("section" summary "section <name>\\n <dictionary entries>\\n end") ("sectiondictionary" summary "sectiondictionary <name>\\n <dictionary entries>") ("template" summary "template <name>\\n <template definition>") ("context" summary "context <name>") @@ -73,6 +78,7 @@ '(("number" :declared t) ("string" :declared t) ("symbol" :declared t) + ("property" syntax ":\\(\\w\\|\\s_\\)*") ("property" :declared t) ("newline" :declared t) ("punctuation" syntax "\\s.+") @@ -85,7 +91,7 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number) + '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY SECTION END PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number) nil (template_file ((newline) @@ -141,7 +147,7 @@ (cons 'macro (read $2)))) (template - ((TEMPLATE templatename opt-dynamic-arguments newline opt-string opt-section-dictionaries TEMPLATE_BLOCK newline opt-bind) + ((TEMPLATE templatename opt-dynamic-arguments newline opt-string section-dictionary-list TEMPLATE_BLOCK newline opt-bind) (wisent-raw-tag (semantic-tag-new-function $2 nil $3 :documentation $5 :code $7 :dictionaries $6 :binding $9)))) (templatename @@ -162,26 +168,40 @@ ((string newline) (read $1)) (nil nil)) - (opt-section-dictionaries - (nil nil) - ((section-dictionary-list))) (section-dictionary-list - ((one-section-dictionary) - (list $1)) - ((section-dictionary-list one-section-dictionary) + (nil nil) + ((section-dictionary-list flat-section-dictionary) + (append $1 + (list $2))) + ((section-dictionary-list section-dictionary) (append $1 (list $2)))) - (one-section-dictionary - ((SECTIONDICTIONARY string newline variable-list) + (flat-section-dictionary + ((SECTIONDICTIONARY string newline flat-dictionary-entry-list) + (cons + (read $2) + $4))) + (flat-dictionary-entry-list + (nil nil) + ((flat-dictionary-entry-list flat-dictionary-entry) + (append $1 $2))) + (flat-dictionary-entry + ((variable) + (wisent-cook-tag $1))) + (section-dictionary + ((SECTION string newline dictionary-entry-list END newline) (cons (read $2) $4))) - (variable-list + (dictionary-entry-list + (nil nil) + ((dictionary-entry-list dictionary-entry) + (append $1 $2))) + (dictionary-entry ((variable) (wisent-cook-tag $1)) - ((variable-list variable) - (append $1 - (wisent-cook-tag $2)))) + ((section-dictionary) + (list $1))) (opt-bind ((BIND string newline) (read $2)) @@ -205,12 +225,12 @@ ;;; Analyzers - -(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer - "string analyzer for <punctuation> tokens." - "\\s.+" +;; +(define-lex-regex-type-analyzer srecode-template-wy--<property>-regexp-analyzer + "regexp analyzer for <property> tokens." + ":\\(\\w\\|\\s_\\)*" nil - 'punctuation) + 'property) (define-lex-regex-type-analyzer srecode-template-wy--<symbol>-regexp-analyzer "regexp analyzer for <symbol> tokens." @@ -224,6 +244,12 @@ nil 'number) +(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer + "string analyzer for <punctuation> tokens." + "\\s.+" + nil + 'punctuation) + (define-lex-sexp-type-analyzer srecode-template-wy--<string>-sexp-analyzer "sexp analyzer for <string> tokens." "\\s\"" diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index fb7ce6bad2f..37403c4fb9e 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -68,6 +68,15 @@ If this is nil, then this template table belongs to a set of generic templates that can be used with no additional dictionary values. When it is non-nil, it is assumed the template macros need specialized Emacs Lisp code to fill in the dictionary.") + (framework :initarg :framework + :type symbol + :documentation + "Tracks the name of the framework these templates belong to. +If nil, then this template table belongs to any framework, or can be +considered generic for all files of this language. +A framework might be a specific library or build environment for which +special templates are desired. OpenGL might be a framework that +exists for multiple languages.") (priority :initarg :priority :type number :documentation @@ -113,23 +122,39 @@ Tracks various lookup hash tables.") (major-mode :initarg :major-mode :documentation "Table of template tables for this major-mode.") + (modetables :initarg :modetables + :documentation + "All that tables unique to this major mode.") (tables :initarg :tables :documentation - "All the tables that have been defined for this major mode.") + "All the tables that can be used for this major mode.") ) "Track template tables for a particular major mode. Tracks all the template-tables for a specific major mode.") (defun srecode-get-mode-table (mode) "Get the SRecoder mode table for the major mode MODE. -Optional argument SOFT indicates to not make a new one if a table -was not found." - (let ((ans nil)) - (while (and (not ans) mode) - (setq ans (eieio-instance-tracker-find - mode 'major-mode 'srecode-mode-table-list) - mode (get-mode-local-parent mode))) - ans)) +This will find the mode table specific to MODE, and then +calculate all inherited templates from parent modes." + (let ((table nil) + (tmptable nil)) + (while mode + (setq tmptable (eieio-instance-tracker-find + mode 'major-mode 'srecode-mode-table-list) + mode (get-mode-local-parent mode)) + (when tmptable + (if (not table) + (progn + ;; If this is the first, update tables to have + ;; all the mode specific tables in it. + (setq table tmptable) + (oset table tables (oref table modetables))) + ;; If there already is a table, then reset the tables + ;; slot to include all the tables belonging to this new child node. + (oset table tables (append (oref table modetables) + (oref tmptable modetables))))) + ) + table)) (defun srecode-make-mode-table (mode) "Get the SRecoder mode table for the major mode MODE." @@ -140,6 +165,7 @@ was not found." (let* ((ms (if (stringp mode) mode (symbol-name mode))) (new (srecode-mode-table ms :major-mode mode + :modetables nil :tables nil))) ;; Save this new mode table in that mode's variable. (eval `(setq-mode-local ,mode srecode-table ,new)) @@ -149,7 +175,7 @@ was not found." (defmethod srecode-mode-table-find ((mt srecode-mode-table) file) "Look in the mode table MT for a template table from FILE. Return nil if there was none." - (object-assoc file 'file (oref mt tables))) + (object-assoc file 'file (oref mt modetables))) (defun srecode-mode-table-new (mode file &rest init) "Create a new template table for MODE in FILE. @@ -166,16 +192,16 @@ INIT are the initialization parameters for the new template table." init ))) ;; Whack the old table. - (when old (object-remove-from-list mt 'tables old)) + (when old (object-remove-from-list mt 'modetables old)) ;; Add the new table - (object-add-to-list mt 'tables new) + (object-add-to-list mt 'modetables new) ;; Sort the list in reverse order. When other routines ;; go front-to-back, the highest priority items are put ;; into the search table first, allowing lower priority items ;; to be the items found in the search table. - (object-sort-list mt 'tables (lambda (a b) - (> (oref a :priority) - (oref b :priority)))) + (object-sort-list mt 'modetables (lambda (a b) + (> (oref a :priority) + (oref b :priority)))) ;; Return it. new)) @@ -231,6 +257,9 @@ Use PREDICATE is the same as for the `sort' function." (when (oref tab :application) (princ "\nApplication: ") (princ (oref tab :application))) + (when (oref tab :framework) + (princ "\nFramework: ") + (princ (oref tab :framework))) (when (oref tab :project) (require 'srecode/find) ; For srecode-template-table-in-project-p (princ "\nProject Directory: ") |