aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric M. Ludlam2010-09-21 18:11:23 -0400
committerChong Yidong2010-09-21 18:11:23 -0400
commitb9749554532876da8bc15e10bc3fb8bd8c0f32ea (patch)
tree0d00b9800e8eb95e8466ab322fde1879e378fddb
parentfbb3da770f233a8e0cf99d5f053b0c31cbbc8db4 (diff)
downloademacs-b9749554532876da8bc15e10bc3fb8bd8c0f32ea.tar.gz
emacs-b9749554532876da8bc15e10bc3fb8bd8c0f32ea.zip
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.
-rw-r--r--etc/ChangeLog4
-rw-r--r--etc/srecode/java.srt2
-rw-r--r--lisp/cedet/ChangeLog70
-rw-r--r--lisp/cedet/cedet.el14
-rw-r--r--lisp/cedet/pulse.el44
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/compile.el129
-rw-r--r--lisp/cedet/srecode/cpp.el82
-rw-r--r--lisp/cedet/srecode/dictionary.el303
-rw-r--r--lisp/cedet/srecode/fields.el16
-rw-r--r--lisp/cedet/srecode/find.el88
-rw-r--r--lisp/cedet/srecode/getset.el3
-rw-r--r--lisp/cedet/srecode/insert.el162
-rw-r--r--lisp/cedet/srecode/map.el10
-rw-r--r--lisp/cedet/srecode/mode.el84
-rw-r--r--lisp/cedet/srecode/semantic.el10
-rw-r--r--lisp/cedet/srecode/table.el13
-rw-r--r--lisp/cedet/srecode/texi.el11
18 files changed, 730 insertions, 317 deletions
diff --git a/etc/ChangeLog b/etc/ChangeLog
index d2145fb811b..7bbc06fa4af 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,7 @@
12010-09-21 Eric Ludlam <zappo@gnu.org>
2
3 * srecode/java.srt: Make NAME be a prompt.
4
12010-08-22 Alex Harsanyi <harsanyi@mac.com> (tiny change) 52010-08-22 Alex Harsanyi <harsanyi@mac.com> (tiny change)
2 6
3 * emacs3.py: Import imp module and use it (Bug#5756). 7 * emacs3.py: Import imp module and use it (Bug#5756).
diff --git a/etc/srecode/java.srt b/etc/srecode/java.srt
index c449f0d77c9..d4cc986a323 100644
--- a/etc/srecode/java.srt
+++ b/etc/srecode/java.srt
@@ -83,7 +83,7 @@ public Class {{?NAME}} {{#PARENTS}}{{#FIRST}}extends {{/FIRST}}{{#NOTFIRST}}impl
83template include :blank 83template include :blank
84"An include statement." 84"An include statement."
85---- 85----
86import {{NAME}}; 86import {{?NAME}};
87---- 87----
88 88
89context misc 89context misc
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog
index cdd5568dffc..34120817a43 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog
@@ -1,5 +1,75 @@
12010-09-21 Eric Ludlam <zappo@gnu.org> 12010-09-21 Eric Ludlam <zappo@gnu.org>
2 2
3 Synch SRecode to CEDET 1.0.
4
5 * pulse.el (pulse-momentary-highlight-overlay): If pulse-flag is
6 'never, disable all pulsing.
7
8 * cedet.el (cedet-version):
9 * srecode.el (srecode-version): Bump version to 1.0.
10
11 * srecode/texi.el (srecode-texi-insert-tag-as-doc): New function.
12 (semantic-insert-foreign-tag): Use it.
13
14 * srecode/mode.el (srecode-bind-insert): Call
15 srecode-load-tables-for-mode.
16 (srecode-minor-mode-templates-menu): Do not list templates that
17 are not in the current project.
18 (srecode-menu-bar): Add binding for srecode-macro-help.
19
20 * srecode/table.el (srecode-template-table): Add :project slot.
21 (srecode-dump): Dump it.
22
23 * srecode/map.el (srecode-map-update-map): Make map loading more
24 robust.
25
26 * srecode/insert.el (srecode-insert-fcn): Merge template
27 dictionary before resolving arguments.
28 (srecode-insert-method-helper): Add error checking to make sure
29 that we only have dictionaries.
30 (srecode-insert-method): Check template nesting depth when using
31 point inserter override.
32 (srecode-insert-method): Install override with depth limit.
33
34 * srecode/getset.el (srecode-insert-getset): Force tag table
35 update. Don't query the class if it is empty.
36
37 * srecode/find.el (srecode-template-get-table)
38 (srecode-template-get-table-for-binding)
39 (srecode-all-template-hash): Skip if not in current project.
40 (srecode-template-table-in-project-p): New method.
41
42 * srecode/fields.el (srecode-fields-exit-confirmation): New option.
43 (srecode-field-exit-ask): Use it.
44
45 * srecode/dictionary.el (srecode-dictionary-add-template-table):
46 Do not add variables in tables not for the current project.
47 (srecode-compound-toString): Handle cases where the default value
48 is another compound value.
49 (srecode-dictionary-lookup-name): New optional argument
50 NON-RECURSIVE, which inhibits visiting dictionary parents.
51 (srecode-dictionary-add-section-dictionary)
52 (srecode-dictionary-merge): New optional argument FORCE adds
53 values even if an identically named entry exists.
54 (srecode-dictionary-add-entries): New method.
55 (srecode-create-dictionaries-from-tags): New function.
56
57 * srecode/cpp.el (srecode-cpp): New defgroup.
58 (srecode-cpp-namespaces): New option.
59 (srecode-semantic-handle-:using-namespaces)
60 (srecode-cpp-apply-templates): New functions.
61 (srecode-semantic-apply-tag-to-dict): Handle template parameters
62 by calling `srecode-cpp-apply-templates'.
63
64 * srecode/compile.el (srecode-compile-templates): Fix directory
65 compare of built-in templates. Give built-ins lower piority.
66 Support special variable "project".
67 (srecode-compile-template-table): Set :project slot of new tables.
68 (srecode-compile-one-template-tag): Use
69 srecode-create-dictionaries-from-tags.
70
712010-09-21 Eric Ludlam <zappo@gnu.org>
72
3 Synch EDE to CEDET 1.0. 73 Synch EDE to CEDET 1.0.
4 74
5 * cedet-idutils.el (cedet-idutils-make-command): New option. 75 * cedet-idutils.el (cedet-idutils-make-command): New option.
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index b15745aac76..26452f20c17 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -36,19 +36,19 @@
36 36
37(declare-function inversion-find-version "inversion") 37(declare-function inversion-find-version "inversion")
38 38
39(defconst cedet-version "1.0pre7" 39(defconst cedet-version "1.0"
40 "Current version of CEDET.") 40 "Current version of CEDET.")
41 41
42(defconst cedet-packages 42(defconst cedet-packages
43 `( 43 `(
44 ;;PACKAGE MIN-VERSION 44 ;;PACKAGE MIN-VERSION
45 (cedet ,cedet-version) 45 (cedet ,cedet-version)
46 (eieio "1.2") 46 (eieio "1.3")
47 (semantic "2.0pre7") 47 (semantic "2.0")
48 (srecode "1.0pre7") 48 (srecode "1.0")
49 (ede "1.0pre7") 49 (ede "1.0")
50 (speedbar "1.0.3")) 50 (speedbar "1.0"))
51 "Table of CEDET packages to install.") 51 "Table of CEDET packages installed.")
52 52
53(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") 53(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu")
54 (let ((map (make-sparse-keymap "CEDET menu"))) 54 (let ((map (make-sparse-keymap "CEDET menu")))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index ce11c18e609..593f196982b 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -3,6 +3,7 @@
3;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 3;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 4
5;; Author: Eric M. Ludlam <eric@siege-engine.com> 5;; Author: Eric M. Ludlam <eric@siege-engine.com>
6;; Version: 1.0
6 7
7;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
8 9
@@ -57,10 +58,14 @@
57 (error nil))) 58 (error nil)))
58 59
59(defcustom pulse-flag (pulse-available-p) 60(defcustom pulse-flag (pulse-available-p)
60 "*Non-nil means to pulse the overlay face for momentary highlighting. 61 "Whether to use pulsing for momentary highlighting.
61Pulsing involves a bright highlight that slowly shifts to the background 62Pulsing involves a bright highlight that slowly shifts to the
62color. Non-nil just means to highlight with an unchanging color for a short 63background color.
63time. 64
65If the value is nil, highlight with an unchanging color until a
66key is pressed.
67If the value is `never', do no coloring at all.
68Any other value means to the default pulsing behavior.
64 69
65If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then 70If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
66this flag is ignored." 71this flag is ignored."
@@ -178,22 +183,23 @@ Be sure to call `pulse-reset-face' after calling pulse."
178Optional argument FACE specifies the fact to do the highlighting." 183Optional argument FACE specifies the fact to do the highlighting."
179 (overlay-put o 'original-face (overlay-get o 'face)) 184 (overlay-put o 'original-face (overlay-get o 'face))
180 (add-to-list 'pulse-momentary-overlay o) 185 (add-to-list 'pulse-momentary-overlay o)
181 (if (or (not pulse-flag) (not (pulse-available-p))) 186 (if (eq pulse-flag 'never)
182 ;; Provide a face... clear on next command 187 nil
183 (progn 188 (if (or (not pulse-flag) (not (pulse-available-p)))
184 (overlay-put o 'face (or face 'pulse-highlight-start-face)) 189 ;; Provide a face... clear on next command
185 (add-hook 'pre-command-hook
186 'pulse-momentary-unhighlight)
187 )
188 ;; pulse it.
189 (unwind-protect
190 (progn 190 (progn
191 (overlay-put o 'face 'pulse-highlight-face) 191 (overlay-put o 'face (or face 'pulse-highlight-start-face))
192 ;; The pulse function puts FACE onto 'pulse-highlight-face. 192 (add-hook 'pre-command-hook
193 ;; Thus above we put our face on the overlay, but pulse 193 'pulse-momentary-unhighlight))
194 ;; with a reference face needed for the color. 194 ;; pulse it.
195 (pulse face)) 195 (unwind-protect
196 (pulse-momentary-unhighlight)))) 196 (progn
197 (overlay-put o 'face 'pulse-highlight-face)
198 ;; The pulse function puts FACE onto 'pulse-highlight-face.
199 ;; Thus above we put our face on the overlay, but pulse
200 ;; with a reference face needed for the color.
201 (pulse face))
202 (pulse-momentary-unhighlight)))))
197 203
198(defun pulse-momentary-unhighlight () 204(defun pulse-momentary-unhighlight ()
199 "Unhighlight a line recently highlighted." 205 "Unhighlight a line recently highlighted."
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index a903ffd0af1..ac9a000ccd5 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -40,7 +40,7 @@
40(require 'mode-local) 40(require 'mode-local)
41(load "srecode/loaddefs" nil 'nomessage) 41(load "srecode/loaddefs" nil 'nomessage)
42 42
43(defvar srecode-version "1.0pre7" 43(defvar srecode-version "1.0"
44 "Current version of the Semantic Recoder.") 44 "Current version of the Semantic Recoder.")
45 45
46;;; Code: 46;;; Code:
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 3caab23e31f..de9b6f56de3 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -35,19 +35,17 @@
35(require 'semantic) 35(require 'semantic)
36(require 'eieio) 36(require 'eieio)
37(require 'eieio-base) 37(require 'eieio-base)
38(require 'srecode)
39(require 'srecode/table) 38(require 'srecode/table)
39(require 'srecode/dictionary)
40 40
41(declare-function srecode-template-inserter-newline-child-p "srecode/insert" 41(declare-function srecode-template-inserter-newline-child-p "srecode/insert"
42 t t) 42 t t)
43(declare-function srecode-create-section-dictionary "srecode/dictionary")
44(declare-function srecode-dictionary-compound-variable "srecode/dictionary")
45 43
46;;; Code: 44;;; Code:
47 45
48;;; Template Class 46;;; Template Class
49;; 47;;
50;; Templatets describe a patter of text that can be inserted into a 48;; Templates describe a pattern of text that can be inserted into a
51;; buffer. 49;; buffer.
52;; 50;;
53(defclass srecode-template (eieio-named) 51(defclass srecode-template (eieio-named)
@@ -213,6 +211,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
213 (mode nil) 211 (mode nil)
214 (application nil) 212 (application nil)
215 (priority nil) 213 (priority nil)
214 (project nil)
216 (vars nil) 215 (vars nil)
217 ) 216 )
218 217
@@ -256,6 +255,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
256 (setq application (read firstvalue))) 255 (setq application (read firstvalue)))
257 ((string= name "priority") 256 ((string= name "priority")
258 (setq priority (read firstvalue))) 257 (setq priority (read firstvalue)))
258 ((string= name "project")
259 (setq project firstvalue))
259 (t 260 (t
260 ;; Assign this into some table of variables. 261 ;; Assign this into some table of variables.
261 (setq vars (cons (cons name firstvalue) vars)) 262 (setq vars (cons (cons name firstvalue) vars))
@@ -297,12 +298,19 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
297 ;; Calculate priority 298 ;; Calculate priority
298 ;; 299 ;;
299 (if (not priority) 300 (if (not priority)
300 (let ((d (file-name-directory (buffer-file-name))) 301 (let ((d (expand-file-name (file-name-directory (buffer-file-name))))
301 (sd (file-name-directory (locate-library "srecode"))) 302 (sd (expand-file-name (file-name-directory (locate-library "srecode"))))
302 (defaultdelta (if (eq mode 'default) 20 0))) 303 (defaultdelta (if (eq mode 'default) 0 10)))
303 (if (string= d sd) 304 ;; @TODO : WHEN INTEGRATING INTO EMACS
304 (setq priority (+ 80 defaultdelta)) 305 ;; The location of Emacs default templates needs to be specified
305 (setq priority (+ 30 defaultdelta))) 306 ;; here to also have a lower priority.
307 (if (string-match (concat "^" sd) d)
308 (setq priority (+ 30 defaultdelta))
309 ;; If the user created template is for a project, then
310 ;; don't add as much as if it is unique to just some user.
311 (if (stringp project)
312 (setq priority (+ 50 defaultdelta))
313 (setq priority (+ 80 defaultdelta))))
306 (message "Templates %s has estimated priority of %d" 314 (message "Templates %s has estimated priority of %d"
307 (file-name-nondirectory (buffer-file-name)) 315 (file-name-nondirectory (buffer-file-name))
308 priority)) 316 priority))
@@ -311,56 +319,56 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
311 priority)) 319 priority))
312 320
313 ;; Save it up! 321 ;; Save it up!
314 (srecode-compile-template-table table mode priority application vars) 322 (srecode-compile-template-table table mode priority application project vars)
315 ) 323 )
316) 324)
317 325
318(defun srecode-compile-one-template-tag (tag STATE) 326(defun srecode-compile-one-template-tag (tag state)
319 "Compile a template tag TAG into an srecode template class. 327 "Compile a template tag TAG into a srecode template object.
320STATE is the current compile state as an object `srecode-compile-state'." 328STATE is the current compile state as an object of class
321 (require 'srecode/dictionary) 329`srecode-compile-state'."
322 (let* ((context (oref STATE context)) 330 (let* ((context (oref state context))
323 (codeout (srecode-compile-split-code 331 (code (cdr (srecode-compile-split-code
324 tag (semantic-tag-get-attribute tag :code) 332 tag (semantic-tag-get-attribute tag :code)
325 STATE)) 333 state)))
326 (code (cdr codeout)) 334 (args (semantic-tag-function-arguments tag))
327 (args (semantic-tag-function-arguments tag)) 335 (binding (semantic-tag-get-attribute tag :binding))
328 (binding (semantic-tag-get-attribute tag :binding)) 336 (dict-tags (semantic-tag-get-attribute tag :dictionaries))
329 (rawdicts (semantic-tag-get-attribute tag :dictionaries)) 337 (root-dict (when dict-tags
330 (sdicts (srecode-create-section-dictionary rawdicts STATE)) 338 (srecode-create-dictionaries-from-tags
331 (addargs nil) 339 dict-tags state)))
332 ) 340 (addargs))
333; (message "Compiled %s to %d codes with %d args and %d prompts." 341 ;; Examine arguments.
334; (semantic-tag-name tag) 342 (dolist (arg args)
335; (length code) 343 (let ((symbol (intern arg)))
336; (length args) 344 (push symbol addargs)
337; (length prompts)) 345
338 (while args 346 ;; If we have a wrap, then put wrap inserters on both ends of
339 (setq addargs (cons (intern (car args)) addargs)) 347 ;; the code.
340 (when (eq (car addargs) :blank) 348 (when (eq symbol :blank)
341 ;; If we have a wrap, then put wrap inserters on both 349 (setq code (append
342 ;; ends of the code. 350 (list (srecode-compile-inserter
343 (setq code (append 351 "BLANK"
344 (list (srecode-compile-inserter "BLANK" 352 "\r"
345 "\r" 353 state
346 STATE 354 :secondname nil
347 :secondname nil 355 :where 'begin))
348 :where 'begin)) 356 code
349 code 357 (list (srecode-compile-inserter
350 (list (srecode-compile-inserter "BLANK" 358 "BLANK"
351 "\r" 359 "\r"
352 STATE 360 state
353 :secondname nil 361 :secondname nil
354 :where 'end)) 362 :where 'end)))))))
355 ))) 363
356 (setq args (cdr args))) 364 ;; Construct and return the template object.
357 (srecode-template (semantic-tag-name tag) 365 (srecode-template (semantic-tag-name tag)
358 :context context 366 :context context
359 :args (nreverse addargs) 367 :args (nreverse addargs)
360 :dictionary sdicts 368 :dictionary root-dict
361 :binding binding 369 :binding binding
362 :code code) 370 :code code))
363 )) 371 )
364 372
365(defun srecode-compile-do-hard-newline-p (comp) 373(defun srecode-compile-do-hard-newline-p (comp)
366 "Examine COMP to decide if the upcoming newline should be hard. 374 "Examine COMP to decide if the upcoming newline should be hard.
@@ -514,12 +522,13 @@ to the inserter constructor."
514 (if (not new) (error "SRECODE: Unknown macro code %S" key)) 522 (if (not new) (error "SRECODE: Unknown macro code %S" key))
515 new))) 523 new)))
516 524
517(defun srecode-compile-template-table (templates mode priority application vars) 525(defun srecode-compile-template-table (templates mode priority application project vars)
518 "Compile a list of TEMPLATES into an semantic recode table. 526 "Compile a list of TEMPLATES into an semantic recode table.
519The table being compiled is for MODE, or the string \"default\". 527The table being compiled is for MODE, or the string \"default\".
520PRIORITY is a numerical value that indicates this tables location 528PRIORITY is a numerical value that indicates this tables location
521in an ordered search. 529in an ordered search.
522APPLICATION is the name of the application these templates belong to. 530APPLICATION is the name of the application these templates belong to.
531PROJECT is a directory name which these templates scope to.
523A list of defined variables VARS provides a variable table." 532A list of defined variables VARS provides a variable table."
524 (let ((namehash (make-hash-table :test 'equal 533 (let ((namehash (make-hash-table :test 'equal
525 :size (length templates))) 534 :size (length templates)))
@@ -549,6 +558,9 @@ A list of defined variables VARS provides a variable table."
549 558
550 (setq lp (cdr lp)))) 559 (setq lp (cdr lp))))
551 560
561 (when (stringp project)
562 (setq project (expand-file-name project)))
563
552 (let* ((table (srecode-mode-table-new mode (buffer-file-name) 564 (let* ((table (srecode-mode-table-new mode (buffer-file-name)
553 :templates (nreverse templates) 565 :templates (nreverse templates)
554 :namehash namehash 566 :namehash namehash
@@ -556,7 +568,8 @@ A list of defined variables VARS provides a variable table."
556 :variables vars 568 :variables vars
557 :major-mode mode 569 :major-mode mode
558 :priority priority 570 :priority priority
559 :application application)) 571 :application application
572 :project project))
560 (tmpl (oref table templates))) 573 (tmpl (oref table templates)))
561 ;; Loop over all the templates, and xref. 574 ;; Loop over all the templates, and xref.
562 (while tmpl 575 (while tmpl
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index ceaa6fba3aa..7fe2bdaa410 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -26,6 +26,27 @@
26 26
27;;; Code: 27;;; Code:
28 28
29(require 'srecode)
30(require 'srecode/dictionary)
31(require 'srecode/semantic)
32(require 'semantic/tag)
33
34;;; Customization
35;;
36
37(defgroup srecode-cpp nil
38 "C++-specific Semantic Recoder settings."
39 :group 'srecode)
40
41(defcustom srecode-cpp-namespaces
42 '("std" "boost")
43 "List expansion candidates for the :using-namespaces argument.
44A dictionary entry of the named PREFIX_NAMESPACE with the value
45NAMESPACE:: is created for each namespace unless the current
46buffer contains a using NAMESPACE; statement "
47 :group 'srecode-cpp
48 :type '(repeat string))
49
29;;; :cpp ARGUMENT HANDLING 50;;; :cpp ARGUMENT HANDLING
30;; 51;;
31;; When a :cpp argument is required, fill the dictionary with 52;; When a :cpp argument is required, fill the dictionary with
@@ -33,10 +54,6 @@
33;; 54;;
34;; Error if not in a C++ mode. 55;; Error if not in a C++ mode.
35 56
36(require 'srecode)
37(require 'srecode/dictionary)
38(require 'srecode/semantic)
39
40;;;###autoload 57;;;###autoload
41(defun srecode-semantic-handle-:cpp (dict) 58(defun srecode-semantic-handle-:cpp (dict)
42 "Add macros into the dictionary DICT based on the current c++ file. 59 "Add macros into the dictionary DICT based on the current c++ file.
@@ -59,6 +76,23 @@ HEADER - Shown section if in a header file."
59 ) 76 )
60 ) 77 )
61 78
79(defun srecode-semantic-handle-:using-namespaces (dict)
80 "Add macros into the dictionary DICT based on used namespaces.
81Adds the following:
82PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'."
83 (let ((tags (semantic-find-tags-by-class
84 'using (semantic-fetch-tags))))
85 (dolist (name srecode-cpp-namespaces)
86 (let ((variable (format "PREFIX_%s" (upcase name)))
87 (prefix (format "%s::" name)))
88 (srecode-dictionary-set-value dict variable prefix)
89 (dolist (tag tags)
90 (when (and (eq (semantic-tag-get-attribute tag :kind)
91 'namespace)
92 (string= (semantic-tag-name tag) name))
93 (srecode-dictionary-set-value dict variable ""))))))
94 )
95
62(define-mode-local-override srecode-semantic-apply-tag-to-dict 96(define-mode-local-override srecode-semantic-apply-tag-to-dict
63 c++-mode (tag-wrapper dict) 97 c++-mode (tag-wrapper dict)
64 "Apply C++ specific features from TAG-WRAPPER into DICT. 98 "Apply C++ specific features from TAG-WRAPPER into DICT.
@@ -97,6 +131,7 @@ special behavior for tag of classes include, using and function."
97 (srecode-semantic-tag (semantic-tag-name value-tag) 131 (srecode-semantic-tag (semantic-tag-name value-tag)
98 :prime value-tag) 132 :prime value-tag)
99 value-dict)) 133 value-dict))
134
100 ;; Discriminate using statements referring to namespaces and 135 ;; Discriminate using statements referring to namespaces and
101 ;; types. 136 ;; types.
102 (when (eq (semantic-tag-get-attribute tag :kind) 'namespace) 137 (when (eq (semantic-tag-get-attribute tag :kind) 'namespace)
@@ -111,7 +146,8 @@ special behavior for tag of classes include, using and function."
111 ;; when they make sense. My best bet would be 146 ;; when they make sense. My best bet would be
112 ;; (semantic-tag-function-parent tag), but it is not there, when 147 ;; (semantic-tag-function-parent tag), but it is not there, when
113 ;; the function is defined in the scope of a class. 148 ;; the function is defined in the scope of a class.
114 (let ((member 't) 149 (let ((member t)
150 (templates (semantic-tag-get-attribute tag :template))
115 (modifiers (semantic-tag-modifiers tag))) 151 (modifiers (semantic-tag-modifiers tag)))
116 152
117 ;; Add modifiers into the dictionary 153 ;; Add modifiers into the dictionary
@@ -120,6 +156,9 @@ special behavior for tag of classes include, using and function."
120 dict "MODIFIERS"))) 156 dict "MODIFIERS")))
121 (srecode-dictionary-set-value modifier-dict "NAME" modifier))) 157 (srecode-dictionary-set-value modifier-dict "NAME" modifier)))
122 158
159 ;; Add templates into child dictionaries.
160 (srecode-cpp-apply-templates dict templates)
161
123 ;; When the function is a member function, it can have 162 ;; When the function is a member function, it can have
124 ;; additional modifiers. 163 ;; additional modifiers.
125 (when member 164 (when member
@@ -133,11 +172,40 @@ special behavior for tag of classes include, using and function."
133 ;; entry. 172 ;; entry.
134 (when (semantic-tag-get-attribute tag :pure-virtual-flag) 173 (when (semantic-tag-get-attribute tag :pure-virtual-flag)
135 (srecode-dictionary-show-section dict "PURE")) 174 (srecode-dictionary-show-section dict "PURE"))
136 ) 175 )))
137 )) 176
177 ;;
178 ;; CLASS
179 ;;
180 ((eq class 'type)
181 ;; For classes, add template parameters.
182 (when (or (semantic-tag-of-type-p tag "class")
183 (semantic-tag-of-type-p tag "struct"))
184
185 ;; Add templates into child dictionaries.
186 (let ((templates (semantic-tag-get-attribute tag :template)))
187 (srecode-cpp-apply-templates dict templates))))
138 )) 188 ))
139 ) 189 )
140 190
191
192;;; Helper functions
193;;
194
195(defun srecode-cpp-apply-templates (dict templates)
196 "Add section dictionaries for TEMPLATES to DICT."
197 (when templates
198 (let ((templates-dict (srecode-dictionary-add-section-dictionary
199 dict "TEMPLATES")))
200 (dolist (template templates)
201 (let ((template-dict (srecode-dictionary-add-section-dictionary
202 templates-dict "ARGS")))
203 (srecode-semantic-apply-tag-to-dict
204 (srecode-semantic-tag (semantic-tag-name template)
205 :prime template)
206 template-dict)))))
207 )
208
141(provide 'srecode/cpp) 209(provide 'srecode/cpp)
142 210
143;; Local variables: 211;; Local variables:
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index 8d168a7f339..cd97c880595 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -37,6 +37,7 @@
37(declare-function srecode-compile-parse-inserter "srecode/compile") 37(declare-function srecode-compile-parse-inserter "srecode/compile")
38(declare-function srecode-dump-code-list "srecode/compile") 38(declare-function srecode-dump-code-list "srecode/compile")
39(declare-function srecode-load-tables-for-mode "srecode/find") 39(declare-function srecode-load-tables-for-mode "srecode/find")
40(declare-function srecode-template-table-in-project-p "srecode/find")
40(declare-function srecode-insert-code-stream "srecode/insert") 41(declare-function srecode-insert-code-stream "srecode/insert")
41(declare-function data-debug-new-buffer "data-debug") 42(declare-function data-debug-new-buffer "data-debug")
42(declare-function data-debug-insert-object-slots "eieio-datadebug") 43(declare-function data-debug-insert-object-slots "eieio-datadebug")
@@ -157,40 +158,49 @@ buffer's table.
157If BUFFER-OR-PARENT is t, then this dictionary should not be 158If BUFFER-OR-PARENT is t, then this dictionary should not be
158associated with a buffer or parent." 159associated with a buffer or parent."
159 (save-excursion 160 (save-excursion
161 ;; Handle the parent
160 (let ((parent nil) 162 (let ((parent nil)
161 (buffer nil) 163 (buffer nil)
162 (origin nil) 164 (origin nil)
163 (initfrombuff nil)) 165 (initfrombuff nil))
164 (cond ((bufferp buffer-or-parent) 166 (cond
165 (set-buffer buffer-or-parent) 167 ;; Parent is a buffer
166 (setq buffer buffer-or-parent 168 ((bufferp buffer-or-parent)
167 origin (buffer-name buffer-or-parent) 169 (set-buffer buffer-or-parent)
168 initfrombuff t)) 170 (setq buffer buffer-or-parent
169 ((srecode-dictionary-child-p buffer-or-parent) 171 origin (buffer-name buffer-or-parent)
170 (setq parent buffer-or-parent 172 initfrombuff t))
171 buffer (oref buffer-or-parent buffer) 173
172 origin (concat (object-name buffer-or-parent) " in " 174 ;; Parent is another dictionary
173 (if buffer (buffer-name buffer) 175 ((srecode-dictionary-child-p buffer-or-parent)
174 "no buffer"))) 176 (setq parent buffer-or-parent
175 (when buffer 177 buffer (oref buffer-or-parent buffer)
176 (set-buffer buffer))) 178 origin (concat (object-name buffer-or-parent) " in "
177 ((eq buffer-or-parent t) 179 (if buffer (buffer-name buffer)
178 (setq buffer nil 180 "no buffer")))
179 origin "Unspecified Origin")) 181 (when buffer
180 (t 182 (set-buffer buffer)))
181 (setq buffer (current-buffer) 183
182 origin (concat "Unspecified. Assume " 184 ;; No parent
183 (buffer-name buffer)) 185 ((eq buffer-or-parent t)
184 initfrombuff t) 186 (setq buffer nil
185 ) 187 origin "Unspecified Origin"))
186 ) 188
189 ;; Default to unspecified parent
190 (t
191 (setq buffer (current-buffer)
192 origin (concat "Unspecified. Assume "
193 (buffer-name buffer))
194 initfrombuff t)))
195
196 ;; Create the new dictionary object.
187 (let ((dict (srecode-dictionary 197 (let ((dict (srecode-dictionary
188 major-mode 198 major-mode
189 :buffer buffer 199 :buffer buffer
190 :parent parent 200 :parent parent
191 :namehash (make-hash-table :test 'equal 201 :namehash (make-hash-table :test 'equal
192 :size 20) 202 :size 20)
193 :origin origin))) 203 :origin origin)))
194 ;; Only set up the default variables if we are being built 204 ;; Only set up the default variables if we are being built
195 ;; directroy for a particular buffer. 205 ;; directroy for a particular buffer.
196 (when initfrombuff 206 (when initfrombuff
@@ -211,34 +221,37 @@ associated with a buffer or parent."
211TPL is an object representing a compiled template file." 221TPL is an object representing a compiled template file."
212 (when tpl 222 (when tpl
213 (let ((tabs (oref tpl :tables))) 223 (let ((tabs (oref tpl :tables)))
224 (require 'srecode/find) ; For srecode-template-table-in-project-p
214 (while tabs 225 (while tabs
215 (let ((vars (oref (car tabs) variables))) 226 (when (srecode-template-table-in-project-p (car tabs))
216 (while vars 227 (let ((vars (oref (car tabs) variables)))
217 (srecode-dictionary-set-value 228 (while vars
218 dict (car (car vars)) (cdr (car vars))) 229 (srecode-dictionary-set-value
219 (setq vars (cdr vars)))) 230 dict (car (car vars)) (cdr (car vars)))
220 (setq tabs (cdr tabs)))))) 231 (setq vars (cdr vars)))))
232 (setq tabs (cdr tabs))))))
221 233
222 234
223(defmethod srecode-dictionary-set-value ((dict srecode-dictionary) 235(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
224 name value) 236 name value)
225 "In dictionary DICT, set NAME to have VALUE." 237 "In dictionary DICT, set NAME to have VALUE."
226 ;; Validate inputs 238 ;; Validate inputs
227 (if (not (stringp name)) 239 (unless (stringp name)
228 (signal 'wrong-type-argument (list name 'stringp))) 240 (signal 'wrong-type-argument (list name 'stringp)))
241
229 ;; Add the value. 242 ;; Add the value.
230 (with-slots (namehash) dict 243 (with-slots (namehash) dict
231 (puthash name value namehash)) 244 (puthash name value namehash))
232 ) 245 )
233 246
234(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary) 247(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
235 name &optional show-only) 248 name &optional show-only force)
236 "In dictionary DICT, add a section dictionary for section macro NAME. 249 "In dictionary DICT, add a section dictionary for section macro NAME.
237Return the new dictionary. 250Return the new dictionary.
238 251
239You can add several dictionaries to the same section macro. 252You can add several dictionaries to the same section entry.
240For each dictionary added to a macro, the block of codes in the 253For each dictionary added to a variable, the block of codes in
241template will be repeated. 254the template will be repeated.
242 255
243If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary 256If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary
244if there is already one in place. Also, don't add FIRST/LAST entries. 257if there is already one in place. Also, don't add FIRST/LAST entries.
@@ -255,10 +268,11 @@ which will enable SECTIONS to be enabled.
255Adding a new dictionary will alter these values in previously 268Adding a new dictionary will alter these values in previously
256inserted dictionaries." 269inserted dictionaries."
257 ;; Validate inputs 270 ;; Validate inputs
258 (if (not (stringp name)) 271 (unless (stringp name)
259 (signal 'wrong-type-argument (list name 'stringp))) 272 (signal 'wrong-type-argument (list name 'stringp)))
273
260 (let ((new (srecode-create-dictionary dict)) 274 (let ((new (srecode-create-dictionary dict))
261 (ov (srecode-dictionary-lookup-name dict name))) 275 (ov (srecode-dictionary-lookup-name dict name t)))
262 276
263 (when (not show-only) 277 (when (not show-only)
264 ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries. 278 ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries.
@@ -275,7 +289,9 @@ inserted dictionaries."
275 (srecode-dictionary-show-section new "LAST")) 289 (srecode-dictionary-show-section new "LAST"))
276 ) 290 )
277 291
278 (when (or (not show-only) (null ov)) 292 (when (or force
293 (not show-only)
294 (null ov))
279 (srecode-dictionary-set-value dict name (append ov (list new)))) 295 (srecode-dictionary-set-value dict name (append ov (list new))))
280 ;; Return the new sub-dictionary. 296 ;; Return the new sub-dictionary.
281 new)) 297 new))
@@ -283,8 +299,9 @@ inserted dictionaries."
283(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name) 299(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
284 "In dictionary DICT, indicate that the section NAME should be exposed." 300 "In dictionary DICT, indicate that the section NAME should be exposed."
285 ;; Validate inputs 301 ;; Validate inputs
286 (if (not (stringp name)) 302 (unless (stringp name)
287 (signal 'wrong-type-argument (list name 'stringp))) 303 (signal 'wrong-type-argument (list name 'stringp)))
304
288 ;; Showing a section is just like making a section dictionary, but 305 ;; Showing a section is just like making a section dictionary, but
289 ;; with no dictionary values to add. 306 ;; with no dictionary values to add.
290 (srecode-dictionary-add-section-dictionary dict name t) 307 (srecode-dictionary-add-section-dictionary dict name t)
@@ -294,51 +311,120 @@ inserted dictionaries."
294 "In dictionary DICT, indicate that the section NAME should be hidden." 311 "In dictionary DICT, indicate that the section NAME should be hidden."
295 ;; We need to find the has value, and then delete it. 312 ;; We need to find the has value, and then delete it.
296 ;; Validate inputs 313 ;; Validate inputs
297 (if (not (stringp name)) 314 (unless (stringp name)
298 (signal 'wrong-type-argument (list name 'stringp))) 315 (signal 'wrong-type-argument (list name 'stringp)))
316
299 ;; Add the value. 317 ;; Add the value.
300 (with-slots (namehash) dict 318 (with-slots (namehash) dict
301 (remhash name namehash)) 319 (remhash name namehash))
302 nil) 320 nil)
303 321
304(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict) 322(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
305 "Merge into DICT the dictionary entries from OTHERDICT." 323 entries &optional state)
324 "Add ENTRIES to DICT.
325
326ENTRIES is a list of even length of dictionary entries to
327add. ENTRIES looks like this:
328
329 (NAME_1 VALUE_1 NAME_2 VALUE_2 ...)
330
331The following rules apply:
332 * NAME_N is a string
333and for values
334 * If VALUE_N is t, the section NAME_N is shown.
335 * If VALUE_N is a string, an ordinary value is inserted.
336 * If VALUE_N is a dictionary, it is inserted as entry NAME_N.
337 * Otherwise, a compound variable is created for VALUE_N.
338
339The optional argument STATE has to non-nil when compound values
340are inserted. An error is signaled if ENTRIES contains compound
341values but STATE is nil."
342 (while entries
343 (let ((name (nth 0 entries))
344 (value (nth 1 entries)))
345 (cond
346 ;; Value is t; show a section.
347 ((eq value t)
348 (srecode-dictionary-show-section dict name))
349
350 ;; Value is a simple string; create an ordinary dictionary
351 ;; entry
352 ((stringp value)
353 (srecode-dictionary-set-value dict name value))
354
355 ;; Value is a dictionary; insert as child dictionary.
356 ((srecode-dictionary-child-p value)
357 (srecode-dictionary-merge
358 (srecode-dictionary-add-section-dictionary dict name)
359 value t))
360
361 ;; Value is some other object; create a compound value.
362 (t
363 (unless state
364 (error "Cannot insert compound values without state."))
365
366 (srecode-dictionary-set-value
367 dict name
368 (srecode-dictionary-compound-variable
369 name :value value :state state)))))
370 (setq entries (nthcdr 2 entries)))
371 dict)
372
373(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
374 &optional force)
375 "Merge into DICT the dictionary entries from OTHERDICT.
376Unless the optional argument FORCE is non-nil, values in DICT are
377not modified, even if there are values of the same names in
378OTHERDICT."
306 (when otherdict 379 (when otherdict
307 (maphash 380 (maphash
308 (lambda (key entry) 381 (lambda (key entry)
309 ;; Only merge in the new values if there was no old value. 382 ;; The new values is only merged in if there was no old value
383 ;; or FORCE is non-nil.
384 ;;
310 ;; This protects applications from being whacked, and basically 385 ;; This protects applications from being whacked, and basically
311 ;; makes these new section dictionary entries act like 386 ;; makes these new section dictionary entries act like
312 ;; "defaults" instead of overrides. 387 ;; "defaults" instead of overrides.
313 (when (not (srecode-dictionary-lookup-name dict key)) 388 (when (or force
314 (cond ((and (listp entry) (srecode-dictionary-p (car entry))) 389 (not (srecode-dictionary-lookup-name dict key t)))
315 ;; A list of section dictionaries. 390 (cond
316 ;; We need to merge them in. 391 ;; A list of section dictionaries. We need to merge them in.
317 (while entry 392 ((and (listp entry)
318 (let ((new-sub-dict 393 (srecode-dictionary-p (car entry)))
319 (srecode-dictionary-add-section-dictionary 394 (dolist (sub-dict entry)
320 dict key))) 395 (srecode-dictionary-merge
321 (srecode-dictionary-merge new-sub-dict (car entry))) 396 (srecode-dictionary-add-section-dictionary
322 (setq entry (cdr entry))) 397 dict key t t)
323 ) 398 sub-dict force)))
324 399
325 (t 400 ;; Other values can be set directly.
326 (srecode-dictionary-set-value dict key entry))) 401 (t
327 )) 402 (srecode-dictionary-set-value dict key entry)))))
328 (oref otherdict namehash)))) 403 (oref otherdict namehash))))
329 404
330(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary) 405(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
331 name) 406 name &optional non-recursive)
332 "Return information about the current DICT's value for NAME." 407 "Return information about DICT's value for NAME.
408DICT is a dictionary, and NAME is a string that is treated as the
409name of an entry in the dictionary. If such an entry exists, its
410value is returned. Otherwise, nil is returned. Normally, the
411lookup is recursive in the sense that the parent of DICT is
412searched for NAME if it is not found in DICT. This recursive
413lookup can be disabled by the optional argument NON-RECURSIVE.
414
415This function derives values for some special NAMEs, such as
416'FIRST' and 'LAST'."
333 (if (not (slot-boundp dict 'namehash)) 417 (if (not (slot-boundp dict 'namehash))
334 nil 418 nil
335 ;; Get the value of this name from the dictionary 419 ;; Get the value of this name from the dictionary or its parent
336 (or (with-slots (namehash) dict 420 ;; unless the lookup should be non-recursive.
337 (gethash name namehash)) 421 (with-slots (namehash parent) dict
338 (and (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST"))) 422 (or (gethash name namehash)
339 (oref dict parent) 423 (and (not non-recursive)
340 (srecode-dictionary-lookup-name (oref dict parent) name)) 424 (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST")))
341 ))) 425 parent
426 (srecode-dictionary-lookup-name parent name)))))
427 )
342 428
343(defmethod srecode-root-dictionary ((dict srecode-dictionary)) 429(defmethod srecode-root-dictionary ((dict srecode-dictionary))
344 "For dictionary DICT, return the root dictionary. 430 "For dictionary DICT, return the root dictionary.
@@ -431,10 +517,22 @@ inserted with a new editable field.")
431 (start (point)) 517 (start (point))
432 (name (oref sti :object-name))) 518 (name (oref sti :object-name)))
433 519
434 (if (or (not dv) (string= dv "")) 520 (cond
435 (insert name) 521 ;; No default value.
436 (insert dv)) 522 ((not dv) (insert name))
437 523 ;; A compound value as the default? Recurse.
524 ((srecode-dictionary-compound-value-child-p dv)
525 (srecode-compound-toString dv function dictionary))
526 ;; A string that is empty? Use the name.
527 ((and (stringp dv) (string= dv ""))
528 (insert name))
529 ;; Insert strings
530 ((stringp dv) (insert dv))
531 ;; Some other issue
532 (t
533 (error "Unknown default value for value %S" name)))
534
535 ;; Create a field from the inserter.
438 (srecode-field name :name name 536 (srecode-field name :name name
439 :start start 537 :start start
440 :end (point) 538 :end (point)
@@ -482,6 +580,53 @@ STATE is the current compiler state."
482 (setq sectiondicts (cdr sectiondicts))) 580 (setq sectiondicts (cdr sectiondicts)))
483 new))) 581 new)))
484 582
583(defun srecode-create-dictionaries-from-tags (tags state)
584 "Create a dictionary with entries according to TAGS.
585
586TAGS should be in the format produced by the template file
587grammar. That is
588
589TAGS = (ENTRY_1 ENTRY_2 ...)
590
591where
592
593ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG
594
595where TAG is a semantic tag of class 'variable. The (NAME ... )
596form creates a child dictionary which is stored under the name
597NAME. The TAG form creates a value entry or section dictionary
598entry whose name is the name of the tag.
599
600STATE is the current compiler state."
601 (let ((dict (srecode-create-dictionary t))
602 (entries (apply #'append
603 (mapcar
604 (lambda (entry)
605 (cond
606 ;; Entry is a tag
607 ((semantic-tag-p entry)
608 (let ((name (semantic-tag-name entry))
609 (value (semantic-tag-variable-default entry)))
610 (list name
611 (if (and (listp value)
612 (= (length value) 1)
613 (stringp (car value)))
614 (car value)
615 value))))
616
617 ;; Entry is a nested dictionary
618 (t
619 (let ((name (car entry))
620 (entries (cdr entry)))
621 (list name
622 (srecode-create-dictionaries-from-tags
623 entries state))))))
624 tags))))
625 (srecode-dictionary-add-entries
626 dict entries state)
627 dict)
628 )
629
485;;; DUMP DICTIONARY 630;;; DUMP DICTIONARY
486;; 631;;
487;; Make a dictionary, and dump it's contents. 632;; Make a dictionary, and dump it's contents.
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 347538aa871..0cfc2953792 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -35,6 +35,8 @@
35;; Each field has 2 overlays. The second overlay allows control in 35;; Each field has 2 overlays. The second overlay allows control in
36;; the character just after the field, but does not highlight it. 36;; the character just after the field, but does not highlight it.
37 37
38;; @TODO - Cancel an old field array if a new one is about to be created!
39
38;; Keep this library independent of SRecode proper. 40;; Keep this library independent of SRecode proper.
39(require 'eieio) 41(require 'eieio)
40 42
@@ -43,6 +45,10 @@
43 "While inserting a set of fields, collect in this variable. 45 "While inserting a set of fields, collect in this variable.
44Once an insertion set is done, these fields will be activated.") 46Once an insertion set is done, these fields will be activated.")
45 47
48
49;;; Customization
50;;
51
46(defface srecode-field-face 52(defface srecode-field-face
47 '((((class color) (background dark)) 53 '((((class color) (background dark))
48 (:underline "green")) 54 (:underline "green"))
@@ -51,6 +57,11 @@ Once an insertion set is done, these fields will be activated.")
51 "*Face used to specify editable fields from a template." 57 "*Face used to specify editable fields from a template."
52 :group 'semantic-faces) 58 :group 'semantic-faces)
53 59
60(defcustom srecode-fields-exit-confirmation nil
61 "Ask for confirmation before leaving field editing mode."
62 :group 'srecode
63 :type 'boolean)
64
54;;; BASECLASS 65;;; BASECLASS
55;; 66;;
56;; Fields and the template region share some basic overlay features. 67;; Fields and the template region share some basic overlay features.
@@ -237,7 +248,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
237 (remove-hook 'post-command-hook 'srecode-field-post-command t) 248 (remove-hook 'post-command-hook 'srecode-field-post-command t)
238 (if (srecode-point-in-region-p ar) 249 (if (srecode-point-in-region-p ar)
239 nil ;; Keep going 250 nil ;; Keep going
240 ;; We moved out of the temlate. Cancel the edits. 251 ;; We moved out of the template. Cancel the edits.
241 (srecode-delete ar))) 252 (srecode-delete ar)))
242 )) 253 ))
243 254
@@ -429,7 +440,8 @@ PRE-LEN is used in the after mode for the length of the changed text."
429(defun srecode-field-exit-ask () 440(defun srecode-field-exit-ask ()
430 "Ask if the user wants to exit field-editing mini-mode." 441 "Ask if the user wants to exit field-editing mini-mode."
431 (interactive) 442 (interactive)
432 (when (y-or-n-p "Exit field-editing mode? ") 443 (when (or (not srecode-fields-exit-confirmation)
444 (y-or-n-p "Exit field-editing mode? "))
433 (srecode-delete (srecode-active-template-region)))) 445 (srecode-delete (srecode-active-template-region))))
434 446
435 447
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index 1a3057fda0e..9c5a897fc4f 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -92,6 +92,23 @@ all template files for that application will be loaded."
92 )) 92 ))
93 )) 93 ))
94 94
95;;; PROJECT
96;;
97;; Find if a template table has a project set, and if so, is the
98;; current buffer in that project.
99(defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
100 "Return non-nil if the table TAB can be used in the current project.
101If TAB has a :project set, check that the directories match.
102If TAB is nil, then always return t."
103 (let ((proj (oref tab :project)))
104 ;; Return t if the project wasn't set.
105 (if (not proj) t
106 ;; If the project directory was set, lets check it.
107 (let ((dd (expand-file-name default-directory))
108 (projexp (regexp-quote (directory-file-name proj))))
109 (if (string-match (concat "^" projexp) dd)
110 t nil)))))
111
95;;; SEARCH 112;;; SEARCH
96;; 113;;
97;; Find a given template based on name, and features of the current 114;; Find a given template based on name, and features of the current
@@ -103,13 +120,14 @@ all template files for that application will be loaded."
103Optional argument CONTEXT specifies that the template should part 120Optional argument CONTEXT specifies that the template should part
104of a particular context. 121of a particular context.
105The APPLICATION argument is unused." 122The APPLICATION argument is unused."
106 (if context 123 (when (srecode-template-table-in-project-p tab)
107 ;; If a context is specified, then look it up there. 124 (if context
108 (let ((ctxth (gethash context (oref tab contexthash)))) 125 ;; If a context is specified, then look it up there.
109 (when ctxth 126 (let ((ctxth (gethash context (oref tab contexthash))))
110 (gethash template-name ctxth))) 127 (when ctxth
111 ;; No context, perhaps a merged name? 128 (gethash template-name ctxth)))
112 (gethash template-name (oref tab namehash)))) 129 ;; No context, perhaps a merged name?
130 (gethash template-name (oref tab namehash)))))
113 131
114(defmethod srecode-template-get-table ((tab srecode-mode-table) 132(defmethod srecode-template-get-table ((tab srecode-mode-table)
115 template-name &optional 133 template-name &optional
@@ -144,32 +162,33 @@ tables that do not belong to an application will be searched."
144 "Find in the template name in table TAB, the template with BINDING. 162 "Find in the template name in table TAB, the template with BINDING.
145Optional argument CONTEXT specifies that the template should part 163Optional argument CONTEXT specifies that the template should part
146of a particular context." 164of a particular context."
147 (let* ((keyout nil) 165 (when (srecode-template-table-in-project-p tab)
148 (hashfcn (lambda (key value) 166 (let* ((keyout nil)
149 (when (and (slot-boundp value 'binding) 167 (hashfcn (lambda (key value)
150 (oref value binding) 168 (when (and (slot-boundp value 'binding)
151 (= (aref (oref value binding) 0) binding)) 169 (oref value binding)
152 (setq keyout key)))) 170 (= (aref (oref value binding) 0) binding))
153 (contextstr (cond ((listp context) 171 (setq keyout key))))
154 (car-safe context)) 172 (contextstr (cond ((listp context)
155 ((stringp context) 173 (car-safe context))
156 context) 174 ((stringp context)
157 (t nil))) 175 context)
158 ) 176 (t nil)))
159 (if context 177 )
160 (let ((ctxth (gethash contextstr (oref tab contexthash)))) 178 (if context
161 (when ctxth 179 (let ((ctxth (gethash contextstr (oref tab contexthash))))
162 ;; If a context is specified, then look it up there. 180 (when ctxth
163 (maphash hashfcn ctxth) 181 ;; If a context is specified, then look it up there.
164 ;; Context hashes EXCLUDE the context prefix which 182 (maphash hashfcn ctxth)
165 ;; we need to include, so concat it here 183 ;; Context hashes EXCLUDE the context prefix which
166 (when keyout 184 ;; we need to include, so concat it here
167 (setq keyout (concat contextstr ":" keyout))) 185 (when keyout
168 ))) 186 (setq keyout (concat contextstr ":" keyout)))
169 (when (not keyout) 187 )))
170 ;; No context, or binding in context. Try full hash. 188 (when (not keyout)
171 (maphash hashfcn (oref tab namehash))) 189 ;; No context, or binding in context. Try full hash.
172 keyout)) 190 (maphash hashfcn (oref tab namehash)))
191 keyout)))
173 192
174(defmethod srecode-template-get-table-for-binding 193(defmethod srecode-template-get-table-for-binding
175 ((tab srecode-mode-table) binding &optional context application) 194 ((tab srecode-mode-table) binding &optional context application)
@@ -220,7 +239,8 @@ Optional argument HASH is the hash table to fill in."
220 ) 239 )
221 (while tabs 240 (while tabs
222 ;; Exclude templates for a perticular application. 241 ;; Exclude templates for a perticular application.
223 (when (not (oref (car tabs) :application)) 242 (when (and (not (oref (car tabs) :application))
243 (srecode-template-table-in-project-p (car tabs)))
224 (maphash (lambda (key temp) 244 (maphash (lambda (key temp)
225 (puthash key temp mhash) 245 (puthash key temp mhash)
226 ) 246 )
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 87266bf2475..a90f3a6d67a 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -55,8 +55,9 @@ will be derived."
55 (error "No templates for inserting get/set")) 55 (error "No templates for inserting get/set"))
56 56
57 ;; Step 1: Try to derive the tag for the class we will use 57 ;; Step 1: Try to derive the tag for the class we will use
58 (semantic-fetch-tags)
58 (let* ((class (or class-in (srecode-auto-choose-class (point)))) 59 (let* ((class (or class-in (srecode-auto-choose-class (point))))
59 (tagstart (semantic-tag-start class)) 60 (tagstart (when class (semantic-tag-start class)))
60 (inclass (eq (semantic-current-tag-of-class 'type) class)) 61 (inclass (eq (semantic-current-tag-of-class 'type) class))
61 (field nil) 62 (field nil)
62 ) 63 )
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 4ee6d467009..843b577e1eb 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -26,6 +26,9 @@
26;; Manage the insertion process for a template. 26;; Manage the insertion process for a template.
27;; 27;;
28 28
29(eval-when-compile
30 (require 'cl)) ;; for `lexical-let'
31
29(require 'srecode/compile) 32(require 'srecode/compile)
30(require 'srecode/find) 33(require 'srecode/find)
31(require 'srecode/dictionary) 34(require 'srecode/dictionary)
@@ -49,7 +52,7 @@ Possible values are:
49NOTE: The field feature does not yet work with XEmacs." 52NOTE: The field feature does not yet work with XEmacs."
50 :group 'srecode 53 :group 'srecode
51 :type '(choice (const :tag "Ask" ask) 54 :type '(choice (const :tag "Ask" ask)
52 (cons :tag "Field" field))) 55 (const :tag "Field" field)))
53 56
54(defvar srecode-insert-with-fields-in-progress nil 57(defvar srecode-insert-with-fields-in-progress nil
55 "Non-nil means that we are actively inserting a template with fields.") 58 "Non-nil means that we are actively inserting a template with fields.")
@@ -86,7 +89,6 @@ DICT-ENTRIES are additional dictionary values to add."
86 (car dict-entries) 89 (car dict-entries)
87 (car (cdr dict-entries))) 90 (car (cdr dict-entries)))
88 (setq dict-entries (cdr (cdr dict-entries)))) 91 (setq dict-entries (cdr (cdr dict-entries))))
89 ;;(srecode-resolve-arguments temp newdict)
90 (srecode-insert-fcn temp newdict) 92 (srecode-insert-fcn temp newdict)
91 ;; Don't put code here. We need to return the end-mark 93 ;; Don't put code here. We need to return the end-mark
92 ;; for this insertion step. 94 ;; for this insertion step.
@@ -100,6 +102,10 @@ has set everything up already."
100 ;; Perform the insertion. 102 ;; Perform the insertion.
101 (let ((standard-output (or stream (current-buffer))) 103 (let ((standard-output (or stream (current-buffer)))
102 (end-mark nil)) 104 (end-mark nil))
105 ;; Merge any template entries into the input dictionary.
106 (when (slot-boundp template 'dictionary)
107 (srecode-dictionary-merge dictionary (oref template dictionary)))
108
103 (unless skipresolver 109 (unless skipresolver
104 ;; Make sure the semantic tags are up to date. 110 ;; Make sure the semantic tags are up to date.
105 (semantic-fetch-tags) 111 (semantic-fetch-tags)
@@ -110,7 +116,7 @@ has set everything up already."
110 ;; If there is a buffer, turn off various hooks. This will cause 116 ;; If there is a buffer, turn off various hooks. This will cause
111 ;; the mod hooks to be buffered up during the insert, but 117 ;; the mod hooks to be buffered up during the insert, but
112 ;; prevent tools like font-lock from fontifying mid-template. 118 ;; prevent tools like font-lock from fontifying mid-template.
113 ;; Especialy important during insertion of complex comments that 119 ;; Especially important during insertion of complex comments that
114 ;; cause the new font-lock to comment-color stuff after the inserted 120 ;; cause the new font-lock to comment-color stuff after the inserted
115 ;; comment. 121 ;; comment.
116 ;; 122 ;;
@@ -239,6 +245,9 @@ ST can be a class, or an object."
239(defmethod srecode-insert-method ((st srecode-template) dictionary) 245(defmethod srecode-insert-method ((st srecode-template) dictionary)
240 "Insert the srecoder template ST." 246 "Insert the srecoder template ST."
241 ;; Merge any template entries into the input dictionary. 247 ;; Merge any template entries into the input dictionary.
248 ;; This may happen twice since some templates arguments need
249 ;; these dictionary values earlier, but these values always
250 ;; need merging for template inserting in other templates.
242 (when (slot-boundp st 'dictionary) 251 (when (slot-boundp st 'dictionary)
243 (srecode-dictionary-merge dictionary (oref st dictionary))) 252 (srecode-dictionary-merge dictionary (oref st dictionary)))
244 ;; Do an insertion. 253 ;; Do an insertion.
@@ -264,7 +273,7 @@ Use DICTIONARY to resolve any macros."
264;; Specific srecode inserters. 273;; Specific srecode inserters.
265;; The base class is from srecode-compile. 274;; The base class is from srecode-compile.
266;; 275;;
267;; Each inserter handles various macro codes from the temlate. 276;; Each inserter handles various macro codes from the template.
268;; The `code' slot specifies a character used to identify which 277;; The `code' slot specifies a character used to identify which
269;; inserter is to be created. 278;; inserter is to be created.
270;; 279;;
@@ -471,7 +480,7 @@ If SECONDNAME is nil, return VALUE."
471 ;; (setq val (format "%S" val)))) 480 ;; (setq val (format "%S" val))))
472 )) 481 ))
473 ;; Output the dumb thing unless the type of thing specifically 482 ;; Output the dumb thing unless the type of thing specifically
474 ;; did the inserting forus. 483 ;; did the inserting for us.
475 (when do-princ 484 (when do-princ
476 (princ val)))) 485 (princ val))))
477 486
@@ -498,7 +507,8 @@ If there is no entry, prompt the user for the value to use.
498The prompt text used is derived from the previous PROMPT command in the 507The prompt text used is derived from the previous PROMPT command in the
499template file.") 508template file.")
500 509
501(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter-ask) STATE) 510(defmethod srecode-inserter-apply-state
511 ((ins srecode-template-inserter-ask) STATE)
502 "For the template inserter INS, apply information from STATE. 512 "For the template inserter INS, apply information from STATE.
503Loop over the prompts to see if we have a match." 513Loop over the prompts to see if we have a match."
504 (let ((prompts (oref STATE prompts)) 514 (let ((prompts (oref STATE prompts))
@@ -669,7 +679,13 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
669 ) 679 )
670 680
671(defvar srecode-template-inserter-point-override nil 681(defvar srecode-template-inserter-point-override nil
672 "When non-nil, the point inserter will do this function instead.") 682 "Point-positioning method for the SRecode template inserter.
683When nil, perform normal point-positioning behavior.
684When the value is a cons cell (DEPTH . FUNCTION), call FUNCTION
685instead, unless the template nesting depth, measured
686by (length (oref srecode-template active)), is greater than
687DEPTH.")
688
673 689
674(defclass srecode-template-inserter-point (srecode-template-inserter) 690(defclass srecode-template-inserter-point (srecode-template-inserter)
675 ((key :initform ?^ 691 ((key :initform ?^
@@ -702,15 +718,20 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
702 dictionary) 718 dictionary)
703 "Insert the STI inserter. 719 "Insert the STI inserter.
704Save point in the class allocated 'point' slot. 720Save point in the class allocated 'point' slot.
705If `srecode-template-inserter-point-override' then this generalized 721If `srecode-template-inserter-point-override' non-nil then this
706marker will do something else. See `srecode-template-inserter-include-wrap' 722generalized marker will do something else. See
707as an example." 723`srecode-template-inserter-include-wrap' as an example."
708 (if srecode-template-inserter-point-override 724 ;; If `srecode-template-inserter-point-override' is non-nil, its car
725 ;; is the maximum template nesting depth for which the override is
726 ;; valid. Compare this to the actual template nesting depth and
727 ;; maybe use the override function which is stored in the cdr.
728 (if (and srecode-template-inserter-point-override
729 (<= (length (oref srecode-template active))
730 (car srecode-template-inserter-point-override)))
709 ;; Disable the old override while we do this. 731 ;; Disable the old override while we do this.
710 (let ((over srecode-template-inserter-point-override) 732 (let ((over (cdr srecode-template-inserter-point-override))
711 (srecode-template-inserter-point-override nil)) 733 (srecode-template-inserter-point-override nil))
712 (funcall over dictionary) 734 (funcall over dictionary))
713 )
714 (oset sti point (point-marker)) 735 (oset sti point (point-marker))
715 )) 736 ))
716 737
@@ -751,9 +772,15 @@ Loops over the embedded CODE which was saved here during compilation.
751The template to insert is stored in SLOT." 772The template to insert is stored in SLOT."
752 (let ((dicts (srecode-dictionary-lookup-name 773 (let ((dicts (srecode-dictionary-lookup-name
753 dictionary (oref sti :object-name)))) 774 dictionary (oref sti :object-name))))
775 (when (not (listp dicts))
776 (error "Cannot insert section %S from non-section variable."
777 (oref sti :object-name)))
754 ;; If there is no section dictionary, then don't output anything 778 ;; If there is no section dictionary, then don't output anything
755 ;; from this section. 779 ;; from this section.
756 (while dicts 780 (while dicts
781 (when (not (srecode-dictionary-p (car dicts)))
782 (error "Cannot insert section %S from non-section variable."
783 (oref sti :object-name)))
757 (srecode-insert-subtemplate sti (car dicts) slot) 784 (srecode-insert-subtemplate sti (car dicts) slot)
758 (setq dicts (cdr dicts))))) 785 (setq dicts (cdr dicts)))))
759 786
@@ -853,39 +880,44 @@ this template instance."
853 ;; If there was no template name, throw an error 880 ;; If there was no template name, throw an error
854 (if (not templatenamepart) 881 (if (not templatenamepart)
855 (error "Include macro %s needs a template name" (oref sti :object-name))) 882 (error "Include macro %s needs a template name" (oref sti :object-name)))
856 ;; Find the template by name, and save it. 883
857 (if (or (not (slot-boundp sti 'includedtemplate)) 884 ;; NOTE: We used to cache the template and not look it up a second time,
858 (not (oref sti includedtemplate))) 885 ;; but changes in the template tables can change which template is
859 (let ((tmpl (srecode-template-get-table (srecode-table) 886 ;; eventually discovered, so now we always lookup that template.
860 templatenamepart)) 887
861 (active (oref srecode-template active)) 888 ;; Calculate and store the discovered template
862 ctxt) 889 (let ((tmpl (srecode-template-get-table (srecode-table)
890 templatenamepart))
891 (active (oref srecode-template active))
892 ctxt)
893 (when (not tmpl)
894 ;; If it isn't just available, scan back through
895 ;; the active template stack, searching for a matching
896 ;; context.
897 (while (and (not tmpl) active)
898 (setq ctxt (oref (car active) context))
899 (setq tmpl (srecode-template-get-table (srecode-table)
900 templatenamepart
901 ctxt))
863 (when (not tmpl) 902 (when (not tmpl)
864 ;; If it isn't just available, scan back through 903 (when (slot-boundp (car active) 'table)
865 ;; the active template stack, searching for a matching 904 (let ((app (oref (oref (car active) table) application)))
866 ;; context. 905 (when app
867 (while (and (not tmpl) active) 906 (setq tmpl (srecode-template-get-table
868 (setq ctxt (oref (car active) context)) 907 (srecode-table)
869 (setq tmpl (srecode-template-get-table (srecode-table) 908 templatenamepart
870 templatenamepart 909 ctxt app)))
871 ctxt)) 910 )))
872 (when (not tmpl) 911 (setq active (cdr active)))
873 (when (slot-boundp (car active) 'table) 912 (when (not tmpl)
874 (let ((app (oref (oref (car active) table) application))) 913 ;; If it wasn't in this context, look to see if it
875 (when app 914 ;; defines it's own context
876 (setq tmpl (srecode-template-get-table 915 (setq tmpl (srecode-template-get-table (srecode-table)
877 (srecode-table) 916 templatenamepart)))
878 templatenamepart 917 )
879 ctxt app))) 918
880 ))) 919 ;; Store the found template into this object for later use.
881 (setq active (cdr active))) 920 (oset sti :includedtemplate tmpl))
882 (when (not tmpl)
883 ;; If it wasn't in this context, look to see if it
884 ;; defines its own context
885 (setq tmpl (srecode-template-get-table (srecode-table)
886 templatenamepart)))
887 )
888 (oset sti :includedtemplate tmpl)))
889 921
890 (if (not (oref sti includedtemplate)) 922 (if (not (oref sti includedtemplate))
891 ;; @todo - Call into a debugger to help find the template in question. 923 ;; @todo - Call into a debugger to help find the template in question.
@@ -955,23 +987,31 @@ insert the section it wraps into the location in the included
955template where a ^ inserter occurs." 987template where a ^ inserter occurs."
956 ;; Step 1: Look up the included inserter 988 ;; Step 1: Look up the included inserter
957 (srecode-insert-include-lookup sti dictionary) 989 (srecode-insert-include-lookup sti dictionary)
958 ;; Step 2: Temporarilly override the point inserter. 990 ;; Step 2: Temporarily override the point inserter.
959 (let* ((vaguely-unique-name sti) 991 ;; We bind `srecode-template-inserter-point-override' to a cons cell
960 (srecode-template-inserter-point-override 992 ;; (DEPTH . FUNCTION) that has the maximum template nesting depth,
961 (lambda (dict2) 993 ;; for which the override is valid, in DEPTH and a lambda function
962 (if (srecode-dictionary-lookup-name 994 ;; which implements the wrap insertion behavior in FUNCTION. The
963 dict2 (oref vaguely-unique-name :object-name)) 995 ;; maximum valid nesting depth is just the current depth + 1.
964 ;; Insert our sectional part with looping. 996 (let ((srecode-template-inserter-point-override
965 (srecode-insert-method-helper 997 (lexical-let ((inserter1 sti))
966 vaguely-unique-name dict2 'template) 998 (cons
967 ;; Insert our sectional part just once. 999 ;; DEPTH
968 (srecode-insert-subtemplate vaguely-unique-name 1000 (+ (length (oref srecode-template active)) 1)
969 dict2 'template)) 1001 ;; FUNCTION
970 ))) 1002 (lambda (dict)
1003 (let ((srecode-template-inserter-point-override nil))
1004 (if (srecode-dictionary-lookup-name
1005 dict (oref inserter1 :object-name))
1006 ;; Insert our sectional part with looping.
1007 (srecode-insert-method-helper
1008 inserter1 dict 'template)
1009 ;; Insert our sectional part just once.
1010 (srecode-insert-subtemplate
1011 inserter1 dict 'template))))))))
971 ;; Do a regular insertion for an include, but with our override in 1012 ;; Do a regular insertion for an include, but with our override in
972 ;; place. 1013 ;; place.
973 (call-next-method) 1014 (call-next-method)))
974 ))
975 1015
976(provide 'srecode/insert) 1016(provide 'srecode/insert)
977 1017
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index af96037944b..3a833ca8bb3 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -295,8 +295,14 @@ if that file is NEW, otherwise assume the mode has not changed."
295 295
296 ;; 2) Do we not have a current map? If so load. 296 ;; 2) Do we not have a current map? If so load.
297 (when (not srecode-current-map) 297 (when (not srecode-current-map)
298 (setq srecode-current-map 298 (condition-case nil
299 (eieio-persistent-read srecode-map-save-file)) 299 (setq srecode-current-map
300 (eieio-persistent-read srecode-map-save-file))
301 (error
302 ;; There was an error loading the old map. Create a new one.
303 (setq srecode-current-map
304 (srecode-map "SRecode Map"
305 :file srecode-map-save-file))))
300 ) 306 )
301 307
302 ) 308 )
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index f588eed2bb1..3f286c96117 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -125,7 +125,13 @@
125 ["Dump Dictionary" 125 ["Dump Dictionary"
126 srecode-dictionary-dump 126 srecode-dictionary-dump
127 :active t 127 :active t
128 :help "Calculate a dump a dictionary for point." 128 :help "Calculate and dump a dictionary for point."
129 ])
130 (semantic-menu-item
131 ["Show Macro Help"
132 srecode-macro-help
133 :active t
134 :help "Display the different types of macros available."
129 ]) 135 ])
130 ) 136 )
131 ) 137 )
@@ -223,43 +229,44 @@ MENU-DEF is the menu to bind this into."
223 (setq context (car-safe (srecode-calculate-context))) 229 (setq context (car-safe (srecode-calculate-context)))
224 230
225 (while subtab 231 (while subtab
226 (setq ltab (oref (car subtab) templates)) 232 (when (srecode-template-table-in-project-p (car subtab))
227 (while ltab 233 (setq ltab (oref (car subtab) templates))
228 (setq temp (car ltab)) 234 (while ltab
229 235 (setq temp (car ltab))
230 ;; Do something with this template. 236
231 237 ;; Do something with this template.
232 (let* ((ctxt (oref temp context)) 238
233 (ctxtcons (assoc ctxt alltabs)) 239 (let* ((ctxt (oref temp context))
234 (bind (if (slot-boundp temp 'binding) 240 (ctxtcons (assoc ctxt alltabs))
235 (oref temp binding))) 241 (bind (if (slot-boundp temp 'binding)
236 (name (object-name-string temp))) 242 (oref temp binding)))
237 243 (name (object-name-string temp)))
238 (when (not ctxtcons) 244
239 (if (string= context ctxt) 245 (when (not ctxtcons)
240 ;; If this context is not in the current list of contexts 246 (if (string= context ctxt)
241 ;; is equal to the current context, then manage the 247 ;; If this context is not in the current list of contexts
242 ;; active list instead 248 ;; is equal to the current context, then manage the
243 (setq active 249 ;; active list instead
244 (setq ctxtcons (or active (cons ctxt nil)))) 250 (setq active
245 ;; This is not an active context, add it to alltabs. 251 (setq ctxtcons (or active (cons ctxt nil))))
246 (setq ctxtcons (cons ctxt nil)) 252 ;; This is not an active context, add it to alltabs.
247 (setq alltabs (cons ctxtcons alltabs)))) 253 (setq ctxtcons (cons ctxt nil))
248 254 (setq alltabs (cons ctxtcons alltabs))))
249 (let ((new (vector 255
250 (if bind 256 (let ((new (vector
251 (concat name " (" bind ")") 257 (if bind
252 name) 258 (concat name " (" bind ")")
253 `(lambda () (interactive) 259 name)
254 (srecode-insert (concat ,ctxt ":" ,name))) 260 `(lambda () (interactive)
255 t))) 261 (srecode-insert (concat ,ctxt ":" ,name)))
256 262 t)))
257 (setcdr ctxtcons (cons 263
258 new 264 (setcdr ctxtcons (cons
259 (cdr ctxtcons))))) 265 new
260 266 (cdr ctxtcons)))))
261 (setq ltab (cdr ltab))) 267
262 (setq subtab (cdr subtab))) 268 (setq ltab (cdr ltab))))
269 (setq subtab (cdr subtab)))
263 270
264 ;; Now create the menu 271 ;; Now create the menu
265 (easy-menu-filter-return 272 (easy-menu-filter-return
@@ -300,6 +307,7 @@ MENU-DEF is the menu to bind this into."
300This command will insert whichever srecode template has a binding 307This command will insert whichever srecode template has a binding
301to the current key." 308to the current key."
302 (interactive) 309 (interactive)
310 (srecode-load-tables-for-mode major-mode)
303 (let* ((k last-command-event) 311 (let* ((k last-command-event)
304 (ctxt (srecode-calculate-context)) 312 (ctxt (srecode-calculate-context))
305 ;; Find the template with the binding K 313 ;; Find the template with the binding K
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index ae96b86a9bc..fd8419add67 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -91,7 +91,7 @@ The hook is called with two arguments, the TAG and DICT
91to be augmented.") 91to be augmented.")
92 92
93(define-overload srecode-semantic-apply-tag-to-dict (tagobj dict) 93(define-overload srecode-semantic-apply-tag-to-dict (tagobj dict)
94 "Insert fewatures of TAGOBJ into the dictionary DICT. 94 "Insert features of TAGOBJ into the dictionary DICT.
95TAGOBJ is an object of class `srecode-semantic-tag'. This class 95TAGOBJ is an object of class `srecode-semantic-tag'. This class
96is a compound inserter value. 96is a compound inserter value.
97DICT is a dictionary object. 97DICT is a dictionary object.
@@ -195,7 +195,7 @@ variable default values, and other things."
195;;; :tag ARGUMENT HANDLING 195;;; :tag ARGUMENT HANDLING
196;; 196;;
197;; When a :tag argument is required, identify the current :tag, 197;; When a :tag argument is required, identify the current :tag,
198;; and apply it's parts into the dictionary. 198;; and apply its parts into the dictionary.
199(defun srecode-semantic-handle-:tag (dict) 199(defun srecode-semantic-handle-:tag (dict)
200 "Add macros into the dictionary DICT based on the current :tag." 200 "Add macros into the dictionary DICT based on the current :tag."
201 ;; We have a tag, start adding "stuff" into the dictionary. 201 ;; We have a tag, start adding "stuff" into the dictionary.
@@ -305,8 +305,8 @@ or `code'.
305 305
306For various conditions, this function looks for a template with 306For various conditions, this function looks for a template with
307the name CLASS-tag, where CLASS is the tag class. If it cannot 307the name CLASS-tag, where CLASS is the tag class. If it cannot
308find that, it will look for that template in the 308find that, it will look for that template in the `declaration'
309`declaration'context (if the current context was not `declaration'). 309context (if the current context was not `declaration').
310 310
311If PROTOTYPE is specified, it will first look for templates with 311If PROTOTYPE is specified, it will first look for templates with
312the name CLASS-tag-prototype, or CLASS-prototype as above. 312the name CLASS-tag-prototype, or CLASS-prototype as above.
@@ -382,7 +382,7 @@ as `function' will leave point where code might be inserted."
382 (error "Cannot find template %s in %s for inserting tag %S" 382 (error "Cannot find template %s in %s for inserting tag %S"
383 errtype top (semantic-format-tag-summarize tag))) 383 errtype top (semantic-format-tag-summarize tag)))
384 384
385 ;; Resolve Arguments 385 ;; Resolve arguments
386 (let ((srecode-semantic-selected-tag tag)) 386 (let ((srecode-semantic-selected-tag tag))
387 (srecode-resolve-arguments temp dict)) 387 (srecode-resolve-arguments temp dict))
388 388
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 3d22922d551..2c95d4f6412 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -31,6 +31,7 @@
31(require 'srecode) 31(require 'srecode)
32 32
33(declare-function srecode-load-tables-for-mode "srecode/find") 33(declare-function srecode-load-tables-for-mode "srecode/find")
34(declare-function srecode-template-table-in-project-p "srecode/find")
34 35
35;;; Code: 36;;; Code:
36 37
@@ -74,6 +75,12 @@ Emacs Lisp code to fill in the dictionary.")
74When there are multiple template files with similar names, templates with 75When there are multiple template files with similar names, templates with
75the highest priority are scanned last, allowing them to override values in 76the highest priority are scanned last, allowing them to override values in
76previous template files.") 77previous template files.")
78 (project :initarg :project
79 :type (or null string)
80 :documentation
81 "Scope some project files to a specific project.
82The value is a directory which forms the root of a particular project,
83or a subset of a particular project.")
77 ;; 84 ;;
78 ;; Parsed Data from the template file 85 ;; Parsed Data from the template file
79 ;; 86 ;;
@@ -224,6 +231,12 @@ Use PREDICATE is the same as for the `sort' function."
224 (when (oref tab :application) 231 (when (oref tab :application)
225 (princ "\nApplication: ") 232 (princ "\nApplication: ")
226 (princ (oref tab :application))) 233 (princ (oref tab :application)))
234 (when (oref tab :project)
235 (require 'srecode/find) ; For srecode-template-table-in-project-p
236 (princ "\nProject Directory: ")
237 (princ (oref tab :project))
238 (when (not (srecode-template-table-in-project-p tab))
239 (princ "\n ** Not Usable in this file. **")))
227 (princ "\n\nVariables:\n") 240 (princ "\n\nVariables:\n")
228 (let ((vars (oref tab variables))) 241 (let ((vars (oref tab variables)))
229 (while vars 242 (while vars
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 2c8d1a7204c..30ba91cadf9 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -175,10 +175,17 @@ Adds the following:
175 175
176(define-mode-local-override semantic-insert-foreign-tag 176(define-mode-local-override semantic-insert-foreign-tag
177 texinfo-mode (foreign-tag) 177 texinfo-mode (foreign-tag)
178 "Insert TAG from a foreign buffer in TAGFILE. 178 "Insert FOREIGN-TAG from a foreign buffer in TAGFILE.
179Assume TAGFILE is a source buffer, and create a documentation 179Assume TAGFILE is a source buffer, and create a documentation
180thingy from it using the `document' tool." 180thingy from it using the `document' tool."
181 (let ((srecode-semantic-selected-tag foreign-tag)) 181 (srecode-texi-insert-tag-as-doc foreign-tag))
182
183(defun srecode-texi-insert-tag-as-doc (tag)
184 "Insert TAG into the current buffer with SRecode."
185 (when (not (eq major-mode 'texinfo-mode))
186 (error "Can only insert tags into texinfo in texinfo mode"))
187 (let ((srecode-semantic-selected-tag tag))
188 (srecode-load-tables-for-mode major-mode)
182 ;; @todo - choose of the many types of tags to insert, 189 ;; @todo - choose of the many types of tags to insert,
183 ;; or put all that logic into srecode. 190 ;; or put all that logic into srecode.
184 (srecode-insert "declaration:function"))) 191 (srecode-insert "declaration:function")))