1 ;;; srecode/insert --- Insert srecode templates to an output stream.
3 ;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Define and implements specific inserter objects.
26 ;; Manage the insertion process for a template.
30 (require 'cl
)) ;; for `lexical-let'
32 (require 'srecode
/compile
)
33 (require 'srecode
/find
)
34 (require 'srecode
/dictionary
)
35 (require 'srecode
/args
)
37 (defvar srecode-template-inserter-point
)
38 (declare-function srecode-overlaid-activate
"srecode/fields")
39 (declare-function srecode-template-inserted-region
"srecode/fields")
43 (defcustom srecode-insert-ask-variable-method
'ask
44 "Determine how to ask for a dictionary value when inserting a template.
45 Only the ASK style inserter will query the user for a value.
46 Dictionary value references that ask begin with the ? character.
48 'ask - Prompt in the minibuffer as the value is inserted.
49 'field - Use the dictionary macro name as the inserted value,
50 and place a field there. Matched fields change together.
52 NOTE: The field feature does not yet work with XEmacs."
54 :type
'(choice (const :tag
"Ask" ask
)
55 (const :tag
"Field" field
)))
57 (defvar srecode-insert-with-fields-in-progress nil
58 "Non-nil means that we are actively inserting a template with fields.")
60 ;;; INSERTION COMMANDS
62 ;; User level commands for inserting stuff.
63 (defvar srecode-insertion-start-context nil
64 "The context that was at point at the beginning of the template insertion.")
66 (defun srecode-insert-again ()
67 "Insert the previously inserted template (by name) again."
69 (let ((prev (car srecode-read-template-name-history
)))
72 (call-interactively 'srecode-insert
))))
75 (defun srecode-insert (template-name &rest dict-entries
)
76 "Insert the template TEMPLATE-NAME into the current buffer at point.
77 DICT-ENTRIES are additional dictionary values to add."
78 (interactive (list (srecode-read-template-name "Template Name: ")))
79 (if (not (srecode-table))
80 (error "No template table found for mode %s" major-mode
))
81 (let ((newdict (srecode-create-dictionary))
82 (temp (srecode-template-get-table (srecode-table) template-name
))
83 (srecode-insertion-start-context (srecode-calculate-context))
86 (error "No Template named %s" template-name
))
88 (srecode-dictionary-set-value newdict
90 (car (cdr dict-entries
)))
91 (setq dict-entries
(cdr (cdr dict-entries
))))
92 (srecode-insert-fcn temp newdict
)
93 ;; Don't put code here. We need to return the end-mark
94 ;; for this insertion step.
97 (defun srecode-insert-fcn (template dictionary
&optional stream skipresolver
)
98 "Insert TEMPLATE using DICTIONARY into STREAM.
99 Optional SKIPRESOLVER means to avoid refreshing the tag list,
100 or resolving any template arguments. It is assumed the caller
101 has set everything up already."
102 ;; Perform the insertion.
103 (let ((standard-output (or stream
(current-buffer)))
105 ;; Merge any template entries into the input dictionary.
106 (when (slot-boundp template
'dictionary
)
107 (srecode-dictionary-merge dictionary
(oref template dictionary
)))
110 ;; Make sure the semantic tags are up to date.
111 (semantic-fetch-tags)
112 ;; Resolve the arguments
113 (srecode-resolve-arguments template dictionary
))
115 (if (bufferp standard-output
)
116 ;; If there is a buffer, turn off various hooks. This will cause
117 ;; the mod hooks to be buffered up during the insert, but
118 ;; prevent tools like font-lock from fontifying mid-template.
119 ;; Especially important during insertion of complex comments that
120 ;; cause the new font-lock to comment-color stuff after the inserted
123 ;; I'm not sure about the motion hooks. It seems like a good
126 ;; Borrowed these concepts out of font-lock.
128 ;; I tried `combine-after-change-calls', but it did not have
129 ;; the effect I wanted.
130 (let ((start (point)))
131 (let ((inhibit-point-motion-hooks t
)
132 (inhibit-modification-hooks t
)
134 (srecode--insert-into-buffer template dictionary
)
136 ;; Now call those after change functions.
137 (run-hook-with-args 'after-change-functions
140 (srecode-insert-method template dictionary
))
141 ;; Handle specialization of the POINT inserter.
142 (when (and (bufferp standard-output
)
143 (slot-boundp 'srecode-template-inserter-point
'point
)
145 (set-buffer standard-output
)
146 (setq end-mark
(point-marker))
147 (goto-char (oref srecode-template-inserter-point point
)))
148 (oset-default 'srecode-template-inserter-point point eieio-unbound
)
150 ;; Return the end-mark.
151 (or end-mark
(point)))
154 (defun srecode--insert-into-buffer (template dictionary
)
155 "Insert a TEMPLATE with DICTIONARY into a buffer.
156 Do not call this function yourself. Instead use:
157 `srecode-insert' - Inserts by name.
158 `srecode-insert-fcn' - Insert with objects.
159 This function handles the case from one of the above functions when
160 the template is inserted into a buffer. It looks
161 at `srecode-insert-ask-variable-method' to decide if unbound dictionary
162 entries ask questions or insert editable fields.
164 Buffer based features related to change hooks is handled one level up."
165 ;; This line prevents the field archive from being let bound
166 ;; while the field insert tool is loaded via autoloads during
168 (when (eq srecode-insert-ask-variable-method
'field
)
169 (require 'srecode
/fields
))
171 (let ((srecode-field-archive nil
) ; Prevent field leaks during insert
172 (start (point)) ; Beginning of the region.
174 ;; This sub-let scopes the 'in-progress' piece so we know
175 ;; when to setup the end-template.
176 (let ((srecode-insert-with-fields-in-progress
177 (if (eq srecode-insert-ask-variable-method
'field
) t nil
))
179 (srecode-insert-method template dictionary
)
181 ;; If we are not in-progress, and we insert fields, then
182 ;; create the end-template with fields editable area.
183 (when (and (not srecode-insert-with-fields-in-progress
)
184 (eq srecode-insert-ask-variable-method
'field
) ; Only if user asked
185 srecode-field-archive
; Only if there were fields created
188 ;; Create the field-driven editable area.
189 (srecode-template-inserted-region
190 "TEMPLATE" :start start
:end
(point))))
191 (srecode-overlaid-activate reg
))
193 ;; We return with 'point being the end of the template insertion
194 ;; area. Return value is not important.
197 ;;; TEMPLATE ARGUMENTS
199 ;; Some templates have arguments. Each argument is associated with
200 ;; a function that can resolve the inputs needed.
201 (defun srecode-resolve-arguments (temp dict
)
202 "Resolve all the arguments needed by the template TEMP.
203 Apply anything learned to the dictionary DICT."
204 (srecode-resolve-argument-list (oref temp args
) dict temp
))
206 (defun srecode-resolve-argument-list (args dict
&optional temp
)
207 "Resolve arguments in the argument list ARGS.
208 ARGS is a list of symbols, such as :blank, or :file.
209 Apply values to DICT.
210 Optional argument TEMP is the template that is getting its arguments resolved."
213 (setq fcn
(intern-soft (concat "srecode-semantic-handle-"
214 (symbol-name (car args
)))))
216 (error "Error resolving template argument %S" (car args
)))
219 ;; Allow some to accept a 2nd argument optionally.
220 ;; They throw an error if not available, so try again.
221 (funcall fcn dict temp
)
222 (wrong-number-of-arguments (funcall fcn dict
)))
224 (setq args
(cdr args
)))
227 ;;; INSERTION STACK & METHOD
229 ;; Code managing the top-level insert method and the current
232 (defmethod srecode-push ((st srecode-template
))
233 "Push the srecoder template ST onto the active stack."
234 (oset st active
(cons st
(oref st active
))))
236 (defmethod srecode-pop :STATIC
((st srecode-template
))
237 "Pop the srecoder template ST onto the active stack.
238 ST can be a class, or an object."
239 (oset st active
(cdr (oref st active
))))
241 (defmethod srecode-peek :STATIC
((st srecode-template
))
242 "Fetch the topmost active template record. ST can be a class."
243 (car (oref st active
)))
245 (defmethod srecode-insert-method ((st srecode-template
) dictionary
)
246 "Insert the srecoder template ST."
247 ;; Merge any template entries into the input dictionary.
248 ;; This may happen twice since some templates arguments need
249 ;; these dictionary values earlier, but these values always
250 ;; need merging for template inserting in other templates.
251 (when (slot-boundp st
'dictionary
)
252 (srecode-dictionary-merge dictionary
(oref st dictionary
)))
255 (let ((c (oref st code
)))
257 (srecode-insert-code-stream c dictionary
))
258 ;; Poping the stack is protected
261 (defun srecode-insert-code-stream (code dictionary
)
262 "Insert the CODE from a template into `standard-output'.
263 Use DICTIONARY to resolve any macros."
265 (cond ((stringp (car code
))
268 (srecode-insert-method (car code
) dictionary
)))
269 (setq code
(cdr code
))))
273 ;; Specific srecode inserters.
274 ;; The base class is from srecode-compile.
276 ;; Each inserter handles various macro codes from the template.
277 ;; The `code' slot specifies a character used to identify which
278 ;; inserter is to be created.
280 (defclass srecode-template-inserter-newline
(srecode-template-inserter)
284 "The character code used to identify inserters of this style.")
288 "Is this a hard newline (always inserted) or optional?
289 Optional newlines don't insert themselves if they are on a blank line
292 "Insert a newline, and possibly do indenting.
293 Specify the :indent argument to enable automatic indentation when newlines
294 occur in your template.")
296 (defmethod srecode-insert-method ((sti srecode-template-inserter-newline
)
298 "Insert the STI inserter."
299 ;; To be safe, indent the previous line since the template will
300 ;; change what is there to indent
301 (let ((i (srecode-dictionary-lookup-name dictionary
"INDENT"))
302 (inbuff (bufferp standard-output
))
305 (when (and inbuff
(not (oref sti hard
)))
306 ;; If this is not a hard newline, we need do the calculation
307 ;; and set "doit" to nil.
310 (narrow-to-region (point) pm
)
311 (when (looking-at "\\s-*$")
315 ;; Do indentation reguardless of the newline.
316 (when (and (eq i t
) inbuff
)
317 (indent-according-to-mode)
322 ;; Indent after the newline, particularly for numeric indents.
323 (cond ((and (eq i t
) (bufferp standard-output
))
324 ;; WARNING - indent according to mode requires that standard-output
326 ;; @todo - how to indent in a string???
327 (setq pm
(point-marker))
328 (indent-according-to-mode)
331 (princ (make-string i
" ")))
335 (defmethod srecode-dump ((ins srecode-template-inserter-newline
) indent
)
336 "Dump the state of the SRecode template inserter INS."
338 (when (oref ins hard
)
342 (defclass srecode-template-inserter-blank
(srecode-template-inserter)
346 "The character representing this inserter style.
347 Can't be blank, or it might be used by regular variable insertion.")
348 (where :initform
'begin
351 "This should be 'begin or 'end, indicating where to insert a CR.
352 When set to 'begin, it will insert a CR if we are not at 'bol'.
353 When set to 'end it will insert a CR if we are not at 'eol'.")
354 ;; @TODO - Add slot and control for the number of blank
355 ;; lines before and after point.
357 "Insert a newline before and after a template, and possibly do indenting.
358 Specify the :blank argument to enable this inserter.")
360 (defmethod srecode-insert-method ((sti srecode-template-inserter-blank
)
362 "Make sure there is no text before or after point."
363 (let ((i (srecode-dictionary-lookup-name dictionary
"INDENT"))
364 (inbuff (bufferp standard-output
))
367 ;; Don't do this if we are not the active template.
368 (= (length (oref srecode-template active
)) 1))
370 (when (and (eq i t
) inbuff
(not (eq (oref sti where
) 'begin
)))
371 (indent-according-to-mode)
374 (cond ((and (eq (oref sti where
) 'begin
) (not (bolp)))
376 ((eq (oref sti where
) 'end
)
377 ;; If there is whitespace after pnt, then clear it out.
378 (when (looking-at "\\s-*$")
379 (delete-region (point) (point-at-eol)))
383 (setq pm
(point-marker))
384 (when (and (eq i t
) inbuff
(not (eq (oref sti where
) 'end
)))
385 (indent-according-to-mode)
389 (defclass srecode-template-inserter-comment
(srecode-template-inserter)
393 "The character code used to identify inserters of this style.")
395 "Allow comments within template coding. This inserts nothing.")
397 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-comment
)
398 escape-start escape-end
)
399 "Insert an example using inserter INS.
400 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
403 (princ "! Miscellaneous text commenting in your template. ")
408 (defmethod srecode-insert-method ((sti srecode-template-inserter-comment
)
410 "Don't insert anything for comment macros in STI."
414 (defclass srecode-template-inserter-variable
(srecode-template-inserter)
418 "The character code used to identify inserters of this style."))
419 "Insert the value of a dictionary entry.
420 If there is no entry, insert nothing.")
422 (defvar srecode-inserter-variable-current-dictionary nil
423 "The active dictionary when calling a variable filter.")
425 (defmethod srecode-insert-variable-secondname-handler
426 ((sti srecode-template-inserter-variable
) dictionary value secondname
)
427 "For VALUE handle SECONDNAME behaviors for this variable inserter.
428 Return the result as a string.
429 By default, treat as a function name.
430 If SECONDNAME is nil, return VALUE."
432 (let ((fcnpart (read secondname
)))
433 (if (fboundp fcnpart
)
434 (let ((srecode-inserter-variable-current-dictionary dictionary
))
435 (funcall fcnpart value
))
437 (error "Variable insertion second arg %s is not a function"
441 (defmethod srecode-insert-method ((sti srecode-template-inserter-variable
)
443 "Insert the STI inserter."
444 ;; Convert the name into a name/fcn pair
445 (let* ((name (oref sti
:object-name
))
446 (fcnpart (oref sti
:secondname
))
447 (val (srecode-dictionary-lookup-name
451 ;; Alert if a macro wasn't found.
453 (message "Warning: macro %S was not found in the dictionary." name
)
455 ;; If there was a functional part, call that function.
458 (setq val
(srecode-insert-variable-secondname-handler
459 sti dictionary val fcnpart
)))
460 ;; Compound data value
461 ((srecode-dictionary-compound-value-child-p val
)
462 ;; Force FCN to be a symbol
463 (when fcnpart
(setq fcnpart
(read fcnpart
)))
464 ;; Convert compound value to a string with the fcn.
465 (setq val
(srecode-compound-toString val fcnpart dictionary
))
466 ;; If the value returned is nil, then it may be a special
467 ;; field inserter that requires us to set do-princ to nil.
472 ;; Dictionaries... not allowed in this style
473 ((srecode-dictionary-child-p val
)
474 (error "Macro %s cannot insert a dictionary - use section macros instead"
476 ;; Other stuff... convert
478 (error "Macro %s cannot insert arbitrary data" name
)
479 ;;(if (and val (not (stringp val)))
480 ;; (setq val (format "%S" val))))
482 ;; Output the dumb thing unless the type of thing specifically
483 ;; did the inserting for us.
487 (defclass srecode-template-inserter-ask
(srecode-template-inserter-variable)
491 "The character code used to identify inserters of this style.")
492 (prompt :initarg
:prompt
495 "The prompt used to query for this dictionary value.")
496 (defaultfcn :initarg
:defaultfcn
499 "The function which can calculate a default value.")
500 (read-fcn :initarg
:read-fcn
501 :initform
'read-string
503 "The function used to read in the text for this prompt.")
505 "Insert the value of a dictionary entry.
506 If there is no entry, prompt the user for the value to use.
507 The prompt text used is derived from the previous PROMPT command in the
510 (defmethod srecode-inserter-apply-state
511 ((ins srecode-template-inserter-ask
) STATE
)
512 "For the template inserter INS, apply information from STATE.
513 Loop over the prompts to see if we have a match."
514 (let ((prompts (oref STATE prompts
))
517 (when (string= (semantic-tag-name (car prompts
))
518 (oref ins
:object-name
))
520 (semantic-tag-get-attribute (car prompts
) :text
))
521 (oset ins
:defaultfcn
522 (semantic-tag-get-attribute (car prompts
) :default
))
524 (or (semantic-tag-get-attribute (car prompts
) :read
)
527 (setq prompts
(cdr prompts
)))
530 (defmethod srecode-insert-method ((sti srecode-template-inserter-ask
)
532 "Insert the STI inserter."
533 (let ((val (srecode-dictionary-lookup-name
534 dictionary
(oref sti
:object-name
))))
536 ;; Does some extra work. Oh well.
539 ;; How is our -ask value determined?
540 (if srecode-insert-with-fields-in-progress
541 ;; Setup editable fields.
542 (setq val
(srecode-insert-method-field sti dictionary
))
543 ;; Ask the question...
544 (setq val
(srecode-insert-method-ask sti dictionary
)))
546 ;; After asking, save in the dictionary so that
547 ;; the user can use the same name again later.
548 (srecode-dictionary-set-value
549 (srecode-root-dictionary dictionary
)
550 (oref sti
:object-name
) val
)
552 ;; Now that this value is safely stowed in the dictionary,
553 ;; we can do what regular inserters do.
554 (call-next-method))))
556 (defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask
)
558 "Derive the default value for an askable inserter STI.
559 DICTIONARY is used to derive some values."
560 (let ((defaultfcn (oref sti
:defaultfcn
)))
561 (cond ((stringp defaultfcn
)
563 ((functionp defaultfcn
)
564 (funcall defaultfcn
))
565 ((and (listp defaultfcn
)
566 (eq (car defaultfcn
) 'macro
))
567 (srecode-dictionary-lookup-name
568 dictionary
(cdr defaultfcn
)))
572 (error "Unknown default for prompt: %S"
575 (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask
)
577 "Do the \"asking\" for the template inserter STI.
578 Use DICTIONARY to resolve values."
579 (let* ((prompt (oref sti prompt
))
580 (default (srecode-insert-ask-default sti dictionary
))
581 (reader (oref sti
:read-fcn
))
584 (cond ((eq reader
'y-or-n-p
)
585 (if (y-or-n-p (or prompt
587 (oref sti
:object-name
))))
590 ((eq reader
'read-char
)
593 (read-char (or prompt
594 (format "Char for %s: "
595 (oref sti
:object-name
))))))
599 (setq val
(funcall reader
601 (format "Specify %s: "
602 (oref sti
:object-name
)))
605 ;; Return our derived value.
609 (defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask
)
611 "Create an editable field for the template inserter STI.
612 Use DICTIONARY to resolve values."
613 (let* ((default (srecode-insert-ask-default sti dictionary
))
615 (srecode-field-value (oref sti
:object-name
)
617 :defaultvalue default
))
619 ;; Return this special compound value as the thing to insert.
620 ;; This special compound value will repeat our asked question
621 ;; across multiple locations.
624 (defmethod srecode-dump ((ins srecode-template-inserter-ask
) indent
)
625 "Dump the state of the SRecode template inserter INS."
628 (princ (oref ins prompt
))
632 (defclass srecode-template-inserter-width
(srecode-template-inserter-variable)
636 "The character code used to identify inserters of this style.")
638 "Inserts the value of a dictionary variable with a specific width.
639 The second argument specifies the width, and a pad, separated by a colon.
640 Thus a specification of `10:left' will insert the value of A
641 to 10 characters, with spaces added to the left. Use `right' for adding
642 spaces to the right.")
644 (defmethod srecode-insert-variable-secondname-handler
645 ((sti srecode-template-inserter-width
) dictionary value width
)
646 "For VALUE handle WIDTH behaviors for this variable inserter.
647 Return the result as a string.
648 By default, treat as a function name."
650 ;; Trim or pad to new length
651 (let* ((split (split-string width
":"))
652 (width (string-to-number (nth 0 split
)))
653 (second (nth 1 split
))
654 (pad (cond ((or (null second
) (string= "right" second
))
656 ((string= "left" second
)
659 (error "Unknown pad type %s" second
)))))
660 (if (>= (length value
) width
)
661 ;; Simple case - too long.
662 (substring value
0 width
)
663 ;; We need to pad on one side or the other.
664 (let ((padchars (make-string (- width
(length value
)) ?
)))
666 (concat padchars value
)
667 (concat value padchars
)))))
668 (error "Width not specified for variable/width inserter")))
670 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-width
)
671 escape-start escape-end
)
672 "Insert an example using inserter INS.
673 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
676 (princ "|A:10:right")
681 (defvar srecode-template-inserter-point-override nil
682 "Point-positioning method for the SRecode template inserter.
683 When nil, perform normal point-positioning behavior.
684 When the value is a cons cell (DEPTH . FUNCTION), call FUNCTION
685 instead, unless the template nesting depth, measured
686 by (length (oref srecode-template active)), is greater than
690 (defclass srecode-template-inserter-point
(srecode-template-inserter)
694 "The character code used to identify inserters of this style.")
695 (point :type
(or null marker
)
698 "Record the value of (point) in this class slot.
699 It is the responsibility of the inserter algorithm to clear this
700 after a successful insertion."))
701 "Record the value of (point) when inserted.
702 The cursor is placed at the ^ macro after insertion.
703 Some inserter macros, such as `srecode-template-inserter-include-wrap'
704 will place text at the ^ macro from the included macro.")
706 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-point
)
707 escape-start escape-end
)
708 "Insert an example using inserter INS.
709 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
717 (defmethod srecode-insert-method ((sti srecode-template-inserter-point
)
719 "Insert the STI inserter.
720 Save point in the class allocated 'point' slot.
721 If `srecode-template-inserter-point-override' non-nil then this
722 generalized marker will do something else. See
723 `srecode-template-inserter-include-wrap' as an example."
724 ;; If `srecode-template-inserter-point-override' is non-nil, its car
725 ;; is the maximum template nesting depth for which the override is
726 ;; valid. Compare this to the actual template nesting depth and
727 ;; maybe use the override function which is stored in the cdr.
728 (if (and srecode-template-inserter-point-override
729 (<= (length (oref srecode-template active
))
730 (car srecode-template-inserter-point-override
)))
731 ;; Disable the old override while we do this.
732 (let ((over (cdr srecode-template-inserter-point-override
))
733 (srecode-template-inserter-point-override nil
))
734 (funcall over dictionary
))
735 (oset sti point
(point-marker))
738 (defclass srecode-template-inserter-subtemplate
(srecode-template-inserter)
740 "Wrap a section of a template under the control of a macro."
743 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-subtemplate
)
744 escape-start escape-end
)
745 "Insert an example using inserter INS.
746 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
748 (princ " Template Text to control")
757 (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate
)
759 "Insert a subtemplate for the inserter STI with dictionary DICT."
760 ;; make sure that only dictionaries are used.
761 (when (not (srecode-dictionary-child-p dict
))
762 (error "Only section dictionaries allowed for %s"
763 (object-name-string sti
)))
764 ;; Output the code from the sub-template.
765 (srecode-insert-method (slot-value sti slot
) dict
)
768 (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate
)
770 "Do the work for inserting the STI inserter.
771 Loops over the embedded CODE which was saved here during compilation.
772 The template to insert is stored in SLOT."
773 (let ((dicts (srecode-dictionary-lookup-name
774 dictionary
(oref sti
:object-name
))))
775 (when (not (listp dicts
))
776 (error "Cannot insert section %S from non-section variable."
777 (oref sti
:object-name
)))
778 ;; If there is no section dictionary, then don't output anything
779 ;; from this section.
781 (when (not (srecode-dictionary-p (car dicts
)))
782 (error "Cannot insert section %S from non-section variable."
783 (oref sti
:object-name
)))
784 (srecode-insert-subtemplate sti
(car dicts
) slot
)
785 (setq dicts
(cdr dicts
)))))
787 (defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate
)
789 "Insert the STI inserter.
790 Calls back to `srecode-insert-method-helper' for this class."
791 (srecode-insert-method-helper sti dictionary
'template
))
794 (defclass srecode-template-inserter-section-start
(srecode-template-inserter-subtemplate)
798 "The character code used to identify inserters of this style.")
799 (template :initarg
:template
801 "A template used to frame the codes from this inserter.")
803 "Apply values from a sub-dictionary to a template section.
804 The dictionary saved at the named dictionary entry will be
805 applied to the text between the section start and the
806 `srecode-template-inserter-section-end' macro.")
808 (defmethod srecode-parse-input ((ins srecode-template-inserter-section-start
)
810 "For the section inserter INS, parse INPUT.
811 Shorten input until the END token is found.
812 Return the remains of INPUT."
813 (let* ((out (srecode-compile-split-code tag input STATE
814 (oref ins
:object-name
))))
815 (oset ins template
(srecode-template
816 (object-name-string ins
)
822 (defmethod srecode-dump ((ins srecode-template-inserter-section-start
) indent
)
823 "Dump the state of the SRecode template inserter INS."
826 (srecode-dump-code-list (oref (oref ins template
) code
)
830 (defclass srecode-template-inserter-section-end
(srecode-template-inserter)
834 "The character code used to identify inserters of this style.")
836 "All template segments between the section-start and section-end
837 are treated specially.")
839 (defmethod srecode-insert-method ((sti srecode-template-inserter-section-end
)
841 "Insert the STI inserter."
844 (defmethod srecode-match-end ((ins srecode-template-inserter-section-end
) name
)
846 "For the template inserter INS, do I end a section called NAME?"
847 (string= name
(oref ins
:object-name
)))
849 (defclass srecode-template-inserter-include
(srecode-template-inserter-subtemplate)
853 "The character code used to identify inserters of this style.")
855 :initarg
:includedtemplate
857 "The template included for this inserter."))
858 "Include a different template into this one.
859 The included template will have additional dictionary entries from the subdictionary
860 stored specified by this macro.")
862 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-include
)
863 escape-start escape-end
)
864 "Insert an example using inserter INS.
865 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
868 (princ ">DICTNAME:contextname:templatename")
873 (defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include
)
875 "For the template inserter STI, lookup the template to include.
876 Finds the template with this macro function part and stores it in
877 this template instance."
878 (let* ((templatenamepart (oref sti
:secondname
))
880 ;; If there was no template name, throw an error
881 (if (not templatenamepart
)
882 (error "Include macro %s needs a template name" (oref sti
:object-name
)))
884 ;; NOTE: We used to cache the template and not look it up a second time,
885 ;; but changes in the template tables can change which template is
886 ;; eventually discovered, so now we always lookup that template.
888 ;; Calculate and store the discovered template
889 (let ((tmpl (srecode-template-get-table (srecode-table)
891 (active (oref srecode-template active
))
894 ;; If it isn't just available, scan back through
895 ;; the active template stack, searching for a matching
897 (while (and (not tmpl
) active
)
898 (setq ctxt
(oref (car active
) context
))
899 (setq tmpl
(srecode-template-get-table (srecode-table)
903 (when (slot-boundp (car active
) 'table
)
904 (let ((app (oref (oref (car active
) table
) application
)))
906 (setq tmpl
(srecode-template-get-table
911 (setq active
(cdr active
)))
913 ;; If it wasn't in this context, look to see if it
914 ;; defines it's own context
915 (setq tmpl
(srecode-template-get-table (srecode-table)
919 ;; Store the found template into this object for later use.
920 (oset sti
:includedtemplate tmpl
))
922 (if (not (oref sti includedtemplate
))
923 ;; @todo - Call into a debugger to help find the template in question.
924 (error "No template \"%s\" found for include macro `%s'"
925 templatenamepart
(oref sti
:object-name
)))
928 (defmethod srecode-insert-method ((sti srecode-template-inserter-include
)
930 "Insert the STI inserter.
931 Finds the template with this macro function part, and inserts it
932 with the dictionaries found in the dictionary."
933 (srecode-insert-include-lookup sti dictionary
)
934 ;; Insert the template.
935 ;; Our baseclass has a simple way to do this.
936 (if (srecode-dictionary-lookup-name dictionary
(oref sti
:object-name
))
937 ;; If we have a value, then call the next method
938 (srecode-insert-method-helper sti dictionary
'includedtemplate
)
939 ;; If we don't have a special dictitonary, then just insert with the
940 ;; current dictionary.
941 (srecode-insert-subtemplate sti dictionary
'includedtemplate
))
945 ;; This template combines the include template and the sectional template.
946 ;; It will first insert the included template, then insert the embedded
947 ;; template wherever the $^$ in the included template was.
949 ;; Since it uses dual inheretance, it will magically get the end-matching
950 ;; behavior of #, with the including feature of >.
952 (defclass srecode-template-inserter-include-wrap
(srecode-template-inserter-include srecode-template-inserter-section-start
)
956 "The character code used to identify inserters of this style.")
958 "Include a different template into this one, and add text at the ^ macro.
959 The included template will have additional dictionary entries from the subdictionary
960 stored specified by this macro. If the included macro includes a ^ macro,
961 then the text between this macro and the end macro will be inserted at
964 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-include-wrap
)
965 escape-start escape-end
)
966 "Insert an example using inserter INS.
967 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
970 (princ "<DICTNAME:contextname:templatename")
973 (princ " Template Text to insert at ^ macro")
982 (defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap
)
984 "Insert the template STI.
985 This will first insert the include part via inheritance, then
986 insert the section it wraps into the location in the included
987 template where a ^ inserter occurs."
988 ;; Step 1: Look up the included inserter
989 (srecode-insert-include-lookup sti dictionary
)
990 ;; Step 2: Temporarily override the point inserter.
991 ;; We bind `srecode-template-inserter-point-override' to a cons cell
992 ;; (DEPTH . FUNCTION) that has the maximum template nesting depth,
993 ;; for which the override is valid, in DEPTH and a lambda function
994 ;; which implements the wrap insertion behavior in FUNCTION. The
995 ;; maximum valid nesting depth is just the current depth + 1.
996 (let ((srecode-template-inserter-point-override
997 (lexical-let ((inserter1 sti
))
1000 (+ (length (oref srecode-template active
)) 1)
1003 (let ((srecode-template-inserter-point-override nil
))
1004 (if (srecode-dictionary-lookup-name
1005 dict
(oref inserter1
:object-name
))
1006 ;; Insert our sectional part with looping.
1007 (srecode-insert-method-helper
1008 inserter1 dict
'template
)
1009 ;; Insert our sectional part just once.
1010 (srecode-insert-subtemplate
1011 inserter1 dict
'template
))))))))
1012 ;; Do a regular insertion for an include, but with our override in
1014 (call-next-method)))
1016 (provide 'srecode
/insert
)
1019 ;; generated-autoload-file: "loaddefs.el"
1020 ;; generated-autoload-load-name: "srecode/insert"
1023 ;;; srecode/insert.el ends here