Commit | Line | Data |
---|---|---|
07a79ce4 | 1 | ;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. |
4d902e6f | 2 | |
73b0cd50 | 3 | ;; Copyright (C) 2007-2011 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 | ||
120 | (when (not state) | |
121 | (error "Cannot create compound variable without :state")) | |
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) | |
178 | origin (concat (object-name buffer-or-parent) " in " | |
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 CY |
204 | ;; Only set up the default variables if we are being built |
205 | ;; directroy for a particular buffer. | |
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 | |
223 | (let ((tabs (oref tpl :tables))) | |
b9749554 | 224 | (require 'srecode/find) ; For srecode-template-table-in-project-p |
4d902e6f | 225 | (while tabs |
b9749554 EL |
226 | (when (srecode-template-table-in-project-p (car tabs)) |
227 | (let ((vars (oref (car tabs) variables))) | |
228 | (while vars | |
229 | (srecode-dictionary-set-value | |
230 | dict (car (car vars)) (cdr (car vars))) | |
231 | (setq vars (cdr vars))))) | |
232 | (setq tabs (cdr tabs)))))) | |
4d902e6f CY |
233 | |
234 | ||
235 | (defmethod srecode-dictionary-set-value ((dict srecode-dictionary) | |
236 | name value) | |
237 | "In dictionary DICT, set NAME to have VALUE." | |
238 | ;; Validate inputs | |
b9749554 EL |
239 | (unless (stringp name) |
240 | (signal 'wrong-type-argument (list name 'stringp))) | |
241 | ||
4d902e6f CY |
242 | ;; Add the value. |
243 | (with-slots (namehash) dict | |
244 | (puthash name value namehash)) | |
245 | ) | |
246 | ||
247 | (defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary) | |
b9749554 | 248 | name &optional show-only force) |
4d902e6f CY |
249 | "In dictionary DICT, add a section dictionary for section macro NAME. |
250 | Return the new dictionary. | |
251 | ||
b9749554 EL |
252 | You can add several dictionaries to the same section entry. |
253 | For each dictionary added to a variable, the block of codes in | |
254 | the template will be repeated. | |
4d902e6f | 255 | |
db9e401b | 256 | If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary |
4d902e6f CY |
257 | if there is already one in place. Also, don't add FIRST/LAST entries. |
258 | These entries are not needed when we are just showing a section. | |
259 | ||
260 | Each dictionary added will automatically get values for positional macros | |
261 | which will enable SECTIONS to be enabled. | |
262 | ||
263 | * FIRST - The first entry in the table. | |
264 | * NOTFIRST - Not the first entry in the table. | |
265 | * LAST - The last entry in the table | |
266 | * NOTLAST - Not the last entry in the table. | |
267 | ||
268 | Adding a new dictionary will alter these values in previously | |
269 | inserted dictionaries." | |
270 | ;; Validate inputs | |
b9749554 EL |
271 | (unless (stringp name) |
272 | (signal 'wrong-type-argument (list name 'stringp))) | |
273 | ||
4d902e6f | 274 | (let ((new (srecode-create-dictionary dict)) |
b9749554 | 275 | (ov (srecode-dictionary-lookup-name dict name t))) |
4d902e6f CY |
276 | |
277 | (when (not show-only) | |
278 | ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries. | |
279 | (if (null ov) | |
280 | (progn | |
281 | (srecode-dictionary-show-section new "FIRST") | |
282 | (srecode-dictionary-show-section new "LAST")) | |
c7015153 | 283 | ;; Not the very first one. Let's clean up CAR. |
4d902e6f CY |
284 | (let ((tail (car (last ov)))) |
285 | (srecode-dictionary-hide-section tail "LAST") | |
286 | (srecode-dictionary-show-section tail "NOTLAST") | |
287 | ) | |
288 | (srecode-dictionary-show-section new "NOTFIRST") | |
289 | (srecode-dictionary-show-section new "LAST")) | |
290 | ) | |
291 | ||
b9749554 EL |
292 | (when (or force |
293 | (not show-only) | |
294 | (null ov)) | |
4d902e6f CY |
295 | (srecode-dictionary-set-value dict name (append ov (list new)))) |
296 | ;; Return the new sub-dictionary. | |
297 | new)) | |
298 | ||
299 | (defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name) | |
300 | "In dictionary DICT, indicate that the section NAME should be exposed." | |
301 | ;; Validate inputs | |
b9749554 EL |
302 | (unless (stringp name) |
303 | (signal 'wrong-type-argument (list name 'stringp))) | |
304 | ||
4d902e6f CY |
305 | ;; Showing a section is just like making a section dictionary, but |
306 | ;; with no dictionary values to add. | |
307 | (srecode-dictionary-add-section-dictionary dict name t) | |
308 | nil) | |
309 | ||
310 | (defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name) | |
311 | "In dictionary DICT, indicate that the section NAME should be hidden." | |
312 | ;; We need to find the has value, and then delete it. | |
313 | ;; Validate inputs | |
b9749554 EL |
314 | (unless (stringp name) |
315 | (signal 'wrong-type-argument (list name 'stringp))) | |
316 | ||
4d902e6f CY |
317 | ;; Add the value. |
318 | (with-slots (namehash) dict | |
319 | (remhash name namehash)) | |
320 | nil) | |
321 | ||
b9749554 EL |
322 | (defmethod srecode-dictionary-add-entries ((dict srecode-dictionary) |
323 | entries &optional state) | |
324 | "Add ENTRIES to DICT. | |
325 | ||
326 | ENTRIES is a list of even length of dictionary entries to | |
327 | add. ENTRIES looks like this: | |
328 | ||
329 | (NAME_1 VALUE_1 NAME_2 VALUE_2 ...) | |
330 | ||
331 | The following rules apply: | |
332 | * NAME_N is a string | |
333 | and 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 | ||
339 | The optional argument STATE has to non-nil when compound values | |
340 | are inserted. An error is signaled if ENTRIES contains compound | |
341 | values 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. | |
376 | Unless the optional argument FORCE is non-nil, values in DICT are | |
377 | not modified, even if there are values of the same names in | |
378 | OTHERDICT." | |
4d902e6f CY |
379 | (when otherdict |
380 | (maphash | |
381 | (lambda (key entry) | |
b9749554 EL |
382 | ;; The new values is only merged in if there was no old value |
383 | ;; or FORCE is non-nil. | |
384 | ;; | |
4d902e6f CY |
385 | ;; This protects applications from being whacked, and basically |
386 | ;; makes these new section dictionary entries act like | |
387 | ;; "defaults" instead of overrides. | |
b9749554 EL |
388 | (when (or force |
389 | (not (srecode-dictionary-lookup-name dict key t))) | |
390 | (cond | |
391 | ;; A list of section dictionaries. We need to merge them in. | |
392 | ((and (listp entry) | |
393 | (srecode-dictionary-p (car entry))) | |
394 | (dolist (sub-dict entry) | |
395 | (srecode-dictionary-merge | |
396 | (srecode-dictionary-add-section-dictionary | |
397 | dict key t t) | |
398 | sub-dict force))) | |
399 | ||
400 | ;; Other values can be set directly. | |
401 | (t | |
402 | (srecode-dictionary-set-value dict key entry))))) | |
4d902e6f CY |
403 | (oref otherdict namehash)))) |
404 | ||
405 | (defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary) | |
b9749554 EL |
406 | name &optional non-recursive) |
407 | "Return information about DICT's value for NAME. | |
408 | DICT is a dictionary, and NAME is a string that is treated as the | |
409 | name of an entry in the dictionary. If such an entry exists, its | |
410 | value is returned. Otherwise, nil is returned. Normally, the | |
411 | lookup is recursive in the sense that the parent of DICT is | |
412 | searched for NAME if it is not found in DICT. This recursive | |
413 | lookup can be disabled by the optional argument NON-RECURSIVE. | |
414 | ||
415 | This function derives values for some special NAMEs, such as | |
416 | 'FIRST' and 'LAST'." | |
4d902e6f CY |
417 | (if (not (slot-boundp dict 'namehash)) |
418 | nil | |
b9749554 EL |
419 | ;; Get the value of this name from the dictionary or its parent |
420 | ;; unless the lookup should be non-recursive. | |
421 | (with-slots (namehash parent) dict | |
422 | (or (gethash name namehash) | |
423 | (and (not non-recursive) | |
424 | (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST"))) | |
425 | parent | |
426 | (srecode-dictionary-lookup-name parent name))))) | |
427 | ) | |
4d902e6f CY |
428 | |
429 | (defmethod srecode-root-dictionary ((dict srecode-dictionary)) | |
430 | "For dictionary DICT, return the root dictionary. | |
431 | The root dictionary is usually for a current or active insertion." | |
432 | (let ((ans dict)) | |
433 | (while (oref ans parent) | |
434 | (setq ans (oref ans parent))) | |
435 | ans)) | |
436 | ||
437 | ;;; COMPOUND VALUE METHODS | |
438 | ;; | |
8350f087 | 439 | ;; Compound values must provide at least the toString method |
4d902e6f CY |
440 | ;; for use in converting the compound value into sometehing insertable. |
441 | ||
442 | (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value) | |
443 | function | |
444 | dictionary) | |
445 | "Convert the compound dictionary value CP to a string. | |
446 | If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect | |
447 | of the compound value. The FUNCTION could be a fraction | |
448 | of some function symbol with a logical prefix excluded. | |
449 | ||
450 | If you subclass `srecode-dictionary-compound-value' then this | |
451 | method could return nil, but if it does that, it must insert | |
452 | the value itself using `princ', or by detecting if the current | |
453 | standard out is a buffer, and using `insert'." | |
454 | (object-name cp)) | |
455 | ||
456 | (defmethod srecode-dump ((cp srecode-dictionary-compound-value) | |
457 | &optional indent) | |
458 | "Display information about this compound value." | |
459 | (princ (object-name cp)) | |
460 | ) | |
461 | ||
462 | (defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable) | |
463 | function | |
464 | dictionary) | |
465 | "Convert the compound dictionary variable value CP into a string. | |
466 | FUNCTION and DICTIONARY are as for the baseclass." | |
467 | (require 'srecode/insert) | |
468 | (srecode-insert-code-stream (oref cp compiled) dictionary)) | |
469 | ||
470 | ||
471 | (defmethod srecode-dump ((cp srecode-dictionary-compound-variable) | |
472 | &optional indent) | |
473 | "Display information about this compound value." | |
474 | (require 'srecode/compile) | |
475 | (princ "# Compound Variable #\n") | |
476 | (let ((indent (+ 4 (or indent 0))) | |
477 | (cmp (oref cp compiled)) | |
478 | ) | |
479 | (srecode-dump-code-list cmp (make-string indent ? )) | |
480 | )) | |
481 | ||
482 | ;;; FIELD EDITING COMPOUND VALUE | |
483 | ;; | |
484 | ;; This is an interface to using field-editing objects | |
485 | ;; instead of asking questions. This provides the basics | |
486 | ;; behind this compound value. | |
487 | ||
488 | (defclass srecode-field-value (srecode-dictionary-compound-value) | |
489 | ((firstinserter :initarg :firstinserter | |
490 | :documentation | |
db9e401b | 491 | "The inserter object for the first occurrence of this field.") |
4d902e6f CY |
492 | (defaultvalue :initarg :defaultvalue |
493 | :documentation | |
494 | "The default value for this inserter.") | |
495 | ) | |
496 | "When inserting values with editable field mode, a dictionary value. | |
497 | Compound values allow a field to be stored in the dictionary for when | |
498 | it is referenced a second time. This compound value can then be | |
499 | inserted with a new editable field.") | |
500 | ||
501 | (defmethod srecode-compound-toString((cp srecode-field-value) | |
502 | function | |
503 | dictionary) | |
504 | "Convert this field into an insertable string." | |
505 | (require 'srecode/fields) | |
506 | ;; If we are not in a buffer, then this is not supported. | |
507 | (when (not (bufferp standard-output)) | |
2f10955c | 508 | (error "FIELDS invoked while inserting template to non-buffer")) |
4d902e6f CY |
509 | |
510 | (if function | |
2f10955c | 511 | (error "@todo: Cannot mix field insertion with functions") |
4d902e6f CY |
512 | |
513 | ;; No function. Perform a plain field insertion. | |
514 | ;; We know we are in a buffer, so we can perform the insertion. | |
515 | (let* ((dv (oref cp defaultvalue)) | |
516 | (sti (oref cp firstinserter)) | |
517 | (start (point)) | |
518 | (name (oref sti :object-name))) | |
519 | ||
b9749554 EL |
520 | (cond |
521 | ;; No default value. | |
522 | ((not dv) (insert name)) | |
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. | |
4d902e6f CY |
536 | (srecode-field name :name name |
537 | :start start | |
538 | :end (point) | |
539 | :prompt (oref sti prompt) | |
540 | :read-fcn (oref sti read-fcn) | |
541 | ) | |
542 | )) | |
543 | ;; Returning nil is a signal that we have done the insertion ourselves. | |
544 | nil) | |
545 | ||
546 | \f | |
547 | ;;; Higher level dictionary functions | |
548 | ;; | |
549 | (defun srecode-create-section-dictionary (sectiondicts STATE) | |
550 | "Create a dictionary with section entries for a template. | |
551 | The format for SECTIONDICTS is what is emitted from the template parsers. | |
552 | STATE is the current compiler state." | |
553 | (when sectiondicts | |
554 | (let ((new (srecode-create-dictionary t))) | |
555 | ;; Loop over each section. The section is a macro w/in the | |
556 | ;; template. | |
557 | (while sectiondicts | |
558 | (let* ((sect (car (car sectiondicts))) | |
559 | (entries (cdr (car sectiondicts))) | |
560 | (subdict (srecode-dictionary-add-section-dictionary new sect)) | |
561 | ) | |
562 | ;; Loop over each entry. This is one variable in the | |
563 | ;; section dictionary. | |
564 | (while entries | |
565 | (let ((tname (semantic-tag-name (car entries))) | |
566 | (val (semantic-tag-variable-default (car entries)))) | |
567 | (if (eq val t) | |
568 | (srecode-dictionary-show-section subdict tname) | |
569 | (cond | |
570 | ((and (stringp (car val)) | |
571 | (= (length val) 1)) | |
572 | (setq val (car val))) | |
573 | (t | |
574 | (setq val (srecode-dictionary-compound-variable | |
575 | tname :value val :state STATE)))) | |
576 | (srecode-dictionary-set-value | |
577 | subdict tname val)) | |
578 | (setq entries (cdr entries)))) | |
579 | ) | |
580 | (setq sectiondicts (cdr sectiondicts))) | |
581 | new))) | |
582 | ||
b9749554 EL |
583 | (defun srecode-create-dictionaries-from-tags (tags state) |
584 | "Create a dictionary with entries according to TAGS. | |
585 | ||
586 | TAGS should be in the format produced by the template file | |
587 | grammar. That is | |
588 | ||
589 | TAGS = (ENTRY_1 ENTRY_2 ...) | |
590 | ||
591 | where | |
592 | ||
593 | ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG | |
594 | ||
595 | where TAG is a semantic tag of class 'variable. The (NAME ... ) | |
596 | form creates a child dictionary which is stored under the name | |
597 | NAME. The TAG form creates a value entry or section dictionary | |
598 | entry whose name is the name of the tag. | |
599 | ||
600 | STATE 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 | ||
4d902e6f CY |
630 | ;;; DUMP DICTIONARY |
631 | ;; | |
632 | ;; Make a dictionary, and dump it's contents. | |
633 | ||
634 | (defun srecode-adebug-dictionary () | |
635 | "Run data-debug on this mode's dictionary." | |
636 | (interactive) | |
637 | (require 'eieio-datadebug) | |
638 | (require 'semantic) | |
639 | (require 'srecode/find) | |
640 | (let* ((modesym major-mode) | |
641 | (start (current-time)) | |
642 | (junk (or (progn (srecode-load-tables-for-mode modesym) | |
643 | (srecode-get-mode-table modesym)) | |
644 | (error "No table found for mode %S" modesym))) | |
645 | (dict (srecode-create-dictionary (current-buffer))) | |
646 | (end (current-time)) | |
647 | ) | |
648 | (message "Creating a dictionary took %.2f seconds." | |
649 | (semantic-elapsed-time start end)) | |
650 | (data-debug-new-buffer "*SRECODE ADEBUG*") | |
651 | (data-debug-insert-object-slots dict "*"))) | |
652 | ||
653 | (defun srecode-dictionary-dump () | |
654 | "Dump a typical fabricated dictionary." | |
655 | (interactive) | |
656 | (require 'srecode/find) | |
657 | (let ((modesym major-mode)) | |
658 | ;; This load allows the dictionary access to inherited | |
659 | ;; and stacked dictionary entries. | |
660 | (srecode-load-tables-for-mode modesym) | |
661 | (let ((tmp (srecode-get-mode-table modesym)) | |
662 | ) | |
663 | (if (not tmp) | |
664 | (error "No table found for mode %S" modesym)) | |
665 | ;; Now make the dictionary. | |
666 | (let ((dict (srecode-create-dictionary (current-buffer)))) | |
667 | (with-output-to-temp-buffer "*SRECODE DUMP*" | |
668 | (princ "DICTIONARY FOR ") | |
669 | (princ major-mode) | |
670 | (princ "\n--------------------------------------------\n") | |
671 | (srecode-dump dict)) | |
672 | )))) | |
673 | ||
674 | (defmethod srecode-dump ((dict srecode-dictionary) &optional indent) | |
675 | "Dump a dictionary." | |
676 | (if (not indent) (setq indent 0)) | |
677 | (maphash (lambda (key entry) | |
678 | (princ (make-string indent ? )) | |
679 | (princ " ") | |
680 | (princ key) | |
681 | (princ " ") | |
682 | (cond ((and (listp entry) | |
683 | (srecode-dictionary-p (car entry))) | |
684 | (let ((newindent (if indent | |
685 | (+ indent 4) | |
686 | 4))) | |
687 | (while entry | |
688 | (princ " --> SUBDICTIONARY ") | |
689 | (princ (object-name dict)) | |
690 | (princ "\n") | |
691 | (srecode-dump (car entry) newindent) | |
692 | (setq entry (cdr entry)) | |
693 | )) | |
694 | (princ "\n") | |
695 | ) | |
696 | ((srecode-dictionary-compound-value-child-p entry) | |
697 | (srecode-dump entry indent) | |
698 | (princ "\n") | |
699 | ) | |
700 | (t | |
701 | (prin1 entry) | |
702 | ;(princ "\n") | |
703 | )) | |
704 | (terpri) | |
705 | ) | |
706 | (oref dict namehash)) | |
707 | ) | |
708 | ||
709 | (provide 'srecode/dictionary) | |
710 | ||
711 | ;;; srecode/dictionary.el ends here |