summaryrefslogtreecommitdiff
path: root/lisp/cedet/srecode/dictionary.el
blob: e04aad33065d64fbd07ba7e1dce427b5bb5bd2bf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
;;; srecode-dictionary.el --- Dictionary code for the semantic recoder.

;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <eric@siege-engine.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Dictionaries contain lists of names and their associated values.
;; These dictionaries are used to fill in macros from recoder templates.

;;; Code:

;;; CLASSES

(eval-when-compile (require 'cl))
(require 'eieio)
(require 'srecode)
(require 'srecode/table)
(eval-when-compile (require 'semantic))

(declare-function srecode-compile-parse-inserter "srecode/compile")
(declare-function srecode-dump-code-list "srecode/compile")
(declare-function srecode-load-tables-for-mode "srecode/find")
(declare-function srecode-template-table-in-project-p "srecode/find")
(declare-function srecode-insert-code-stream "srecode/insert")
(declare-function data-debug-new-buffer "data-debug")
(declare-function data-debug-insert-object-slots "eieio-datadebug")
(declare-function srecode-field "srecode/fields")

(defclass srecode-dictionary ()
  ((namehash :initarg :namehash
	     :documentation
	     "Hash table containing the names of all the templates.")
   (buffer :initarg :buffer
	   :documentation
	   "The buffer this dictionary was initialized with.")
   (parent :initarg :parent
	   :type (or null srecode-dictionary)
	   :documentation
	   "The parent dictionary.
Symbols not appearing in this dictionary will be checked against the
parent dictionary.")
   (origin :initarg :origin
	   :type string
	   :documentation
	   "A string representing the origin of this dictionary.
Useful only while debugging.")
   )
  "Dictionary of symbols and what they mean.
Dictionaries are used to look up named symbols from
templates to decide what to do with those symbols.")

(defclass srecode-dictionary-compound-value ()
  ()
  "A compound dictionary value.
Values stored in a dictionary must be a STRING,
a dictionary for showing sections, or an instance of a subclass
of this class.

Compound dictionary values derive from this class, and must
provide a sequence of method implementations to convert into
a string."
  :abstract t)

(defclass srecode-dictionary-compound-variable
  (srecode-dictionary-compound-value)
  ((value :initarg :value
	  :documentation
	  "The value of this template variable.
Variables in template files are usually a single string
which can be inserted into a dictionary directly.

Some variables may be more complex and involve dictionary
lookups, strings, concatenation, or the like.

The format of VALUE is determined by current template
formatting rules.")
   (compiled :initarg :compiled
	     :type list
	     :documentation
	     "The compiled version of VALUE.")
   )
  "A compound dictionary value for template file variables.
You can declare a variable in a template like this:

set NAME \"str\" macro \"OTHERNAME\"

with appending various parts together in a list.")

(defmethod initialize-instance ((this srecode-dictionary-compound-variable)
				&optional fields)
  "Initialize the compound variable THIS.
Makes sure that :value is compiled."
  (let ((newfields nil)
	(state nil))
    (while fields
      ;; Strip out :state
      (if (eq (car fields) :state)
	  (setq state (car (cdr fields)))
	(setq newfields (cons (car (cdr fields))
			      (cons (car fields) newfields))))
      (setq fields (cdr (cdr fields))))

    (when (not state)
      (error "Cannot create compound variable without :state"))

    (call-next-method this (nreverse newfields))
    (when (not (slot-boundp this 'compiled))
      (let ((val (oref this :value))
	    (comp nil))
	(while val
	  (let ((nval (car val))
		)
	    (cond ((stringp nval)
		   (setq comp (cons nval comp)))
		  ((and (listp nval)
			(equal (car nval) 'macro))
		   (require 'srecode/compile)
		   (setq comp (cons
			       (srecode-compile-parse-inserter
				(cdr nval)
				state)
			       comp)))
		  (t
		   (error "Don't know how to handle variable value %S" nval)))
	    )
	  (setq val (cdr val)))
	(oset this :compiled (nreverse comp))))))

;;; DICTIONARY METHODS
;;

(defun srecode-create-dictionary (&optional buffer-or-parent)
  "Create a dictionary for BUFFER.
If BUFFER-OR-PARENT is not specified, assume a buffer, and
use the current buffer.
If BUFFER-OR-PARENT is another dictionary, then remember the
parent within the new dictionary, and assume that BUFFER
is the same as belongs to the parent dictionary.
The dictionary is initialized with variables setup for that
buffer's table.
If BUFFER-OR-PARENT is t, then this dictionary should not be
associated with a buffer or parent."
  (save-excursion
    ;; Handle the parent
    (let ((parent nil)
	  (buffer nil)
	  (origin nil)
	  (initfrombuff nil))
      (cond
       ;; Parent is a buffer
       ((bufferp buffer-or-parent)
	(set-buffer buffer-or-parent)
	(setq buffer buffer-or-parent
	      origin (buffer-name buffer-or-parent)
	      initfrombuff t))

       ;; Parent is another dictionary
       ((srecode-dictionary-child-p buffer-or-parent)
	(setq parent buffer-or-parent
	      buffer (oref buffer-or-parent buffer)
	      origin (concat (object-name buffer-or-parent) " in "
			     (if buffer (buffer-name buffer)
			       "no buffer")))
	(when buffer
	  (set-buffer buffer)))

       ;; No parent
       ((eq buffer-or-parent t)
	(setq buffer nil
	      origin "Unspecified Origin"))

       ;; Default to unspecified parent
       (t
	(setq buffer (current-buffer)
	      origin (concat "Unspecified.  Assume "
			     (buffer-name buffer))
	      initfrombuff t)))

      ;; Create the new dictionary object.
      (let ((dict (srecode-dictionary
		   major-mode
		   :buffer   buffer
		   :parent   parent
		   :namehash (make-hash-table :test 'equal
					      :size 20)
		   :origin   origin)))
	;; Only set up the default variables if we are being built
	;; directroy for a particular buffer.
	(when initfrombuff
	  ;; Variables from the table we are inserting from.
	  ;; @todo - get a better tree of tables.
	  (let ((mt (srecode-get-mode-table major-mode))
		(def (srecode-get-mode-table 'default)))
	    ;; Each table has multiple template tables.
	    ;; Do DEF first so that MT can override any values.
	    (srecode-dictionary-add-template-table dict def)
	    (srecode-dictionary-add-template-table dict mt)
	    ))
	dict))))

(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
						  tpl)
  "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)))
      (require 'srecode/find) ; For srecode-template-table-in-project-p
      (while tabs
	(when (srecode-template-table-in-project-p (car tabs))
	  (let ((vars (oref (car tabs) variables)))
	    (while vars
	      (srecode-dictionary-set-value
	       dict (car (car vars)) (cdr (car vars)))
	      (setq vars (cdr vars)))))
  	(setq tabs (cdr tabs))))))


(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
					 name value)
  "In dictionary DICT, set NAME to have VALUE."
  ;; Validate inputs
  (unless (stringp name)
    (signal 'wrong-type-argument (list name 'stringp)))

  ;; Add the value.
  (with-slots (namehash) dict
    (puthash name value namehash))
  )

(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
						      name &optional show-only force)
  "In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.

You can add several dictionaries to the same section entry.
For each dictionary added to a variable, the block of codes in
the template will be repeated.

If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary
if there is already one in place.  Also, don't add FIRST/LAST entries.
These entries are not needed when we are just showing a section.

Each dictionary added will automatically get values for positional macros
which will enable SECTIONS to be enabled.

 * FIRST - The first entry in the table.
 * NOTFIRST - Not the first entry in the table.
 * LAST - The last entry in the table
 * NOTLAST - Not the last entry in the table.

Adding a new dictionary will alter these values in previously
inserted dictionaries."
  ;; Validate inputs
  (unless (stringp name)
    (signal 'wrong-type-argument (list name 'stringp)))

  (let ((new (srecode-create-dictionary dict))
	(ov  (srecode-dictionary-lookup-name dict name t)))

    (when (not show-only)
      ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries.
      (if (null ov)
	  (progn
	    (srecode-dictionary-show-section new "FIRST")
	    (srecode-dictionary-show-section new "LAST"))
	;; Not the very first one.  Lets clean up CAR.
	(let ((tail (car (last ov))))
	  (srecode-dictionary-hide-section tail "LAST")
	  (srecode-dictionary-show-section tail "NOTLAST")
	  )
	(srecode-dictionary-show-section new "NOTFIRST")
	(srecode-dictionary-show-section new "LAST"))
      )

    (when (or force
	      (not show-only)
	      (null ov))
      (srecode-dictionary-set-value dict name (append ov (list new))))
    ;; Return the new sub-dictionary.
    new))

(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
  "In dictionary DICT, indicate that the section NAME should be exposed."
  ;; Validate inputs
  (unless (stringp name)
    (signal 'wrong-type-argument (list name 'stringp)))

  ;; Showing a section is just like making a section dictionary, but
  ;; with no dictionary values to add.
  (srecode-dictionary-add-section-dictionary dict name t)
  nil)

(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
  "In dictionary DICT, indicate that the section NAME should be hidden."
  ;; We need to find the has value, and then delete it.
  ;; Validate inputs
  (unless (stringp name)
    (signal 'wrong-type-argument (list name 'stringp)))

  ;; Add the value.
  (with-slots (namehash) dict
    (remhash name namehash))
  nil)

(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
					   entries &optional state)
  "Add ENTRIES to DICT.

ENTRIES is a list of even length of dictionary entries to
add. ENTRIES looks like this:

  (NAME_1 VALUE_1 NAME_2 VALUE_2 ...)

The following rules apply:
 * NAME_N is a string
and for values
 * If VALUE_N is t, the section NAME_N is shown.
 * If VALUE_N is a string, an ordinary value is inserted.
 * If VALUE_N is a dictionary, it is inserted as entry NAME_N.
 * Otherwise, a compound variable is created for VALUE_N.

The optional argument STATE has to non-nil when compound values
are inserted. An error is signaled if ENTRIES contains compound
values but STATE is nil."
  (while entries
    (let ((name  (nth 0 entries))
	  (value (nth 1 entries)))
      (cond
       ;; Value is t; show a section.
       ((eq value t)
	(srecode-dictionary-show-section dict name))

       ;; Value is a simple string; create an ordinary dictionary
       ;; entry
       ((stringp value)
	(srecode-dictionary-set-value dict name value))

       ;; Value is a dictionary; insert as child dictionary.
       ((srecode-dictionary-child-p value)
	(srecode-dictionary-merge
	 (srecode-dictionary-add-section-dictionary dict name)
	 value t))

       ;; Value is some other object; create a compound value.
       (t
	(unless state
	  (error "Cannot insert compound values without state."))

	(srecode-dictionary-set-value
	 dict name
	 (srecode-dictionary-compound-variable
	  name :value value :state state)))))
    (setq entries (nthcdr 2 entries)))
  dict)

(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
				     &optional force)
  "Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are
not modified, even if there are values of the same names in
OTHERDICT."
  (when otherdict
    (maphash
     (lambda (key entry)
       ;; The new values is only merged in if there was no old value
       ;; or FORCE is non-nil.
       ;;
       ;; This protects applications from being whacked, and basically
       ;; makes these new section dictionary entries act like
       ;; "defaults" instead of overrides.
       (when (or force
		 (not (srecode-dictionary-lookup-name dict key t)))
	 (cond
	  ;; A list of section dictionaries. We need to merge them in.
	  ((and (listp entry)
		(srecode-dictionary-p (car entry)))
	   (dolist (sub-dict entry)
	     (srecode-dictionary-merge
	      (srecode-dictionary-add-section-dictionary
	       dict key t t)
	      sub-dict force)))

	  ;; Other values can be set directly.
	  (t
	   (srecode-dictionary-set-value dict key entry)))))
     (oref otherdict namehash))))

(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
					   name &optional non-recursive)
  "Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the
name of an entry in the dictionary. If such an entry exists, its
value is returned. Otherwise, nil is returned. Normally, the
lookup is recursive in the sense that the parent of DICT is
searched for NAME if it is not found in DICT.  This recursive
lookup can be disabled by the optional argument NON-RECURSIVE.

This function derives values for some special NAMEs, such as
'FIRST' and 'LAST'."
  (if (not (slot-boundp dict 'namehash))
      nil
    ;; Get the value of this name from the dictionary or its parent
    ;; unless the lookup should be non-recursive.
    (with-slots (namehash parent) dict
      (or (gethash name namehash)
	  (and (not non-recursive)
	       (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST")))
	       parent
	       (srecode-dictionary-lookup-name parent name)))))
  )

(defmethod srecode-root-dictionary ((dict srecode-dictionary))
  "For dictionary DICT, return the root dictionary.
The root dictionary is usually for a current or active insertion."
  (let ((ans dict))
    (while (oref ans parent)
      (setq ans (oref ans parent)))
    ans))

;;; COMPOUND VALUE METHODS
;;
;; Compound values must provide at least the toStriong method
;; for use in converting the compound value into sometehing insertable.

(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
				      function
				      dictionary)
  "Convert the compound dictionary value CP to a string.
If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect
of the compound value.  The FUNCTION could be a fraction
of some function symbol with a logical prefix excluded.

If you subclass `srecode-dictionary-compound-value' then this
method could return nil, but if it does that, it must insert
the value itself using `princ', or by detecting if the current
standard out is a buffer, and using `insert'."
  (object-name cp))

(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
			 &optional indent)
  "Display information about this compound value."
  (princ (object-name cp))
  )

(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
				      function
				      dictionary)
  "Convert the compound dictionary variable value CP into a string.
FUNCTION and DICTIONARY are as for the baseclass."
  (require 'srecode/insert)
  (srecode-insert-code-stream (oref cp compiled) dictionary))


(defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
			 &optional indent)
  "Display information about this compound value."
  (require 'srecode/compile)
  (princ "# Compound Variable #\n")
  (let ((indent (+ 4 (or indent 0)))
	(cmp (oref cp compiled))
	)
    (srecode-dump-code-list cmp (make-string indent ? ))
    ))

;;; FIELD EDITING COMPOUND VALUE
;;
;; This is an interface to using field-editing objects
;; instead of asking questions.  This provides the basics
;; behind this compound value.

(defclass srecode-field-value (srecode-dictionary-compound-value)
  ((firstinserter :initarg :firstinserter
		  :documentation
		  "The inserter object for the first occurrence of this field.")
   (defaultvalue :initarg :defaultvalue
     :documentation
     "The default value for this inserter.")
   )
  "When inserting values with editable field mode, a dictionary value.
Compound values allow a field to be stored in the dictionary for when
it is referenced a second time.  This compound value can then be
inserted with a new editable field.")

(defmethod srecode-compound-toString((cp srecode-field-value)
				     function
				     dictionary)
  "Convert this field into an insertable string."
  (require 'srecode/fields)
  ;; If we are not in a buffer, then this is not supported.
  (when (not (bufferp standard-output))
    (error "FIELDS invoked while inserting template to non-buffer"))

  (if function
      (error "@todo: Cannot mix field insertion with functions")

    ;; No function.  Perform a plain field insertion.
    ;; We know we are in a buffer, so we can perform the insertion.
    (let* ((dv (oref cp defaultvalue))
	   (sti (oref cp firstinserter))
	   (start (point))
	   (name (oref sti :object-name)))

      (cond
       ;; No default value.
       ((not dv) (insert name))
       ;; A compound value as the default?  Recurse.
       ((srecode-dictionary-compound-value-child-p dv)
	(srecode-compound-toString dv function dictionary))
       ;; A string that is empty?  Use the name.
       ((and (stringp dv) (string= dv ""))
	(insert name))
       ;; Insert strings
       ((stringp dv) (insert dv))
       ;; Some other issue
       (t
	(error "Unknown default value for value %S" name)))

      ;; Create a field from the inserter.
      (srecode-field name :name name
		     :start start
		     :end (point)
		     :prompt (oref sti prompt)
		     :read-fcn (oref sti read-fcn)
		     )
      ))
  ;; Returning nil is a signal that we have done the insertion ourselves.
  nil)


;;; 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.

TAGS should be in the format produced by the template file
grammar. That is

TAGS = (ENTRY_1 ENTRY_2 ...)

where

ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG

where TAG is a semantic tag of class 'variable. The (NAME ... )
form creates a child dictionary which is stored under the name
NAME. The TAG form creates a value entry or section dictionary
entry whose name is the name of the tag.

STATE is the current compiler state."
  (let ((dict    (srecode-create-dictionary t))
	(entries (apply #'append
			(mapcar
			 (lambda (entry)
			   (cond
			    ;; Entry is a tag
			    ((semantic-tag-p entry)
			     (let ((name  (semantic-tag-name entry))
				   (value (semantic-tag-variable-default entry)))
			       (list name
				     (if (and (listp value)
					      (= (length value) 1)
					      (stringp (car value)))
					 (car value)
				       value))))

			    ;; Entry is a nested dictionary
			    (t
			     (let ((name    (car entry))
				   (entries (cdr entry)))
			       (list name
				     (srecode-create-dictionaries-from-tags
				      entries state))))))
			 tags))))
    (srecode-dictionary-add-entries
     dict entries state)
    dict)
  )

;;; DUMP DICTIONARY
;;
;; Make a dictionary, and dump it's contents.

(defun srecode-adebug-dictionary ()
  "Run data-debug on this mode's dictionary."
  (interactive)
  (require 'eieio-datadebug)
  (require 'semantic)
  (require 'srecode/find)
  (let* ((modesym major-mode)
	 (start (current-time))
	 (junk (or (progn (srecode-load-tables-for-mode modesym)
			  (srecode-get-mode-table modesym))
		   (error "No table found for mode %S" modesym)))
	 (dict (srecode-create-dictionary (current-buffer)))
	 (end (current-time))
	 )
    (message "Creating a dictionary took %.2f seconds."
	     (semantic-elapsed-time start end))
    (data-debug-new-buffer "*SRECODE ADEBUG*")
    (data-debug-insert-object-slots dict "*")))

(defun srecode-dictionary-dump ()
  "Dump a typical fabricated dictionary."
  (interactive)
  (require 'srecode/find)
  (let ((modesym major-mode))
    ;; This load allows the dictionary access to inherited
    ;; and stacked dictionary entries.
    (srecode-load-tables-for-mode modesym)
    (let ((tmp (srecode-get-mode-table modesym))
	  )
      (if (not tmp)
	  (error "No table found for mode %S" modesym))
      ;; Now make the dictionary.
      (let ((dict (srecode-create-dictionary (current-buffer))))
	(with-output-to-temp-buffer "*SRECODE DUMP*"
	  (princ "DICTIONARY FOR ")
	  (princ major-mode)
	  (princ "\n--------------------------------------------\n")
	  (srecode-dump dict))
	))))

(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
  "Dump a dictionary."
  (if (not indent) (setq indent 0))
  (maphash (lambda (key entry)
	     (princ (make-string indent ? ))
	     (princ " ")
	     (princ key)
	     (princ " ")
	     (cond ((and (listp entry)
			 (srecode-dictionary-p (car entry)))
		    (let ((newindent (if indent
					 (+ indent 4)
				       4)))
		      (while entry
			(princ " --> SUBDICTIONARY ")
			(princ (object-name dict))
			(princ "\n")
			(srecode-dump (car entry) newindent)
			(setq entry (cdr entry))
			))
		    (princ "\n")
		    )
		   ((srecode-dictionary-compound-value-child-p entry)
		    (srecode-dump entry indent)
		    (princ "\n")
		    )
		   (t
		    (prin1 entry)
		    ;(princ "\n")
		    ))
	     (terpri)
	     )
	   (oref dict namehash))
  )

(provide 'srecode/dictionary)

;; arch-tag: c664179c-171c-4709-9b56-d5a2fd30e457
;;; srecode/dictionary.el ends here