Commit | Line | Data |
---|---|---|
07a79ce4 | 1 | ;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. |
4d902e6f | 2 | |
ba318903 | 3 | ;; Copyright (C) 2007-2014 Free Software Foundation, Inc. |
4d902e6f CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
2f10955c | 24 | ;; Dictionaries contain lists of names and their associated values. |
4d902e6f CY |
25 | ;; These dictionaries are used to fill in macros from recoder templates. |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | ;;; CLASSES | |
30 | ||
67d3ffe4 | 31 | (eval-when-compile (require 'cl)) |
4d902e6f CY |
32 | (require 'eieio) |
33 | (require 'srecode) | |
34 | (require 'srecode/table) | |
35 | (eval-when-compile (require 'semantic)) | |
36 | ||
37 | (declare-function srecode-compile-parse-inserter "srecode/compile") | |
38 | (declare-function srecode-dump-code-list "srecode/compile") | |
39 | (declare-function srecode-load-tables-for-mode "srecode/find") | |
b9749554 | 40 | (declare-function srecode-template-table-in-project-p "srecode/find") |
4d902e6f CY |
41 | (declare-function srecode-insert-code-stream "srecode/insert") |
42 | (declare-function data-debug-new-buffer "data-debug") | |
43 | (declare-function data-debug-insert-object-slots "eieio-datadebug") | |
44 | (declare-function srecode-field "srecode/fields") | |
45 | ||
46 | (defclass srecode-dictionary () | |
47 | ((namehash :initarg :namehash | |
48 | :documentation | |
49 | "Hash table containing the names of all the templates.") | |
50 | (buffer :initarg :buffer | |
51 | :documentation | |
52 | "The buffer this dictionary was initialized with.") | |
53 | (parent :initarg :parent | |
54 | :type (or null srecode-dictionary) | |
55 | :documentation | |
56 | "The parent dictionary. | |
57 | Symbols not appearing in this dictionary will be checked against the | |
58 | parent dictionary.") | |
59 | (origin :initarg :origin | |
60 | :type string | |
61 | :documentation | |
62 | "A string representing the origin of this dictionary. | |
63 | Useful only while debugging.") | |
64 | ) | |
65 | "Dictionary of symbols and what they mean. | |
66 | Dictionaries are used to look up named symbols from | |
67 | templates to decide what to do with those symbols.") | |
68 | ||
69 | (defclass srecode-dictionary-compound-value () | |
70 | () | |
71 | "A compound dictionary value. | |
72 | Values stored in a dictionary must be a STRING, | |
73 | a dictionary for showing sections, or an instance of a subclass | |
74 | of this class. | |
75 | ||
76 | Compound dictionary values derive from this class, and must | |
77 | provide a sequence of method implementations to convert into | |
78 | a string." | |
79 | :abstract t) | |
80 | ||
81 | (defclass srecode-dictionary-compound-variable | |
82 | (srecode-dictionary-compound-value) | |
83 | ((value :initarg :value | |
84 | :documentation | |
85 | "The value of this template variable. | |
86 | Variables in template files are usually a single string | |
87 | which can be inserted into a dictionary directly. | |
88 | ||
89 | Some variables may be more complex and involve dictionary | |
90 | lookups, strings, concatenation, or the like. | |
91 | ||
92 | The format of VALUE is determined by current template | |
93 | formatting rules.") | |
94 | (compiled :initarg :compiled | |
95 | :type list | |
96 | :documentation | |
97 | "The compiled version of VALUE.") | |
98 | ) | |
99 | "A compound dictionary value for template file variables. | |
100 | You can declare a variable in a template like this: | |
101 | ||
102 | set NAME \"str\" macro \"OTHERNAME\" | |
103 | ||
104 | with appending various parts together in a list.") | |
105 | ||
106 | (defmethod initialize-instance ((this srecode-dictionary-compound-variable) | |
107 | &optional fields) | |
108 | "Initialize the compound variable THIS. | |
109 | Makes sure that :value is compiled." | |
110 | (let ((newfields nil) | |
111 | (state nil)) | |
112 | (while fields | |
113 | ;; Strip out :state | |
114 | (if (eq (car fields) :state) | |
115 | (setq state (car (cdr fields))) | |
116 | (setq newfields (cons (car (cdr fields)) | |
117 | (cons (car fields) newfields)))) | |
118 | (setq fields (cdr (cdr fields)))) | |
119 | ||
62a81506 CY |
120 | ;;(when (not state) |
121 | ;; (error "Cannot create compound variable outside of sectiondictionary")) | |
4d902e6f CY |
122 | |
123 | (call-next-method this (nreverse newfields)) | |
124 | (when (not (slot-boundp this 'compiled)) | |
125 | (let ((val (oref this :value)) | |
126 | (comp nil)) | |
127 | (while val | |
128 | (let ((nval (car val)) | |
129 | ) | |
130 | (cond ((stringp nval) | |
131 | (setq comp (cons nval comp))) | |
132 | ((and (listp nval) | |
133 | (equal (car nval) 'macro)) | |
134 | (require 'srecode/compile) | |
135 | (setq comp (cons | |
136 | (srecode-compile-parse-inserter | |
137 | (cdr nval) | |
138 | state) | |
139 | comp))) | |
140 | (t | |
141 | (error "Don't know how to handle variable value %S" nval))) | |
142 | ) | |
143 | (setq val (cdr val))) | |
144 | (oset this :compiled (nreverse comp)))))) | |
145 | ||
146 | ;;; DICTIONARY METHODS | |
147 | ;; | |
148 | ||
149 | (defun srecode-create-dictionary (&optional buffer-or-parent) | |
150 | "Create a dictionary for BUFFER. | |
151 | If BUFFER-OR-PARENT is not specified, assume a buffer, and | |
152 | use the current buffer. | |
153 | If BUFFER-OR-PARENT is another dictionary, then remember the | |
154 | parent within the new dictionary, and assume that BUFFER | |
155 | is the same as belongs to the parent dictionary. | |
156 | The dictionary is initialized with variables setup for that | |
157 | buffer's table. | |
158 | If BUFFER-OR-PARENT is t, then this dictionary should not be | |
2f10955c | 159 | associated with a buffer or parent." |
4d902e6f | 160 | (save-excursion |
b9749554 | 161 | ;; Handle the parent |
4d902e6f CY |
162 | (let ((parent nil) |
163 | (buffer nil) | |
164 | (origin nil) | |
165 | (initfrombuff nil)) | |
b9749554 EL |
166 | (cond |
167 | ;; Parent is a buffer | |
168 | ((bufferp buffer-or-parent) | |
169 | (set-buffer buffer-or-parent) | |
170 | (setq buffer buffer-or-parent | |
171 | origin (buffer-name buffer-or-parent) | |
172 | initfrombuff t)) | |
173 | ||
174 | ;; Parent is another dictionary | |
175 | ((srecode-dictionary-child-p buffer-or-parent) | |
176 | (setq parent buffer-or-parent | |
177 | buffer (oref buffer-or-parent buffer) | |
e8cc7880 | 178 | origin (concat (eieio-object-name buffer-or-parent) " in " |
b9749554 EL |
179 | (if buffer (buffer-name buffer) |
180 | "no buffer"))) | |
181 | (when buffer | |
182 | (set-buffer buffer))) | |
183 | ||
184 | ;; No parent | |
185 | ((eq buffer-or-parent t) | |
186 | (setq buffer nil | |
187 | origin "Unspecified Origin")) | |
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. | |
4d902e6f CY |
197 | (let ((dict (srecode-dictionary |
198 | major-mode | |
b9749554 EL |
199 | :buffer buffer |
200 | :parent parent | |
201 | :namehash (make-hash-table :test 'equal | |
202 | :size 20) | |
203 | :origin origin))) | |
4d902e6f | 204 | ;; Only set up the default variables if we are being built |
4c36be58 | 205 | ;; directly for a particular buffer. |
4d902e6f CY |
206 | (when initfrombuff |
207 | ;; Variables from the table we are inserting from. | |
208 | ;; @todo - get a better tree of tables. | |
209 | (let ((mt (srecode-get-mode-table major-mode)) | |
210 | (def (srecode-get-mode-table 'default))) | |
211 | ;; Each table has multiple template tables. | |
212 | ;; Do DEF first so that MT can override any values. | |
213 | (srecode-dictionary-add-template-table dict def) | |
214 | (srecode-dictionary-add-template-table dict mt) | |
215 | )) | |
216 | dict)))) | |
217 | ||
218 | (defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary) | |
219 | tpl) | |
220 | "Insert into DICT the variables found in table TPL. | |
221 | TPL is an object representing a compiled template file." | |
222 | (when tpl | |
62a81506 CY |
223 | ;; Tables are sorted with highest priority first, useful for looking |
224 | ;; up templates, but this means we need to install the variables in | |
225 | ;; reverse order so higher priority variables override lower ones. | |
226 | (let ((tabs (reverse (oref tpl :tables)))) | |
b9749554 | 227 | (require 'srecode/find) ; For srecode-template-table-in-project-p |
4d902e6f | 228 | (while tabs |
b9749554 EL |
229 | (when (srecode-template-table-in-project-p (car tabs)) |
230 | (let ((vars (oref (car tabs) variables))) | |
231 | (while vars | |
232 | (srecode-dictionary-set-value | |
233 | dict (car (car vars)) (cdr (car vars))) | |
234 | (setq vars (cdr vars))))) | |
235 | (setq tabs (cdr tabs)))))) | |
4d902e6f CY |
236 | |
237 | ||
238 | (defmethod srecode-dictionary-set-value ((dict srecode-dictionary) | |
239 | name value) | |
240 | "In dictionary DICT, set NAME to have VALUE." | |
241 | ;; Validate inputs | |
b9749554 EL |
242 | (unless (stringp name) |
243 | (signal 'wrong-type-argument (list name 'stringp))) | |
244 | ||
4d902e6f CY |
245 | ;; Add the value. |
246 | (with-slots (namehash) dict | |
247 | (puthash name value namehash)) | |
248 | ) | |
249 | ||
250 | (defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary) | |
b9749554 | 251 | name &optional show-only force) |
4d902e6f CY |
252 | "In dictionary DICT, add a section dictionary for section macro NAME. |
253 | Return the new dictionary. | |
254 | ||
b9749554 EL |
255 | You can add several dictionaries to the same section entry. |
256 | For each dictionary added to a variable, the block of codes in | |
257 | the template will be repeated. | |
4d902e6f | 258 | |
db9e401b | 259 | If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary |
4d902e6f CY |
260 | if there is already one in place. Also, don't add FIRST/LAST entries. |
261 | These entries are not needed when we are just showing a section. | |
262 | ||
263 | Each dictionary added will automatically get values for positional macros | |
264 | which will enable SECTIONS to be enabled. | |
265 | ||
266 | * FIRST - The first entry in the table. | |
267 | * NOTFIRST - Not the first entry in the table. | |
268 | * LAST - The last entry in the table | |
269 | * NOTLAST - Not the last entry in the table. | |
270 | ||
271 | Adding a new dictionary will alter these values in previously | |
272 | inserted dictionaries." | |
273 | ;; Validate inputs | |
b9749554 EL |
274 | (unless (stringp name) |
275 | (signal 'wrong-type-argument (list name 'stringp))) | |
276 | ||
4d902e6f | 277 | (let ((new (srecode-create-dictionary dict)) |
b9749554 | 278 | (ov (srecode-dictionary-lookup-name dict name t))) |
4d902e6f CY |
279 | |
280 | (when (not show-only) | |
281 | ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries. | |
282 | (if (null ov) | |
283 | (progn | |
284 | (srecode-dictionary-show-section new "FIRST") | |
285 | (srecode-dictionary-show-section new "LAST")) | |
c7015153 | 286 | ;; Not the very first one. Let's clean up CAR. |
4d902e6f CY |
287 | (let ((tail (car (last ov)))) |
288 | (srecode-dictionary-hide-section tail "LAST") | |
289 | (srecode-dictionary-show-section tail "NOTLAST") | |
290 | ) | |
291 | (srecode-dictionary-show-section new "NOTFIRST") | |
292 | (srecode-dictionary-show-section new "LAST")) | |
293 | ) | |
294 | ||
b9749554 EL |
295 | (when (or force |
296 | (not show-only) | |
297 | (null ov)) | |
4d902e6f CY |
298 | (srecode-dictionary-set-value dict name (append ov (list new)))) |
299 | ;; Return the new sub-dictionary. | |
300 | new)) | |
301 | ||
302 | (defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name) | |
303 | "In dictionary DICT, indicate that the section NAME should be exposed." | |
304 | ;; Validate inputs | |
b9749554 EL |
305 | (unless (stringp name) |
306 | (signal 'wrong-type-argument (list name 'stringp))) | |
307 | ||
4d902e6f CY |
308 | ;; Showing a section is just like making a section dictionary, but |
309 | ;; with no dictionary values to add. | |
310 | (srecode-dictionary-add-section-dictionary dict name t) | |
311 | nil) | |
312 | ||
313 | (defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name) | |
314 | "In dictionary DICT, indicate that the section NAME should be hidden." | |
315 | ;; We need to find the has value, and then delete it. | |
316 | ;; Validate inputs | |
b9749554 EL |
317 | (unless (stringp name) |
318 | (signal 'wrong-type-argument (list name 'stringp))) | |
319 | ||
4d902e6f CY |
320 | ;; Add the value. |
321 | (with-slots (namehash) dict | |
322 | (remhash name namehash)) | |
323 | nil) | |
324 | ||
b9749554 EL |
325 | (defmethod srecode-dictionary-add-entries ((dict srecode-dictionary) |
326 | entries &optional state) | |
327 | "Add ENTRIES to DICT. | |
328 | ||
329 | ENTRIES is a list of even length of dictionary entries to | |
330 | add. ENTRIES looks like this: | |
331 | ||
332 | (NAME_1 VALUE_1 NAME_2 VALUE_2 ...) | |
333 | ||
334 | The following rules apply: | |
335 | * NAME_N is a string | |
336 | and for values | |
337 | * If VALUE_N is t, the section NAME_N is shown. | |
338 | * If VALUE_N is a string, an ordinary value is inserted. | |
339 | * If VALUE_N is a dictionary, it is inserted as entry NAME_N. | |
340 | * Otherwise, a compound variable is created for VALUE_N. | |
341 | ||
342 | The optional argument STATE has to non-nil when compound values | |
343 | are inserted. An error is signaled if ENTRIES contains compound | |
344 | values but STATE is nil." | |
345 | (while entries | |
346 | (let ((name (nth 0 entries)) | |
347 | (value (nth 1 entries))) | |
348 | (cond | |
349 | ;; Value is t; show a section. | |
350 | ((eq value t) | |
351 | (srecode-dictionary-show-section dict name)) | |
352 | ||
353 | ;; Value is a simple string; create an ordinary dictionary | |
354 | ;; entry | |
355 | ((stringp value) | |
356 | (srecode-dictionary-set-value dict name value)) | |
357 | ||
358 | ;; Value is a dictionary; insert as child dictionary. | |
359 | ((srecode-dictionary-child-p value) | |
360 | (srecode-dictionary-merge | |
361 | (srecode-dictionary-add-section-dictionary dict name) | |
362 | value t)) | |
363 | ||
364 | ;; Value is some other object; create a compound value. | |
365 | (t | |
366 | (unless state | |
367 | (error "Cannot insert compound values without state.")) | |
368 | ||
369 | (srecode-dictionary-set-value | |
370 | dict name | |
371 | (srecode-dictionary-compound-variable | |
372 | name :value value :state state))))) | |
373 | (setq entries (nthcdr 2 entries))) | |
374 | dict) | |
375 | ||
376 | (defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict | |
377 | &optional force) | |
378 | "Merge into DICT the dictionary entries from OTHERDICT. | |
379 | Unless the optional argument FORCE is non-nil, values in DICT are | |
380 | not modified, even if there are values of the same names in | |
381 | OTHERDICT." | |
4d902e6f CY |
382 | (when otherdict |
383 | (maphash | |
384 | (lambda (key entry) | |
b9749554 EL |
385 | ;; The new values is only merged in if there was no old value |
386 | ;; or FORCE is non-nil. | |
387 | ;; | |
4d902e6f CY |
388 | ;; This protects applications from being whacked, and basically |
389 | ;; makes these new section dictionary entries act like | |
390 | ;; "defaults" instead of overrides. | |
b9749554 EL |
391 | (when (or force |
392 | (not (srecode-dictionary-lookup-name dict key t))) | |
393 | (cond | |
394 | ;; A list of section dictionaries. We need to merge them in. | |
395 | ((and (listp entry) | |
396 | (srecode-dictionary-p (car entry))) | |
397 | (dolist (sub-dict entry) | |
398 | (srecode-dictionary-merge | |
399 | (srecode-dictionary-add-section-dictionary | |
400 | dict key t t) | |
401 | sub-dict force))) | |
402 | ||
403 | ;; Other values can be set directly. | |
404 | (t | |
405 | (srecode-dictionary-set-value dict key entry))))) | |
4d902e6f CY |
406 | (oref otherdict namehash)))) |
407 | ||
408 | (defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary) | |
b9749554 EL |
409 | name &optional non-recursive) |
410 | "Return information about DICT's value for NAME. | |
411 | DICT is a dictionary, and NAME is a string that is treated as the | |
412 | name of an entry in the dictionary. If such an entry exists, its | |
413 | value is returned. Otherwise, nil is returned. Normally, the | |
414 | lookup is recursive in the sense that the parent of DICT is | |
415 | searched for NAME if it is not found in DICT. This recursive | |
416 | lookup can be disabled by the optional argument NON-RECURSIVE. | |
417 | ||
418 | This function derives values for some special NAMEs, such as | |
419 | 'FIRST' and 'LAST'." | |
4d902e6f CY |
420 | (if (not (slot-boundp dict 'namehash)) |
421 | nil | |
b9749554 EL |
422 | ;; Get the value of this name from the dictionary or its parent |
423 | ;; unless the lookup should be non-recursive. | |
424 | (with-slots (namehash parent) dict | |
425 | (or (gethash name namehash) | |
426 | (and (not non-recursive) | |
427 | (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST"))) | |
428 | parent | |
429 | (srecode-dictionary-lookup-name parent name))))) | |
430 | ) | |
4d902e6f CY |
431 | |
432 | (defmethod srecode-root-dictionary ((dict srecode-dictionary)) | |
433 | "For dictionary DICT, return the root dictionary. | |
434 | The root dictionary is usually for a current or active insertion." | |
435 | (let ((ans dict)) | |
436 | (while (oref ans parent) | |
437 | (setq ans (oref ans parent))) | |
438 | ans)) | |
439 | ||
440 | ;;; COMPOUND VALUE METHODS | |
441 | ;; | |
8350f087 | 442 | ;; Compound values must provide at least the toString method |
cd1181db | 443 | ;; for use in converting the compound value into something insertable. |
4d902e6f CY |
444 | |
445 | (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value) | |
446 | function | |
447 | dictionary) | |
448 | "Convert the compound dictionary value CP to a string. | |
449 | If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect | |
450 | of the compound value. The FUNCTION could be a fraction | |
451 | of some function symbol with a logical prefix excluded. | |
452 | ||
453 | If you subclass `srecode-dictionary-compound-value' then this | |
454 | method could return nil, but if it does that, it must insert | |
455 | the value itself using `princ', or by detecting if the current | |
456 | standard out is a buffer, and using `insert'." | |
e8cc7880 | 457 | (eieio-object-name cp)) |
4d902e6f CY |
458 | |
459 | (defmethod srecode-dump ((cp srecode-dictionary-compound-value) | |
460 | &optional indent) | |
461 | "Display information about this compound value." | |
e8cc7880 | 462 | (princ (eieio-object-name cp)) |
4d902e6f CY |
463 | ) |
464 | ||
465 | (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) | |
466 | function | |
467 | dictionary) | |
468 | "Convert the compound dictionary variable value CP into a string. | |
469 | FUNCTION and DICTIONARY are as for the baseclass." | |
470 | (require 'srecode/insert) | |
471 | (srecode-insert-code-stream (oref cp compiled) dictionary)) | |
472 | ||
473 | ||
474 | (defmethod srecode-dump ((cp srecode-dictionary-compound-variable) | |
475 | &optional indent) | |
476 | "Display information about this compound value." | |
477 | (require 'srecode/compile) | |
478 | (princ "# Compound Variable #\n") | |
479 | (let ((indent (+ 4 (or indent 0))) | |
480 | (cmp (oref cp compiled)) | |
481 | ) | |
482 | (srecode-dump-code-list cmp (make-string indent ? )) | |
483 | )) | |
484 | ||
485 | ;;; FIELD EDITING COMPOUND VALUE | |
486 | ;; | |
487 | ;; This is an interface to using field-editing objects | |
488 | ;; instead of asking questions. This provides the basics | |
489 | ;; behind this compound value. | |
490 | ||
491 | (defclass srecode-field-value (srecode-dictionary-compound-value) | |
492 | ((firstinserter :initarg :firstinserter | |
493 | :documentation | |
db9e401b | 494 | "The inserter object for the first occurrence of this field.") |
4d902e6f CY |
495 | (defaultvalue :initarg :defaultvalue |
496 | :documentation | |
497 | "The default value for this inserter.") | |
498 | ) | |
499 | "When inserting values with editable field mode, a dictionary value. | |
500 | Compound values allow a field to be stored in the dictionary for when | |
501 | it is referenced a second time. This compound value can then be | |
502 | inserted with a new editable field.") | |
503 | ||
504 | (defmethod srecode-compound-toString((cp srecode-field-value) | |
505 | function | |
506 | dictionary) | |
507 | "Convert this field into an insertable string." | |
508 | (require 'srecode/fields) | |
509 | ;; If we are not in a buffer, then this is not supported. | |
510 | (when (not (bufferp standard-output)) | |
2f10955c | 511 | (error "FIELDS invoked while inserting template to non-buffer")) |
4d902e6f CY |
512 | |
513 | (if function | |
2f10955c | 514 | (error "@todo: Cannot mix field insertion with functions") |
4d902e6f CY |
515 | |
516 | ;; No function. Perform a plain field insertion. | |
517 | ;; We know we are in a buffer, so we can perform the insertion. | |
518 | (let* ((dv (oref cp defaultvalue)) | |
519 | (sti (oref cp firstinserter)) | |
520 | (start (point)) | |
521 | (name (oref sti :object-name))) | |
522 | ||
b9749554 EL |
523 | (cond |
524 | ;; No default value. | |
525 | ((not dv) (insert name)) | |
526 | ;; A compound value as the default? Recurse. | |
527 | ((srecode-dictionary-compound-value-child-p dv) | |
528 | (srecode-compound-toString dv function dictionary)) | |
529 | ;; A string that is empty? Use the name. | |
530 | ((and (stringp dv) (string= dv "")) | |
531 | (insert name)) | |
532 | ;; Insert strings | |
533 | ((stringp dv) (insert dv)) | |
534 | ;; Some other issue | |
535 | (t | |
536 | (error "Unknown default value for value %S" name))) | |
537 | ||
538 | ;; Create a field from the inserter. | |
4d902e6f CY |
539 | (srecode-field name :name name |
540 | :start start | |
541 | :end (point) | |
542 | :prompt (oref sti prompt) | |
543 | :read-fcn (oref sti read-fcn) | |
544 | ) | |
545 | )) | |
546 | ;; Returning nil is a signal that we have done the insertion ourselves. | |
547 | nil) | |
548 | ||
549 | \f | |
550 | ;;; Higher level dictionary functions | |
551 | ;; | |
b9749554 EL |
552 | (defun srecode-create-dictionaries-from-tags (tags state) |
553 | "Create a dictionary with entries according to TAGS. | |
554 | ||
555 | TAGS should be in the format produced by the template file | |
556 | grammar. That is | |
557 | ||
558 | TAGS = (ENTRY_1 ENTRY_2 ...) | |
559 | ||
560 | where | |
561 | ||
562 | ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG | |
563 | ||
564 | where TAG is a semantic tag of class 'variable. The (NAME ... ) | |
565 | form creates a child dictionary which is stored under the name | |
566 | NAME. The TAG form creates a value entry or section dictionary | |
567 | entry whose name is the name of the tag. | |
568 | ||
569 | STATE is the current compiler state." | |
570 | (let ((dict (srecode-create-dictionary t)) | |
571 | (entries (apply #'append | |
572 | (mapcar | |
573 | (lambda (entry) | |
574 | (cond | |
575 | ;; Entry is a tag | |
576 | ((semantic-tag-p entry) | |
577 | (let ((name (semantic-tag-name entry)) | |
578 | (value (semantic-tag-variable-default entry))) | |
579 | (list name | |
580 | (if (and (listp value) | |
581 | (= (length value) 1) | |
582 | (stringp (car value))) | |
583 | (car value) | |
584 | value)))) | |
585 | ||
586 | ;; Entry is a nested dictionary | |
587 | (t | |
588 | (let ((name (car entry)) | |
589 | (entries (cdr entry))) | |
590 | (list name | |
591 | (srecode-create-dictionaries-from-tags | |
592 | entries state)))))) | |
593 | tags)))) | |
594 | (srecode-dictionary-add-entries | |
595 | dict entries state) | |
596 | dict) | |
597 | ) | |
598 | ||
4d902e6f CY |
599 | ;;; DUMP DICTIONARY |
600 | ;; | |
601 | ;; Make a dictionary, and dump it's contents. | |
602 | ||
603 | (defun srecode-adebug-dictionary () | |
604 | "Run data-debug on this mode's dictionary." | |
605 | (interactive) | |
606 | (require 'eieio-datadebug) | |
4d902e6f CY |
607 | (require 'srecode/find) |
608 | (let* ((modesym major-mode) | |
609 | (start (current-time)) | |
610 | (junk (or (progn (srecode-load-tables-for-mode modesym) | |
611 | (srecode-get-mode-table modesym)) | |
612 | (error "No table found for mode %S" modesym))) | |
613 | (dict (srecode-create-dictionary (current-buffer))) | |
614 | (end (current-time)) | |
615 | ) | |
616 | (message "Creating a dictionary took %.2f seconds." | |
617 | (semantic-elapsed-time start end)) | |
618 | (data-debug-new-buffer "*SRECODE ADEBUG*") | |
619 | (data-debug-insert-object-slots dict "*"))) | |
620 | ||
621 | (defun srecode-dictionary-dump () | |
622 | "Dump a typical fabricated dictionary." | |
623 | (interactive) | |
624 | (require 'srecode/find) | |
625 | (let ((modesym major-mode)) | |
626 | ;; This load allows the dictionary access to inherited | |
627 | ;; and stacked dictionary entries. | |
628 | (srecode-load-tables-for-mode modesym) | |
629 | (let ((tmp (srecode-get-mode-table modesym)) | |
630 | ) | |
631 | (if (not tmp) | |
632 | (error "No table found for mode %S" modesym)) | |
633 | ;; Now make the dictionary. | |
634 | (let ((dict (srecode-create-dictionary (current-buffer)))) | |
635 | (with-output-to-temp-buffer "*SRECODE DUMP*" | |
636 | (princ "DICTIONARY FOR ") | |
637 | (princ major-mode) | |
638 | (princ "\n--------------------------------------------\n") | |
639 | (srecode-dump dict)) | |
640 | )))) | |
641 | ||
642 | (defmethod srecode-dump ((dict srecode-dictionary) &optional indent) | |
643 | "Dump a dictionary." | |
644 | (if (not indent) (setq indent 0)) | |
645 | (maphash (lambda (key entry) | |
646 | (princ (make-string indent ? )) | |
647 | (princ " ") | |
648 | (princ key) | |
649 | (princ " ") | |
650 | (cond ((and (listp entry) | |
651 | (srecode-dictionary-p (car entry))) | |
652 | (let ((newindent (if indent | |
653 | (+ indent 4) | |
654 | 4))) | |
655 | (while entry | |
656 | (princ " --> SUBDICTIONARY ") | |
e8cc7880 | 657 | (princ (eieio-object-name dict)) |
4d902e6f CY |
658 | (princ "\n") |
659 | (srecode-dump (car entry) newindent) | |
660 | (setq entry (cdr entry)) | |
661 | )) | |
662 | (princ "\n") | |
663 | ) | |
664 | ((srecode-dictionary-compound-value-child-p entry) | |
665 | (srecode-dump entry indent) | |
666 | (princ "\n") | |
667 | ) | |
668 | (t | |
669 | (prin1 entry) | |
670 | ;(princ "\n") | |
671 | )) | |
672 | (terpri) | |
673 | ) | |
674 | (oref dict namehash)) | |
675 | ) | |
676 | ||
677 | (provide 'srecode/dictionary) | |
678 | ||
679 | ;;; srecode/dictionary.el ends here |