Commit | Line | Data |
---|---|---|
07a79ce4 | 1 | ;;; srecode/insert.el --- Insert srecode templates to an output stream. |
4d902e6f | 2 | |
ba318903 | 3 | ;; Copyright (C) 2005, 2007-2014 Free Software Foundation, Inc. |
4d902e6f CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
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 | ;; | |
24 | ;; Define and implements specific inserter objects. | |
25 | ;; | |
26 | ;; Manage the insertion process for a template. | |
27 | ;; | |
28 | ||
b9749554 EL |
29 | (eval-when-compile |
30 | (require 'cl)) ;; for `lexical-let' | |
31 | ||
4d902e6f CY |
32 | (require 'srecode/compile) |
33 | (require 'srecode/find) | |
34 | (require 'srecode/dictionary) | |
a70bfe61 | 35 | (require 'srecode/args) |
c6ddbd68 | 36 | (require 'srecode/filters) |
4d902e6f CY |
37 | |
38 | (defvar srecode-template-inserter-point) | |
39 | (declare-function srecode-overlaid-activate "srecode/fields") | |
40 | (declare-function srecode-template-inserted-region "srecode/fields") | |
41 | ||
42 | ;;; Code: | |
43 | ||
44 | (defcustom srecode-insert-ask-variable-method 'ask | |
45 | "Determine how to ask for a dictionary value when inserting a template. | |
46 | Only the ASK style inserter will query the user for a value. | |
47 | Dictionary value references that ask begin with the ? character. | |
48 | Possible values are: | |
49 | 'ask - Prompt in the minibuffer as the value is inserted. | |
50 | 'field - Use the dictionary macro name as the inserted value, | |
51 | and place a field there. Matched fields change together. | |
52 | ||
53 | NOTE: The field feature does not yet work with XEmacs." | |
54 | :group 'srecode | |
55 | :type '(choice (const :tag "Ask" ask) | |
b9749554 | 56 | (const :tag "Field" field))) |
4d902e6f CY |
57 | |
58 | (defvar srecode-insert-with-fields-in-progress nil | |
59 | "Non-nil means that we are actively inserting a template with fields.") | |
60 | ||
61 | ;;; INSERTION COMMANDS | |
62 | ;; | |
63 | ;; User level commands for inserting stuff. | |
64 | (defvar srecode-insertion-start-context nil | |
65 | "The context that was at point at the beginning of the template insertion.") | |
66 | ||
67 | (defun srecode-insert-again () | |
68 | "Insert the previously inserted template (by name) again." | |
69 | (interactive) | |
70 | (let ((prev (car srecode-read-template-name-history))) | |
71 | (if prev | |
72 | (srecode-insert prev) | |
73 | (call-interactively 'srecode-insert)))) | |
74 | ||
75 | ;;;###autoload | |
76 | (defun srecode-insert (template-name &rest dict-entries) | |
2f10955c | 77 | "Insert the template TEMPLATE-NAME into the current buffer at point. |
4d902e6f CY |
78 | DICT-ENTRIES are additional dictionary values to add." |
79 | (interactive (list (srecode-read-template-name "Template Name: "))) | |
80 | (if (not (srecode-table)) | |
81 | (error "No template table found for mode %s" major-mode)) | |
82 | (let ((newdict (srecode-create-dictionary)) | |
83 | (temp (srecode-template-get-table (srecode-table) template-name)) | |
84 | (srecode-insertion-start-context (srecode-calculate-context)) | |
85 | ) | |
86 | (if (not temp) | |
87 | (error "No Template named %s" template-name)) | |
88 | (while dict-entries | |
89 | (srecode-dictionary-set-value newdict | |
90 | (car dict-entries) | |
91 | (car (cdr dict-entries))) | |
92 | (setq dict-entries (cdr (cdr dict-entries)))) | |
4d902e6f CY |
93 | (srecode-insert-fcn temp newdict) |
94 | ;; Don't put code here. We need to return the end-mark | |
95 | ;; for this insertion step. | |
96 | )) | |
97 | ||
98 | (defun srecode-insert-fcn (template dictionary &optional stream skipresolver) | |
99 | "Insert TEMPLATE using DICTIONARY into STREAM. | |
100 | Optional SKIPRESOLVER means to avoid refreshing the tag list, | |
101 | or resolving any template arguments. It is assumed the caller | |
102 | has set everything up already." | |
103 | ;; Perform the insertion. | |
104 | (let ((standard-output (or stream (current-buffer))) | |
105 | (end-mark nil)) | |
b9749554 EL |
106 | ;; Merge any template entries into the input dictionary. |
107 | (when (slot-boundp template 'dictionary) | |
108 | (srecode-dictionary-merge dictionary (oref template dictionary))) | |
109 | ||
4d902e6f CY |
110 | (unless skipresolver |
111 | ;; Make sure the semantic tags are up to date. | |
112 | (semantic-fetch-tags) | |
113 | ;; Resolve the arguments | |
114 | (srecode-resolve-arguments template dictionary)) | |
115 | ;; Insert | |
116 | (if (bufferp standard-output) | |
117 | ;; If there is a buffer, turn off various hooks. This will cause | |
118 | ;; the mod hooks to be buffered up during the insert, but | |
119 | ;; prevent tools like font-lock from fontifying mid-template. | |
b9749554 | 120 | ;; Especially important during insertion of complex comments that |
4d902e6f CY |
121 | ;; cause the new font-lock to comment-color stuff after the inserted |
122 | ;; comment. | |
123 | ;; | |
124 | ;; I'm not sure about the motion hooks. It seems like a good | |
125 | ;; idea though. | |
126 | ;; | |
127 | ;; Borrowed these concepts out of font-lock. | |
128 | ;; | |
129 | ;; I tried `combine-after-change-calls', but it did not have | |
130 | ;; the effect I wanted. | |
131 | (let ((start (point))) | |
132 | (let ((inhibit-point-motion-hooks t) | |
133 | (inhibit-modification-hooks t) | |
134 | ) | |
135 | (srecode--insert-into-buffer template dictionary) | |
136 | ) | |
137 | ;; Now call those after change functions. | |
138 | (run-hook-with-args 'after-change-functions | |
139 | start (point) 0) | |
140 | ) | |
141 | (srecode-insert-method template dictionary)) | |
142 | ;; Handle specialization of the POINT inserter. | |
143 | (when (and (bufferp standard-output) | |
144 | (slot-boundp 'srecode-template-inserter-point 'point) | |
145 | ) | |
146 | (set-buffer standard-output) | |
147 | (setq end-mark (point-marker)) | |
148 | (goto-char (oref srecode-template-inserter-point point))) | |
149 | (oset-default 'srecode-template-inserter-point point eieio-unbound) | |
150 | ||
151 | ;; Return the end-mark. | |
152 | (or end-mark (point))) | |
153 | ) | |
154 | ||
155 | (defun srecode--insert-into-buffer (template dictionary) | |
156 | "Insert a TEMPLATE with DICTIONARY into a buffer. | |
157 | Do not call this function yourself. Instead use: | |
158 | `srecode-insert' - Inserts by name. | |
159 | `srecode-insert-fcn' - Insert with objects. | |
160 | This function handles the case from one of the above functions when | |
161 | the template is inserted into a buffer. It looks | |
162 | at `srecode-insert-ask-variable-method' to decide if unbound dictionary | |
163 | entries ask questions or insert editable fields. | |
164 | ||
165 | Buffer based features related to change hooks is handled one level up." | |
166 | ;; This line prevents the field archive from being let bound | |
167 | ;; while the field insert tool is loaded via autoloads during | |
168 | ;; the insert. | |
169 | (when (eq srecode-insert-ask-variable-method 'field) | |
b82525f2 | 170 | (require 'srecode/fields)) |
4d902e6f CY |
171 | |
172 | (let ((srecode-field-archive nil) ; Prevent field leaks during insert | |
173 | (start (point)) ; Beginning of the region. | |
174 | ) | |
175 | ;; This sub-let scopes the 'in-progress' piece so we know | |
176 | ;; when to setup the end-template. | |
177 | (let ((srecode-insert-with-fields-in-progress | |
178 | (if (eq srecode-insert-ask-variable-method 'field) t nil)) | |
179 | ) | |
180 | (srecode-insert-method template dictionary) | |
181 | ) | |
182 | ;; If we are not in-progress, and we insert fields, then | |
183 | ;; create the end-template with fields editable area. | |
184 | (when (and (not srecode-insert-with-fields-in-progress) | |
185 | (eq srecode-insert-ask-variable-method 'field) ; Only if user asked | |
186 | srecode-field-archive ; Only if there were fields created | |
187 | ) | |
188 | (let ((reg | |
189 | ;; Create the field-driven editable area. | |
190 | (srecode-template-inserted-region | |
191 | "TEMPLATE" :start start :end (point)))) | |
192 | (srecode-overlaid-activate reg)) | |
193 | ) | |
194 | ;; We return with 'point being the end of the template insertion | |
195 | ;; area. Return value is not important. | |
196 | )) | |
197 | ||
3f2a848d DE |
198 | (declare-function data-debug-new-buffer "data-debug") |
199 | (declare-function data-debug-insert-stuff-list "data-debug") | |
200 | (declare-function data-debug-insert-thing dictionary "data-debug") | |
201 | ||
62a81506 CY |
202 | (defun srecode-insert-show-error-report (dictionary format &rest args) |
203 | "Display an error report based on DICTIONARY, FORMAT and ARGS. | |
204 | This is intended to diagnose problems with failed template | |
205 | insertions." | |
206 | (with-current-buffer (data-debug-new-buffer "*SRECODE INSERTION ERROR*") | |
207 | (erase-buffer) | |
208 | ;; Insert the stack of templates that are currently being | |
209 | ;; inserted. | |
210 | (insert (propertize "Template Stack" 'face '(:weight bold)) | |
211 | (propertize " (most recent at bottom)" 'face '(:slant italic)) | |
212 | ":\n") | |
213 | (data-debug-insert-stuff-list | |
214 | (reverse (oref srecode-template active)) "> ") | |
215 | ;; Show the current dictionary. | |
216 | (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") | |
217 | (data-debug-insert-thing dictionary "" "> ") | |
218 | ;; Show the error message. | |
219 | (insert (propertize "Error" 'face '(:weight bold)) "\n") | |
220 | (insert (apply #'format format args)) | |
221 | (pop-to-buffer (current-buffer)))) | |
222 | ||
223 | (defun srecode-insert-report-error (dictionary format &rest args) | |
224 | ;; TODO only display something when inside an interactive call? | |
225 | (srecode-insert-show-error-report dictionary format args) | |
226 | (apply #'error format args)) | |
227 | ||
4d902e6f CY |
228 | ;;; TEMPLATE ARGUMENTS |
229 | ;; | |
737b5223 | 230 | ;; Some templates have arguments. Each argument is associated with |
4d902e6f CY |
231 | ;; a function that can resolve the inputs needed. |
232 | (defun srecode-resolve-arguments (temp dict) | |
233 | "Resolve all the arguments needed by the template TEMP. | |
234 | Apply anything learned to the dictionary DICT." | |
235 | (srecode-resolve-argument-list (oref temp args) dict temp)) | |
236 | ||
237 | (defun srecode-resolve-argument-list (args dict &optional temp) | |
238 | "Resolve arguments in the argument list ARGS. | |
239 | ARGS is a list of symbols, such as :blank, or :file. | |
240 | Apply values to DICT. | |
d1f18ec0 | 241 | Optional argument TEMP is the template that is getting its arguments resolved." |
4d902e6f CY |
242 | (let ((fcn nil)) |
243 | (while args | |
244 | (setq fcn (intern-soft (concat "srecode-semantic-handle-" | |
245 | (symbol-name (car args))))) | |
246 | (if (not fcn) | |
247 | (error "Error resolving template argument %S" (car args))) | |
248 | (if temp | |
249 | (condition-case nil | |
250 | ;; Allow some to accept a 2nd argument optionally. | |
251 | ;; They throw an error if not available, so try again. | |
252 | (funcall fcn dict temp) | |
253 | (wrong-number-of-arguments (funcall fcn dict))) | |
254 | (funcall fcn dict)) | |
255 | (setq args (cdr args))) | |
256 | )) | |
257 | ||
258 | ;;; INSERTION STACK & METHOD | |
259 | ;; | |
260 | ;; Code managing the top-level insert method and the current | |
261 | ;; insertion stack. | |
262 | ;; | |
263 | (defmethod srecode-push ((st srecode-template)) | |
264 | "Push the srecoder template ST onto the active stack." | |
265 | (oset st active (cons st (oref st active)))) | |
266 | ||
267 | (defmethod srecode-pop :STATIC ((st srecode-template)) | |
268 | "Pop the srecoder template ST onto the active stack. | |
269 | ST can be a class, or an object." | |
270 | (oset st active (cdr (oref st active)))) | |
271 | ||
272 | (defmethod srecode-peek :STATIC ((st srecode-template)) | |
273 | "Fetch the topmost active template record. ST can be a class." | |
274 | (car (oref st active))) | |
275 | ||
276 | (defmethod srecode-insert-method ((st srecode-template) dictionary) | |
277 | "Insert the srecoder template ST." | |
278 | ;; Merge any template entries into the input dictionary. | |
b9749554 EL |
279 | ;; This may happen twice since some templates arguments need |
280 | ;; these dictionary values earlier, but these values always | |
281 | ;; need merging for template inserting in other templates. | |
4d902e6f CY |
282 | (when (slot-boundp st 'dictionary) |
283 | (srecode-dictionary-merge dictionary (oref st dictionary))) | |
284 | ;; Do an insertion. | |
285 | (unwind-protect | |
286 | (let ((c (oref st code))) | |
287 | (srecode-push st) | |
288 | (srecode-insert-code-stream c dictionary)) | |
09e80d9f | 289 | ;; Popping the stack is protected. |
4d902e6f CY |
290 | (srecode-pop st))) |
291 | ||
292 | (defun srecode-insert-code-stream (code dictionary) | |
293 | "Insert the CODE from a template into `standard-output'. | |
294 | Use DICTIONARY to resolve any macros." | |
295 | (while code | |
296 | (cond ((stringp (car code)) | |
297 | (princ (car code))) | |
298 | (t | |
299 | (srecode-insert-method (car code) dictionary))) | |
300 | (setq code (cdr code)))) | |
301 | ||
302 | ;;; INSERTERS | |
303 | ;; | |
304 | ;; Specific srecode inserters. | |
305 | ;; The base class is from srecode-compile. | |
306 | ;; | |
b9749554 | 307 | ;; Each inserter handles various macro codes from the template. |
4d902e6f CY |
308 | ;; The `code' slot specifies a character used to identify which |
309 | ;; inserter is to be created. | |
310 | ;; | |
311 | (defclass srecode-template-inserter-newline (srecode-template-inserter) | |
312 | ((key :initform "\n" | |
313 | :allocation :class | |
314 | :documentation | |
315 | "The character code used to identify inserters of this style.") | |
316 | (hard :initform nil | |
317 | :initarg :hard | |
318 | :documentation | |
319 | "Is this a hard newline (always inserted) or optional? | |
320 | Optional newlines don't insert themselves if they are on a blank line | |
321 | by themselves.") | |
322 | ) | |
323 | "Insert a newline, and possibly do indenting. | |
324 | Specify the :indent argument to enable automatic indentation when newlines | |
325 | occur in your template.") | |
326 | ||
327 | (defmethod srecode-insert-method ((sti srecode-template-inserter-newline) | |
328 | dictionary) | |
329 | "Insert the STI inserter." | |
330 | ;; To be safe, indent the previous line since the template will | |
331 | ;; change what is there to indent | |
332 | (let ((i (srecode-dictionary-lookup-name dictionary "INDENT")) | |
333 | (inbuff (bufferp standard-output)) | |
334 | (doit t) | |
335 | (pm (point-marker))) | |
336 | (when (and inbuff (not (oref sti hard))) | |
337 | ;; If this is not a hard newline, we need do the calculation | |
338 | ;; and set "doit" to nil. | |
339 | (beginning-of-line) | |
340 | (save-restriction | |
341 | (narrow-to-region (point) pm) | |
342 | (when (looking-at "\\s-*$") | |
343 | (setq doit nil))) | |
344 | (goto-char pm) | |
345 | ) | |
fa463103 | 346 | ;; Do indentation regardless of the newline. |
4d902e6f CY |
347 | (when (and (eq i t) inbuff) |
348 | (indent-according-to-mode) | |
349 | (goto-char pm)) | |
350 | ||
351 | (when doit | |
352 | (princ "\n") | |
353 | ;; Indent after the newline, particularly for numeric indents. | |
354 | (cond ((and (eq i t) (bufferp standard-output)) | |
355 | ;; WARNING - indent according to mode requires that standard-output | |
356 | ;; is a buffer! | |
357 | ;; @todo - how to indent in a string??? | |
358 | (setq pm (point-marker)) | |
359 | (indent-according-to-mode) | |
360 | (goto-char pm)) | |
361 | ((numberp i) | |
362 | (princ (make-string i " "))) | |
363 | ((stringp i) | |
364 | (princ i)))))) | |
365 | ||
366 | (defmethod srecode-dump ((ins srecode-template-inserter-newline) indent) | |
367 | "Dump the state of the SRecode template inserter INS." | |
368 | (call-next-method) | |
369 | (when (oref ins hard) | |
370 | (princ " : hard") | |
371 | )) | |
372 | ||
373 | (defclass srecode-template-inserter-blank (srecode-template-inserter) | |
374 | ((key :initform "\r" | |
375 | :allocation :class | |
376 | :documentation | |
d1f18ec0 | 377 | "The character representing this inserter style. |
4d902e6f CY |
378 | Can't be blank, or it might be used by regular variable insertion.") |
379 | (where :initform 'begin | |
380 | :initarg :where | |
381 | :documentation | |
d1f18ec0 | 382 | "This should be 'begin or 'end, indicating where to insert a CR. |
4d902e6f | 383 | When set to 'begin, it will insert a CR if we are not at 'bol'. |
d1f18ec0 | 384 | When set to 'end it will insert a CR if we are not at 'eol'.") |
4d902e6f CY |
385 | ;; @TODO - Add slot and control for the number of blank |
386 | ;; lines before and after point. | |
387 | ) | |
388 | "Insert a newline before and after a template, and possibly do indenting. | |
389 | Specify the :blank argument to enable this inserter.") | |
390 | ||
391 | (defmethod srecode-insert-method ((sti srecode-template-inserter-blank) | |
392 | dictionary) | |
393 | "Make sure there is no text before or after point." | |
394 | (let ((i (srecode-dictionary-lookup-name dictionary "INDENT")) | |
395 | (inbuff (bufferp standard-output)) | |
396 | (pm (point-marker))) | |
397 | (when (and inbuff | |
398 | ;; Don't do this if we are not the active template. | |
399 | (= (length (oref srecode-template active)) 1)) | |
400 | ||
401 | (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) | |
402 | (indent-according-to-mode) | |
403 | (goto-char pm)) | |
404 | ||
405 | (cond ((and (eq (oref sti where) 'begin) (not (bolp))) | |
406 | (princ "\n")) | |
407 | ((eq (oref sti where) 'end) | |
408 | ;; If there is whitespace after pnt, then clear it out. | |
409 | (when (looking-at "\\s-*$") | |
410 | (delete-region (point) (point-at-eol))) | |
411 | (when (not (eolp)) | |
412 | (princ "\n"))) | |
413 | ) | |
414 | (setq pm (point-marker)) | |
415 | (when (and (eq i t) inbuff (not (eq (oref sti where) 'end))) | |
416 | (indent-according-to-mode) | |
417 | (goto-char pm)) | |
418 | ))) | |
419 | ||
420 | (defclass srecode-template-inserter-comment (srecode-template-inserter) | |
421 | ((key :initform ?! | |
422 | :allocation :class | |
423 | :documentation | |
424 | "The character code used to identify inserters of this style.") | |
425 | ) | |
426 | "Allow comments within template coding. This inserts nothing.") | |
427 | ||
428 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment) | |
429 | escape-start escape-end) | |
430 | "Insert an example using inserter INS. | |
431 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
432 | (princ " ") | |
433 | (princ escape-start) | |
434 | (princ "! Miscellaneous text commenting in your template. ") | |
435 | (princ escape-end) | |
436 | (terpri) | |
437 | ) | |
438 | ||
439 | (defmethod srecode-insert-method ((sti srecode-template-inserter-comment) | |
440 | dictionary) | |
441 | "Don't insert anything for comment macros in STI." | |
442 | nil) | |
443 | ||
444 | ||
445 | (defclass srecode-template-inserter-variable (srecode-template-inserter) | |
446 | ((key :initform nil | |
447 | :allocation :class | |
448 | :documentation | |
449 | "The character code used to identify inserters of this style.")) | |
d1f18ec0 | 450 | "Insert the value of a dictionary entry. |
4d902e6f CY |
451 | If there is no entry, insert nothing.") |
452 | ||
453 | (defvar srecode-inserter-variable-current-dictionary nil | |
454 | "The active dictionary when calling a variable filter.") | |
455 | ||
456 | (defmethod srecode-insert-variable-secondname-handler | |
457 | ((sti srecode-template-inserter-variable) dictionary value secondname) | |
458 | "For VALUE handle SECONDNAME behaviors for this variable inserter. | |
459 | Return the result as a string. | |
460 | By default, treat as a function name. | |
461 | If SECONDNAME is nil, return VALUE." | |
462 | (if secondname | |
463 | (let ((fcnpart (read secondname))) | |
464 | (if (fboundp fcnpart) | |
465 | (let ((srecode-inserter-variable-current-dictionary dictionary)) | |
466 | (funcall fcnpart value)) | |
467 | ;; Else, warn. | |
62a81506 CY |
468 | (srecode-insert-report-error |
469 | dictionary | |
470 | "Variable inserter %s: second argument `%s' is not a function" | |
471 | (object-print sti) secondname))) | |
4d902e6f CY |
472 | value)) |
473 | ||
474 | (defmethod srecode-insert-method ((sti srecode-template-inserter-variable) | |
475 | dictionary) | |
476 | "Insert the STI inserter." | |
477 | ;; Convert the name into a name/fcn pair | |
478 | (let* ((name (oref sti :object-name)) | |
479 | (fcnpart (oref sti :secondname)) | |
480 | (val (srecode-dictionary-lookup-name | |
481 | dictionary name)) | |
482 | (do-princ t) | |
483 | ) | |
484 | ;; Alert if a macro wasn't found. | |
485 | (when (not val) | |
486 | (message "Warning: macro %S was not found in the dictionary." name) | |
487 | (setq val "")) | |
488 | ;; If there was a functional part, call that function. | |
489 | (cond ;; Strings | |
490 | ((stringp val) | |
491 | (setq val (srecode-insert-variable-secondname-handler | |
492 | sti dictionary val fcnpart))) | |
493 | ;; Compound data value | |
494 | ((srecode-dictionary-compound-value-child-p val) | |
495 | ;; Force FCN to be a symbol | |
496 | (when fcnpart (setq fcnpart (read fcnpart))) | |
497 | ;; Convert compound value to a string with the fcn. | |
498 | (setq val (srecode-compound-toString val fcnpart dictionary)) | |
499 | ;; If the value returned is nil, then it may be a special | |
500 | ;; field inserter that requires us to set do-princ to nil. | |
501 | (when (not val) | |
62a81506 CY |
502 | (setq do-princ nil))) |
503 | ||
4d902e6f CY |
504 | ;; Dictionaries... not allowed in this style |
505 | ((srecode-dictionary-child-p val) | |
62a81506 CY |
506 | (srecode-insert-report-error |
507 | dictionary | |
508 | "Macro %s cannot insert a dictionary - use section macros instead" | |
509 | name)) | |
510 | ||
4d902e6f CY |
511 | ;; Other stuff... convert |
512 | (t | |
62a81506 CY |
513 | (srecode-insert-report-error |
514 | dictionary | |
515 | "Macro %s cannot insert arbitrary data" name))) | |
4d902e6f | 516 | ;; Output the dumb thing unless the type of thing specifically |
b9749554 | 517 | ;; did the inserting for us. |
4d902e6f CY |
518 | (when do-princ |
519 | (princ val)))) | |
520 | ||
521 | (defclass srecode-template-inserter-ask (srecode-template-inserter-variable) | |
522 | ((key :initform ?? | |
523 | :allocation :class | |
524 | :documentation | |
525 | "The character code used to identify inserters of this style.") | |
526 | (prompt :initarg :prompt | |
527 | :initform nil | |
528 | :documentation | |
529 | "The prompt used to query for this dictionary value.") | |
530 | (defaultfcn :initarg :defaultfcn | |
531 | :initform nil | |
532 | :documentation | |
533 | "The function which can calculate a default value.") | |
534 | (read-fcn :initarg :read-fcn | |
535 | :initform 'read-string | |
536 | :documentation | |
537 | "The function used to read in the text for this prompt.") | |
538 | ) | |
d1f18ec0 | 539 | "Insert the value of a dictionary entry. |
4d902e6f CY |
540 | If there is no entry, prompt the user for the value to use. |
541 | The prompt text used is derived from the previous PROMPT command in the | |
542 | template file.") | |
543 | ||
b9749554 EL |
544 | (defmethod srecode-inserter-apply-state |
545 | ((ins srecode-template-inserter-ask) STATE) | |
4d902e6f CY |
546 | "For the template inserter INS, apply information from STATE. |
547 | Loop over the prompts to see if we have a match." | |
548 | (let ((prompts (oref STATE prompts)) | |
549 | ) | |
550 | (while prompts | |
551 | (when (string= (semantic-tag-name (car prompts)) | |
552 | (oref ins :object-name)) | |
553 | (oset ins :prompt | |
554 | (semantic-tag-get-attribute (car prompts) :text)) | |
555 | (oset ins :defaultfcn | |
556 | (semantic-tag-get-attribute (car prompts) :default)) | |
557 | (oset ins :read-fcn | |
558 | (or (semantic-tag-get-attribute (car prompts) :read) | |
559 | 'read-string)) | |
560 | ) | |
561 | (setq prompts (cdr prompts))) | |
562 | )) | |
563 | ||
564 | (defmethod srecode-insert-method ((sti srecode-template-inserter-ask) | |
565 | dictionary) | |
566 | "Insert the STI inserter." | |
567 | (let ((val (srecode-dictionary-lookup-name | |
568 | dictionary (oref sti :object-name)))) | |
569 | (if val | |
570 | ;; Does some extra work. Oh well. | |
571 | (call-next-method) | |
572 | ||
573 | ;; How is our -ask value determined? | |
574 | (if srecode-insert-with-fields-in-progress | |
575 | ;; Setup editable fields. | |
576 | (setq val (srecode-insert-method-field sti dictionary)) | |
577 | ;; Ask the question... | |
578 | (setq val (srecode-insert-method-ask sti dictionary))) | |
579 | ||
580 | ;; After asking, save in the dictionary so that | |
581 | ;; the user can use the same name again later. | |
582 | (srecode-dictionary-set-value | |
583 | (srecode-root-dictionary dictionary) | |
584 | (oref sti :object-name) val) | |
585 | ||
586 | ;; Now that this value is safely stowed in the dictionary, | |
587 | ;; we can do what regular inserters do. | |
588 | (call-next-method)))) | |
589 | ||
590 | (defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask) | |
591 | dictionary) | |
592 | "Derive the default value for an askable inserter STI. | |
593 | DICTIONARY is used to derive some values." | |
594 | (let ((defaultfcn (oref sti :defaultfcn))) | |
62a81506 CY |
595 | (cond |
596 | ((stringp defaultfcn) | |
597 | defaultfcn) | |
598 | ||
599 | ((functionp defaultfcn) | |
600 | (funcall defaultfcn)) | |
601 | ||
602 | ((and (listp defaultfcn) | |
603 | (eq (car defaultfcn) 'macro)) | |
604 | (srecode-dictionary-lookup-name | |
605 | dictionary (cdr defaultfcn))) | |
606 | ||
607 | ((null defaultfcn) | |
608 | "") | |
609 | ||
610 | (t | |
611 | (srecode-insert-report-error | |
612 | dictionary | |
613 | "Unknown default for prompt: %S" defaultfcn))))) | |
4d902e6f CY |
614 | |
615 | (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask) | |
616 | dictionary) | |
617 | "Do the \"asking\" for the template inserter STI. | |
618 | Use DICTIONARY to resolve values." | |
619 | (let* ((prompt (oref sti prompt)) | |
620 | (default (srecode-insert-ask-default sti dictionary)) | |
621 | (reader (oref sti :read-fcn)) | |
622 | (val nil) | |
623 | ) | |
624 | (cond ((eq reader 'y-or-n-p) | |
625 | (if (y-or-n-p (or prompt | |
626 | (format "%s? " | |
627 | (oref sti :object-name)))) | |
628 | (setq val default) | |
629 | (setq val ""))) | |
630 | ((eq reader 'read-char) | |
631 | (setq val (format | |
632 | "%c" | |
633 | (read-char (or prompt | |
634 | (format "Char for %s: " | |
635 | (oref sti :object-name)))))) | |
636 | ) | |
637 | (t | |
638 | (save-excursion | |
639 | (setq val (funcall reader | |
640 | (or prompt | |
641 | (format "Specify %s: " | |
642 | (oref sti :object-name))) | |
643 | default | |
644 | ))))) | |
645 | ;; Return our derived value. | |
646 | val) | |
647 | ) | |
648 | ||
649 | (defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask) | |
650 | dictionary) | |
651 | "Create an editable field for the template inserter STI. | |
652 | Use DICTIONARY to resolve values." | |
653 | (let* ((default (srecode-insert-ask-default sti dictionary)) | |
654 | (compound-value | |
655 | (srecode-field-value (oref sti :object-name) | |
656 | :firstinserter sti | |
657 | :defaultvalue default)) | |
658 | ) | |
659 | ;; Return this special compound value as the thing to insert. | |
660 | ;; This special compound value will repeat our asked question | |
661 | ;; across multiple locations. | |
662 | compound-value)) | |
663 | ||
664 | (defmethod srecode-dump ((ins srecode-template-inserter-ask) indent) | |
665 | "Dump the state of the SRecode template inserter INS." | |
666 | (call-next-method) | |
667 | (princ " : \"") | |
668 | (princ (oref ins prompt)) | |
669 | (princ "\"") | |
670 | ) | |
671 | ||
672 | (defclass srecode-template-inserter-width (srecode-template-inserter-variable) | |
673 | ((key :initform ?| | |
674 | :allocation :class | |
675 | :documentation | |
676 | "The character code used to identify inserters of this style.") | |
677 | ) | |
678 | "Inserts the value of a dictionary variable with a specific width. | |
d1f18ec0 JB |
679 | The second argument specifies the width, and a pad, separated by a colon. |
680 | Thus a specification of `10:left' will insert the value of A | |
4d902e6f CY |
681 | to 10 characters, with spaces added to the left. Use `right' for adding |
682 | spaces to the right.") | |
683 | ||
684 | (defmethod srecode-insert-variable-secondname-handler | |
685 | ((sti srecode-template-inserter-width) dictionary value width) | |
686 | "For VALUE handle WIDTH behaviors for this variable inserter. | |
687 | Return the result as a string. | |
688 | By default, treat as a function name." | |
62a81506 CY |
689 | ;; Cannot work without width. |
690 | (unless width | |
691 | (srecode-insert-report-error | |
692 | dictionary | |
693 | "Width not specified for variable/width inserter")) | |
694 | ||
695 | ;; Trim or pad to new length | |
696 | (let* ((split (split-string width ":")) | |
697 | (width (string-to-number (nth 0 split))) | |
698 | (second (nth 1 split)) | |
699 | (pad (cond | |
700 | ((or (null second) (string= "right" second)) | |
701 | 'right) | |
702 | ((string= "left" second) | |
703 | 'left) | |
704 | (t | |
705 | (srecode-insert-report-error | |
706 | dictionary | |
707 | "Unknown pad type %s" second))))) | |
708 | (if (>= (length value) width) | |
709 | ;; Simple case - too long. | |
710 | (substring value 0 width) | |
711 | ;; We need to pad on one side or the other. | |
712 | (let ((padchars (make-string (- width (length value)) ? ))) | |
713 | (if (eq pad 'left) | |
714 | (concat padchars value) | |
715 | (concat value padchars)))))) | |
4d902e6f CY |
716 | |
717 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width) | |
718 | escape-start escape-end) | |
719 | "Insert an example using inserter INS. | |
720 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
721 | (princ " ") | |
722 | (princ escape-start) | |
723 | (princ "|A:10:right") | |
724 | (princ escape-end) | |
725 | (terpri) | |
726 | ) | |
727 | ||
728 | (defvar srecode-template-inserter-point-override nil | |
b9749554 EL |
729 | "Point-positioning method for the SRecode template inserter. |
730 | When nil, perform normal point-positioning behavior. | |
731 | When the value is a cons cell (DEPTH . FUNCTION), call FUNCTION | |
732 | instead, unless the template nesting depth, measured | |
733 | by (length (oref srecode-template active)), is greater than | |
734 | DEPTH.") | |
735 | ||
4d902e6f CY |
736 | |
737 | (defclass srecode-template-inserter-point (srecode-template-inserter) | |
738 | ((key :initform ?^ | |
739 | :allocation :class | |
740 | :documentation | |
741 | "The character code used to identify inserters of this style.") | |
742 | (point :type (or null marker) | |
743 | :allocation :class | |
744 | :documentation | |
745 | "Record the value of (point) in this class slot. | |
746 | It is the responsibility of the inserter algorithm to clear this | |
747 | after a successful insertion.")) | |
748 | "Record the value of (point) when inserted. | |
749 | The cursor is placed at the ^ macro after insertion. | |
750 | Some inserter macros, such as `srecode-template-inserter-include-wrap' | |
751 | will place text at the ^ macro from the included macro.") | |
752 | ||
753 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point) | |
754 | escape-start escape-end) | |
755 | "Insert an example using inserter INS. | |
756 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
757 | (princ " ") | |
758 | (princ escape-start) | |
759 | (princ "^") | |
760 | (princ escape-end) | |
761 | (terpri) | |
762 | ) | |
763 | ||
764 | (defmethod srecode-insert-method ((sti srecode-template-inserter-point) | |
765 | dictionary) | |
766 | "Insert the STI inserter. | |
767 | Save point in the class allocated 'point' slot. | |
b9749554 EL |
768 | If `srecode-template-inserter-point-override' non-nil then this |
769 | generalized marker will do something else. See | |
770 | `srecode-template-inserter-include-wrap' as an example." | |
771 | ;; If `srecode-template-inserter-point-override' is non-nil, its car | |
772 | ;; is the maximum template nesting depth for which the override is | |
773 | ;; valid. Compare this to the actual template nesting depth and | |
774 | ;; maybe use the override function which is stored in the cdr. | |
775 | (if (and srecode-template-inserter-point-override | |
776 | (<= (length (oref srecode-template active)) | |
777 | (car srecode-template-inserter-point-override))) | |
4d902e6f | 778 | ;; Disable the old override while we do this. |
b9749554 | 779 | (let ((over (cdr srecode-template-inserter-point-override)) |
4d902e6f | 780 | (srecode-template-inserter-point-override nil)) |
b9749554 | 781 | (funcall over dictionary)) |
4d902e6f CY |
782 | (oset sti point (point-marker)) |
783 | )) | |
784 | ||
785 | (defclass srecode-template-inserter-subtemplate (srecode-template-inserter) | |
786 | () | |
787 | "Wrap a section of a template under the control of a macro." | |
788 | :abstract t) | |
789 | ||
790 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate) | |
791 | escape-start escape-end) | |
792 | "Insert an example using inserter INS. | |
793 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
794 | (call-next-method) | |
795 | (princ " Template Text to control") | |
796 | (terpri) | |
797 | (princ " ") | |
798 | (princ escape-start) | |
799 | (princ "/VARNAME") | |
800 | (princ escape-end) | |
801 | (terpri) | |
802 | ) | |
803 | ||
804 | (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate) | |
805 | dict slot) | |
806 | "Insert a subtemplate for the inserter STI with dictionary DICT." | |
62a81506 CY |
807 | ;; Make sure that only dictionaries are used. |
808 | (unless (srecode-dictionary-child-p dict) | |
809 | (srecode-insert-report-error | |
810 | dict | |
811 | "Only section dictionaries allowed for `%s'" | |
e8cc7880 | 812 | (eieio-object-name-string sti))) |
62a81506 | 813 | |
4d902e6f | 814 | ;; Output the code from the sub-template. |
62a81506 | 815 | (srecode-insert-method (slot-value sti slot) dict)) |
4d902e6f CY |
816 | |
817 | (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate) | |
818 | dictionary slot) | |
819 | "Do the work for inserting the STI inserter. | |
820 | Loops over the embedded CODE which was saved here during compilation. | |
821 | The template to insert is stored in SLOT." | |
822 | (let ((dicts (srecode-dictionary-lookup-name | |
823 | dictionary (oref sti :object-name)))) | |
b9749554 | 824 | (when (not (listp dicts)) |
62a81506 CY |
825 | (srecode-insert-report-error |
826 | dictionary | |
827 | "Cannot insert section %S from non-section variable." | |
828 | (oref sti :object-name))) | |
4d902e6f CY |
829 | ;; If there is no section dictionary, then don't output anything |
830 | ;; from this section. | |
831 | (while dicts | |
b9749554 | 832 | (when (not (srecode-dictionary-p (car dicts))) |
62a81506 CY |
833 | (srecode-insert-report-error |
834 | dictionary | |
835 | "Cannot insert section %S from non-section variable." | |
836 | (oref sti :object-name))) | |
4d902e6f CY |
837 | (srecode-insert-subtemplate sti (car dicts) slot) |
838 | (setq dicts (cdr dicts))))) | |
839 | ||
840 | (defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate) | |
841 | dictionary) | |
842 | "Insert the STI inserter. | |
843 | Calls back to `srecode-insert-method-helper' for this class." | |
844 | (srecode-insert-method-helper sti dictionary 'template)) | |
845 | ||
846 | ||
847 | (defclass srecode-template-inserter-section-start (srecode-template-inserter-subtemplate) | |
848 | ((key :initform ?# | |
849 | :allocation :class | |
850 | :documentation | |
851 | "The character code used to identify inserters of this style.") | |
852 | (template :initarg :template | |
853 | :documentation | |
d1f18ec0 | 854 | "A template used to frame the codes from this inserter.") |
4d902e6f CY |
855 | ) |
856 | "Apply values from a sub-dictionary to a template section. | |
857 | The dictionary saved at the named dictionary entry will be | |
858 | applied to the text between the section start and the | |
859 | `srecode-template-inserter-section-end' macro.") | |
860 | ||
861 | (defmethod srecode-parse-input ((ins srecode-template-inserter-section-start) | |
862 | tag input STATE) | |
863 | "For the section inserter INS, parse INPUT. | |
864 | Shorten input until the END token is found. | |
865 | Return the remains of INPUT." | |
866 | (let* ((out (srecode-compile-split-code tag input STATE | |
867 | (oref ins :object-name)))) | |
868 | (oset ins template (srecode-template | |
e8cc7880 | 869 | (eieio-object-name-string ins) |
4d902e6f CY |
870 | :context nil |
871 | :args nil | |
872 | :code (cdr out))) | |
873 | (car out))) | |
874 | ||
875 | (defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent) | |
876 | "Dump the state of the SRecode template inserter INS." | |
877 | (call-next-method) | |
878 | (princ "\n") | |
879 | (srecode-dump-code-list (oref (oref ins template) code) | |
880 | (concat indent " ")) | |
881 | ) | |
882 | ||
883 | (defclass srecode-template-inserter-section-end (srecode-template-inserter) | |
884 | ((key :initform ?/ | |
885 | :allocation :class | |
886 | :documentation | |
887 | "The character code used to identify inserters of this style.") | |
888 | ) | |
d1f18ec0 | 889 | "All template segments between the section-start and section-end |
4d902e6f CY |
890 | are treated specially.") |
891 | ||
892 | (defmethod srecode-insert-method ((sti srecode-template-inserter-section-end) | |
893 | dictionary) | |
894 | "Insert the STI inserter." | |
895 | ) | |
896 | ||
897 | (defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name) | |
898 | ||
899 | "For the template inserter INS, do I end a section called NAME?" | |
900 | (string= name (oref ins :object-name))) | |
901 | ||
902 | (defclass srecode-template-inserter-include (srecode-template-inserter-subtemplate) | |
903 | ((key :initform ?> | |
904 | :allocation :class | |
905 | :documentation | |
906 | "The character code used to identify inserters of this style.") | |
907 | (includedtemplate | |
908 | :initarg :includedtemplate | |
909 | :documentation | |
910 | "The template included for this inserter.")) | |
911 | "Include a different template into this one. | |
912 | The included template will have additional dictionary entries from the subdictionary | |
913 | stored specified by this macro.") | |
914 | ||
915 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include) | |
916 | escape-start escape-end) | |
917 | "Insert an example using inserter INS. | |
918 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
919 | (princ " ") | |
920 | (princ escape-start) | |
921 | (princ ">DICTNAME:contextname:templatename") | |
922 | (princ escape-end) | |
923 | (terpri) | |
924 | ) | |
925 | ||
926 | (defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include) | |
927 | dictionary) | |
928 | "For the template inserter STI, lookup the template to include. | |
929 | Finds the template with this macro function part and stores it in | |
930 | this template instance." | |
62a81506 CY |
931 | (let ((templatenamepart (oref sti :secondname))) |
932 | ;; If there was no template name, throw an error. | |
933 | (unless templatenamepart | |
934 | (srecode-insert-report-error | |
935 | dictionary | |
936 | "Include macro `%s' needs a template name" | |
937 | (oref sti :object-name))) | |
b9749554 EL |
938 | |
939 | ;; NOTE: We used to cache the template and not look it up a second time, | |
940 | ;; but changes in the template tables can change which template is | |
941 | ;; eventually discovered, so now we always lookup that template. | |
942 | ||
943 | ;; Calculate and store the discovered template | |
944 | (let ((tmpl (srecode-template-get-table (srecode-table) | |
945 | templatenamepart)) | |
946 | (active (oref srecode-template active)) | |
947 | ctxt) | |
948 | (when (not tmpl) | |
949 | ;; If it isn't just available, scan back through | |
950 | ;; the active template stack, searching for a matching | |
951 | ;; context. | |
952 | (while (and (not tmpl) active) | |
953 | (setq ctxt (oref (car active) context)) | |
954 | (setq tmpl (srecode-template-get-table (srecode-table) | |
955 | templatenamepart | |
956 | ctxt)) | |
4d902e6f | 957 | (when (not tmpl) |
b9749554 EL |
958 | (when (slot-boundp (car active) 'table) |
959 | (let ((app (oref (oref (car active) table) application))) | |
960 | (when app | |
961 | (setq tmpl (srecode-template-get-table | |
962 | (srecode-table) | |
963 | templatenamepart | |
964 | ctxt app))) | |
965 | ))) | |
966 | (setq active (cdr active))) | |
967 | (when (not tmpl) | |
968 | ;; If it wasn't in this context, look to see if it | |
07a79ce4 | 969 | ;; defines its own context |
b9749554 EL |
970 | (setq tmpl (srecode-template-get-table (srecode-table) |
971 | templatenamepart))) | |
972 | ) | |
973 | ||
974 | ;; Store the found template into this object for later use. | |
975 | (oset sti :includedtemplate tmpl)) | |
4d902e6f | 976 | |
62a81506 CY |
977 | (unless (oref sti includedtemplate) |
978 | ;; @todo - Call into a debugger to help find the template in question. | |
979 | (srecode-insert-report-error | |
980 | dictionary | |
981 | "No template \"%s\" found for include macro `%s'" | |
982 | templatenamepart (oref sti :object-name))))) | |
4d902e6f CY |
983 | |
984 | (defmethod srecode-insert-method ((sti srecode-template-inserter-include) | |
985 | dictionary) | |
986 | "Insert the STI inserter. | |
987 | Finds the template with this macro function part, and inserts it | |
d1f18ec0 | 988 | with the dictionaries found in the dictionary." |
4d902e6f CY |
989 | (srecode-insert-include-lookup sti dictionary) |
990 | ;; Insert the template. | |
991 | ;; Our baseclass has a simple way to do this. | |
992 | (if (srecode-dictionary-lookup-name dictionary (oref sti :object-name)) | |
993 | ;; If we have a value, then call the next method | |
994 | (srecode-insert-method-helper sti dictionary 'includedtemplate) | |
4c36be58 | 995 | ;; If we don't have a special dictionary, then just insert with the |
4d902e6f CY |
996 | ;; current dictionary. |
997 | (srecode-insert-subtemplate sti dictionary 'includedtemplate)) | |
998 | ) | |
999 | ||
1000 | ;; | |
1001 | ;; This template combines the include template and the sectional template. | |
1002 | ;; It will first insert the included template, then insert the embedded | |
1003 | ;; template wherever the $^$ in the included template was. | |
1004 | ;; | |
53964682 | 1005 | ;; Since it uses dual inheritance, it will magically get the end-matching |
4d902e6f CY |
1006 | ;; behavior of #, with the including feature of >. |
1007 | ;; | |
1008 | (defclass srecode-template-inserter-include-wrap (srecode-template-inserter-include srecode-template-inserter-section-start) | |
1009 | ((key :initform ?< | |
1010 | :allocation :class | |
1011 | :documentation | |
1012 | "The character code used to identify inserters of this style.") | |
1013 | ) | |
1014 | "Include a different template into this one, and add text at the ^ macro. | |
1015 | The included template will have additional dictionary entries from the subdictionary | |
1016 | stored specified by this macro. If the included macro includes a ^ macro, | |
1017 | then the text between this macro and the end macro will be inserted at | |
1018 | the ^ macro.") | |
1019 | ||
1020 | (defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap) | |
1021 | escape-start escape-end) | |
1022 | "Insert an example using inserter INS. | |
1023 | Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use." | |
1024 | (princ " ") | |
1025 | (princ escape-start) | |
1026 | (princ "<DICTNAME:contextname:templatename") | |
1027 | (princ escape-end) | |
1028 | (terpri) | |
1029 | (princ " Template Text to insert at ^ macro") | |
1030 | (terpri) | |
1031 | (princ " ") | |
1032 | (princ escape-start) | |
1033 | (princ "/DICTNAME") | |
1034 | (princ escape-end) | |
1035 | (terpri) | |
1036 | ) | |
1037 | ||
1038 | (defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap) | |
1039 | dictionary) | |
1040 | "Insert the template STI. | |
1041 | This will first insert the include part via inheritance, then | |
1042 | insert the section it wraps into the location in the included | |
d1f18ec0 | 1043 | template where a ^ inserter occurs." |
4d902e6f CY |
1044 | ;; Step 1: Look up the included inserter |
1045 | (srecode-insert-include-lookup sti dictionary) | |
b9749554 EL |
1046 | ;; Step 2: Temporarily override the point inserter. |
1047 | ;; We bind `srecode-template-inserter-point-override' to a cons cell | |
1048 | ;; (DEPTH . FUNCTION) that has the maximum template nesting depth, | |
1049 | ;; for which the override is valid, in DEPTH and a lambda function | |
1050 | ;; which implements the wrap insertion behavior in FUNCTION. The | |
1051 | ;; maximum valid nesting depth is just the current depth + 1. | |
1052 | (let ((srecode-template-inserter-point-override | |
1053 | (lexical-let ((inserter1 sti)) | |
1054 | (cons | |
1055 | ;; DEPTH | |
1056 | (+ (length (oref srecode-template active)) 1) | |
1057 | ;; FUNCTION | |
1058 | (lambda (dict) | |
1059 | (let ((srecode-template-inserter-point-override nil)) | |
1060 | (if (srecode-dictionary-lookup-name | |
1061 | dict (oref inserter1 :object-name)) | |
1062 | ;; Insert our sectional part with looping. | |
1063 | (srecode-insert-method-helper | |
1064 | inserter1 dict 'template) | |
1065 | ;; Insert our sectional part just once. | |
1066 | (srecode-insert-subtemplate | |
1067 | inserter1 dict 'template)))))))) | |
4d902e6f CY |
1068 | ;; Do a regular insertion for an include, but with our override in |
1069 | ;; place. | |
b9749554 | 1070 | (call-next-method))) |
4d902e6f CY |
1071 | |
1072 | (provide 'srecode/insert) | |
1073 | ||
1074 | ;; Local variables: | |
1075 | ;; generated-autoload-file: "loaddefs.el" | |
4d902e6f CY |
1076 | ;; generated-autoload-load-name: "srecode/insert" |
1077 | ;; End: | |
1078 | ||
1079 | ;;; srecode/insert.el ends here |