1 ;;; srecode/insert --- Insert srecode templates to an output stream.
3 ;;; Copyright (C) 2005, 2007, 2008, 2009 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.
29 (require 'srecode
/compile
)
30 (require 'srecode
/find
)
31 (require 'srecode
/dictionary
)
33 (defvar srecode-template-inserter-point
)
34 (declare-function srecode-overlaid-activate
"srecode/fields")
35 (declare-function srecode-template-inserted-region
"srecode/fields")
39 (defcustom srecode-insert-ask-variable-method
'ask
40 "Determine how to ask for a dictionary value when inserting a template.
41 Only the ASK style inserter will query the user for a value.
42 Dictionary value references that ask begin with the ? character.
44 'ask - Prompt in the minibuffer as the value is inserted.
45 'field - Use the dictionary macro name as the inserted value,
46 and place a field there. Matched fields change together.
48 NOTE: The field feature does not yet work with XEmacs."
50 :type
'(choice (const :tag
"Ask" ask
)
51 (cons :tag
"Field" field
)))
53 (defvar srecode-insert-with-fields-in-progress nil
54 "Non-nil means that we are actively inserting a template with fields.")
56 ;;; INSERTION COMMANDS
58 ;; User level commands for inserting stuff.
59 (defvar srecode-insertion-start-context nil
60 "The context that was at point at the beginning of the template insertion.")
62 (defun srecode-insert-again ()
63 "Insert the previously inserted template (by name) again."
65 (let ((prev (car srecode-read-template-name-history
)))
68 (call-interactively 'srecode-insert
))))
71 (defun srecode-insert (template-name &rest dict-entries
)
72 "Inesrt the template TEMPLATE-NAME into the current buffer at point.
73 DICT-ENTRIES are additional dictionary values to add."
74 (interactive (list (srecode-read-template-name "Template Name: ")))
75 (if (not (srecode-table))
76 (error "No template table found for mode %s" major-mode
))
77 (let ((newdict (srecode-create-dictionary))
78 (temp (srecode-template-get-table (srecode-table) template-name
))
79 (srecode-insertion-start-context (srecode-calculate-context))
82 (error "No Template named %s" template-name
))
84 (srecode-dictionary-set-value newdict
86 (car (cdr dict-entries
)))
87 (setq dict-entries
(cdr (cdr dict-entries
))))
88 ;;(srecode-resolve-arguments temp newdict)
89 (srecode-insert-fcn temp newdict
)
90 ;; Don't put code here. We need to return the end-mark
91 ;; for this insertion step.
94 (defun srecode-insert-fcn (template dictionary
&optional stream skipresolver
)
95 "Insert TEMPLATE using DICTIONARY into STREAM.
96 Optional SKIPRESOLVER means to avoid refreshing the tag list,
97 or resolving any template arguments. It is assumed the caller
98 has set everything up already."
99 ;; Perform the insertion.
100 (let ((standard-output (or stream
(current-buffer)))
103 ;; Make sure the semantic tags are up to date.
104 (semantic-fetch-tags)
105 ;; Resolve the arguments
106 (srecode-resolve-arguments template dictionary
))
108 (if (bufferp standard-output
)
109 ;; If there is a buffer, turn off various hooks. This will cause
110 ;; the mod hooks to be buffered up during the insert, but
111 ;; prevent tools like font-lock from fontifying mid-template.
112 ;; Especialy important during insertion of complex comments that
113 ;; cause the new font-lock to comment-color stuff after the inserted
116 ;; I'm not sure about the motion hooks. It seems like a good
119 ;; Borrowed these concepts out of font-lock.
121 ;; I tried `combine-after-change-calls', but it did not have
122 ;; the effect I wanted.
123 (let ((start (point)))
124 (let ((inhibit-point-motion-hooks t
)
125 (inhibit-modification-hooks t
)
127 (srecode--insert-into-buffer template dictionary
)
129 ;; Now call those after change functions.
130 (run-hook-with-args 'after-change-functions
133 (srecode-insert-method template dictionary
))
134 ;; Handle specialization of the POINT inserter.
135 (when (and (bufferp standard-output
)
136 (slot-boundp 'srecode-template-inserter-point
'point
)
138 (set-buffer standard-output
)
139 (setq end-mark
(point-marker))
140 (goto-char (oref srecode-template-inserter-point point
)))
141 (oset-default 'srecode-template-inserter-point point eieio-unbound
)
143 ;; Return the end-mark.
144 (or end-mark
(point)))
147 (defun srecode--insert-into-buffer (template dictionary
)
148 "Insert a TEMPLATE with DICTIONARY into a buffer.
149 Do not call this function yourself. Instead use:
150 `srecode-insert' - Inserts by name.
151 `srecode-insert-fcn' - Insert with objects.
152 This function handles the case from one of the above functions when
153 the template is inserted into a buffer. It looks
154 at `srecode-insert-ask-variable-method' to decide if unbound dictionary
155 entries ask questions or insert editable fields.
157 Buffer based features related to change hooks is handled one level up."
158 ;; This line prevents the field archive from being let bound
159 ;; while the field insert tool is loaded via autoloads during
161 (when (eq srecode-insert-ask-variable-method
'field
)
162 (require 'srecode
/fields
))
164 (let ((srecode-field-archive nil
) ; Prevent field leaks during insert
165 (start (point)) ; Beginning of the region.
167 ;; This sub-let scopes the 'in-progress' piece so we know
168 ;; when to setup the end-template.
169 (let ((srecode-insert-with-fields-in-progress
170 (if (eq srecode-insert-ask-variable-method
'field
) t nil
))
172 (srecode-insert-method template dictionary
)
174 ;; If we are not in-progress, and we insert fields, then
175 ;; create the end-template with fields editable area.
176 (when (and (not srecode-insert-with-fields-in-progress
)
177 (eq srecode-insert-ask-variable-method
'field
) ; Only if user asked
178 srecode-field-archive
; Only if there were fields created
181 ;; Create the field-driven editable area.
182 (srecode-template-inserted-region
183 "TEMPLATE" :start start
:end
(point))))
184 (srecode-overlaid-activate reg
))
186 ;; We return with 'point being the end of the template insertion
187 ;; area. Return value is not important.
190 ;;; TEMPLATE ARGUMENTS
192 ;; Some templates have arguments. Each argument is assocaited with
193 ;; a function that can resolve the inputs needed.
194 (defun srecode-resolve-arguments (temp dict
)
195 "Resolve all the arguments needed by the template TEMP.
196 Apply anything learned to the dictionary DICT."
197 (srecode-resolve-argument-list (oref temp args
) dict temp
))
199 (defun srecode-resolve-argument-list (args dict
&optional temp
)
200 "Resolve arguments in the argument list ARGS.
201 ARGS is a list of symbols, such as :blank, or :file.
202 Apply values to DICT.
203 Optional argument TEMP is the template that is getting it's arguments resolved."
206 (setq fcn
(intern-soft (concat "srecode-semantic-handle-"
207 (symbol-name (car args
)))))
209 (error "Error resolving template argument %S" (car args
)))
212 ;; Allow some to accept a 2nd argument optionally.
213 ;; They throw an error if not available, so try again.
214 (funcall fcn dict temp
)
215 (wrong-number-of-arguments (funcall fcn dict
)))
217 (setq args
(cdr args
)))
220 ;;; INSERTION STACK & METHOD
222 ;; Code managing the top-level insert method and the current
225 (defmethod srecode-push ((st srecode-template
))
226 "Push the srecoder template ST onto the active stack."
227 (oset st active
(cons st
(oref st active
))))
229 (defmethod srecode-pop :STATIC
((st srecode-template
))
230 "Pop the srecoder template ST onto the active stack.
231 ST can be a class, or an object."
232 (oset st active
(cdr (oref st active
))))
234 (defmethod srecode-peek :STATIC
((st srecode-template
))
235 "Fetch the topmost active template record. ST can be a class."
236 (car (oref st active
)))
238 (defmethod srecode-insert-method ((st srecode-template
) dictionary
)
239 "Insert the srecoder template ST."
240 ;; Merge any template entries into the input dictionary.
241 (when (slot-boundp st
'dictionary
)
242 (srecode-dictionary-merge dictionary
(oref st dictionary
)))
245 (let ((c (oref st code
)))
247 (srecode-insert-code-stream c dictionary
))
248 ;; Poping the stack is protected
251 (defun srecode-insert-code-stream (code dictionary
)
252 "Insert the CODE from a template into `standard-output'.
253 Use DICTIONARY to resolve any macros."
255 (cond ((stringp (car code
))
258 (srecode-insert-method (car code
) dictionary
)))
259 (setq code
(cdr code
))))
263 ;; Specific srecode inserters.
264 ;; The base class is from srecode-compile.
266 ;; Each inserter handles various macro codes from the temlate.
267 ;; The `code' slot specifies a character used to identify which
268 ;; inserter is to be created.
270 (defclass srecode-template-inserter-newline
(srecode-template-inserter)
274 "The character code used to identify inserters of this style.")
278 "Is this a hard newline (always inserted) or optional?
279 Optional newlines don't insert themselves if they are on a blank line
282 "Insert a newline, and possibly do indenting.
283 Specify the :indent argument to enable automatic indentation when newlines
284 occur in your template.")
286 (defmethod srecode-insert-method ((sti srecode-template-inserter-newline
)
288 "Insert the STI inserter."
289 ;; To be safe, indent the previous line since the template will
290 ;; change what is there to indent
291 (let ((i (srecode-dictionary-lookup-name dictionary
"INDENT"))
292 (inbuff (bufferp standard-output
))
295 (when (and inbuff
(not (oref sti hard
)))
296 ;; If this is not a hard newline, we need do the calculation
297 ;; and set "doit" to nil.
300 (narrow-to-region (point) pm
)
301 (when (looking-at "\\s-*$")
305 ;; Do indentation reguardless of the newline.
306 (when (and (eq i t
) inbuff
)
307 (indent-according-to-mode)
312 ;; Indent after the newline, particularly for numeric indents.
313 (cond ((and (eq i t
) (bufferp standard-output
))
314 ;; WARNING - indent according to mode requires that standard-output
316 ;; @todo - how to indent in a string???
317 (setq pm
(point-marker))
318 (indent-according-to-mode)
321 (princ (make-string i
" ")))
325 (defmethod srecode-dump ((ins srecode-template-inserter-newline
) indent
)
326 "Dump the state of the SRecode template inserter INS."
328 (when (oref ins hard
)
332 (defclass srecode-template-inserter-blank
(srecode-template-inserter)
336 "The character represeinting this inserter style.
337 Can't be blank, or it might be used by regular variable insertion.")
338 (where :initform
'begin
341 "This should be 'begin or 'end, indicating where to insrt a CR.
342 When set to 'begin, it will insert a CR if we are not at 'bol'.
343 When set to 'end it will insert a CR if we are not at 'eol'")
344 ;; @TODO - Add slot and control for the number of blank
345 ;; lines before and after point.
347 "Insert a newline before and after a template, and possibly do indenting.
348 Specify the :blank argument to enable this inserter.")
350 (defmethod srecode-insert-method ((sti srecode-template-inserter-blank
)
352 "Make sure there is no text before or after point."
353 (let ((i (srecode-dictionary-lookup-name dictionary
"INDENT"))
354 (inbuff (bufferp standard-output
))
357 ;; Don't do this if we are not the active template.
358 (= (length (oref srecode-template active
)) 1))
360 (when (and (eq i t
) inbuff
(not (eq (oref sti where
) 'begin
)))
361 (indent-according-to-mode)
364 (cond ((and (eq (oref sti where
) 'begin
) (not (bolp)))
366 ((eq (oref sti where
) 'end
)
367 ;; If there is whitespace after pnt, then clear it out.
368 (when (looking-at "\\s-*$")
369 (delete-region (point) (point-at-eol)))
373 (setq pm
(point-marker))
374 (when (and (eq i t
) inbuff
(not (eq (oref sti where
) 'end
)))
375 (indent-according-to-mode)
379 (defclass srecode-template-inserter-comment
(srecode-template-inserter)
383 "The character code used to identify inserters of this style.")
385 "Allow comments within template coding. This inserts nothing.")
387 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-comment
)
388 escape-start escape-end
)
389 "Insert an example using inserter INS.
390 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
393 (princ "! Miscellaneous text commenting in your template. ")
398 (defmethod srecode-insert-method ((sti srecode-template-inserter-comment
)
400 "Don't insert anything for comment macros in STI."
404 (defclass srecode-template-inserter-variable
(srecode-template-inserter)
408 "The character code used to identify inserters of this style."))
409 "Insert the value of a dictionary entry
410 If there is no entry, insert nothing.")
412 (defvar srecode-inserter-variable-current-dictionary nil
413 "The active dictionary when calling a variable filter.")
415 (defmethod srecode-insert-variable-secondname-handler
416 ((sti srecode-template-inserter-variable
) dictionary value secondname
)
417 "For VALUE handle SECONDNAME behaviors for this variable inserter.
418 Return the result as a string.
419 By default, treat as a function name.
420 If SECONDNAME is nil, return VALUE."
422 (let ((fcnpart (read secondname
)))
423 (if (fboundp fcnpart
)
424 (let ((srecode-inserter-variable-current-dictionary dictionary
))
425 (funcall fcnpart value
))
427 (error "Variable insertion second arg %s is not a function."
431 (defmethod srecode-insert-method ((sti srecode-template-inserter-variable
)
433 "Insert the STI inserter."
434 ;; Convert the name into a name/fcn pair
435 (let* ((name (oref sti
:object-name
))
436 (fcnpart (oref sti
:secondname
))
437 (val (srecode-dictionary-lookup-name
441 ;; Alert if a macro wasn't found.
443 (message "Warning: macro %S was not found in the dictionary." name
)
445 ;; If there was a functional part, call that function.
448 (setq val
(srecode-insert-variable-secondname-handler
449 sti dictionary val fcnpart
)))
450 ;; Compound data value
451 ((srecode-dictionary-compound-value-child-p val
)
452 ;; Force FCN to be a symbol
453 (when fcnpart
(setq fcnpart
(read fcnpart
)))
454 ;; Convert compound value to a string with the fcn.
455 (setq val
(srecode-compound-toString val fcnpart dictionary
))
456 ;; If the value returned is nil, then it may be a special
457 ;; field inserter that requires us to set do-princ to nil.
462 ;; Dictionaries... not allowed in this style
463 ((srecode-dictionary-child-p val
)
464 (error "Macro %s cannot insert a dictionary. Use section macros instead."
466 ;; Other stuff... convert
468 (error "Macro %s cannot insert arbitrary data." name
)
469 ;;(if (and val (not (stringp val)))
470 ;; (setq val (format "%S" val))))
472 ;; Output the dumb thing unless the type of thing specifically
473 ;; did the inserting forus.
477 (defclass srecode-template-inserter-ask
(srecode-template-inserter-variable)
481 "The character code used to identify inserters of this style.")
482 (prompt :initarg
:prompt
485 "The prompt used to query for this dictionary value.")
486 (defaultfcn :initarg
:defaultfcn
489 "The function which can calculate a default value.")
490 (read-fcn :initarg
:read-fcn
491 :initform
'read-string
493 "The function used to read in the text for this prompt.")
495 "Insert the value of a dictionary entry
496 If there is no entry, prompt the user for the value to use.
497 The prompt text used is derived from the previous PROMPT command in the
500 (defmethod srecode-inserter-apply-state ((ins srecode-template-inserter-ask
) STATE
)
501 "For the template inserter INS, apply information from STATE.
502 Loop over the prompts to see if we have a match."
503 (let ((prompts (oref STATE prompts
))
506 (when (string= (semantic-tag-name (car prompts
))
507 (oref ins
:object-name
))
509 (semantic-tag-get-attribute (car prompts
) :text
))
510 (oset ins
:defaultfcn
511 (semantic-tag-get-attribute (car prompts
) :default
))
513 (or (semantic-tag-get-attribute (car prompts
) :read
)
516 (setq prompts
(cdr prompts
)))
519 (defmethod srecode-insert-method ((sti srecode-template-inserter-ask
)
521 "Insert the STI inserter."
522 (let ((val (srecode-dictionary-lookup-name
523 dictionary
(oref sti
:object-name
))))
525 ;; Does some extra work. Oh well.
528 ;; How is our -ask value determined?
529 (if srecode-insert-with-fields-in-progress
530 ;; Setup editable fields.
531 (setq val
(srecode-insert-method-field sti dictionary
))
532 ;; Ask the question...
533 (setq val
(srecode-insert-method-ask sti dictionary
)))
535 ;; After asking, save in the dictionary so that
536 ;; the user can use the same name again later.
537 (srecode-dictionary-set-value
538 (srecode-root-dictionary dictionary
)
539 (oref sti
:object-name
) val
)
541 ;; Now that this value is safely stowed in the dictionary,
542 ;; we can do what regular inserters do.
543 (call-next-method))))
545 (defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask
)
547 "Derive the default value for an askable inserter STI.
548 DICTIONARY is used to derive some values."
549 (let ((defaultfcn (oref sti
:defaultfcn
)))
550 (cond ((stringp defaultfcn
)
552 ((functionp defaultfcn
)
553 (funcall defaultfcn
))
554 ((and (listp defaultfcn
)
555 (eq (car defaultfcn
) 'macro
))
556 (srecode-dictionary-lookup-name
557 dictionary
(cdr defaultfcn
)))
561 (error "Unknown default for prompt: %S"
564 (defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask
)
566 "Do the \"asking\" for the template inserter STI.
567 Use DICTIONARY to resolve values."
568 (let* ((prompt (oref sti prompt
))
569 (default (srecode-insert-ask-default sti dictionary
))
570 (reader (oref sti
:read-fcn
))
573 (cond ((eq reader
'y-or-n-p
)
574 (if (y-or-n-p (or prompt
576 (oref sti
:object-name
))))
579 ((eq reader
'read-char
)
582 (read-char (or prompt
583 (format "Char for %s: "
584 (oref sti
:object-name
))))))
588 (setq val
(funcall reader
590 (format "Specify %s: "
591 (oref sti
:object-name
)))
594 ;; Return our derived value.
598 (defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask
)
600 "Create an editable field for the template inserter STI.
601 Use DICTIONARY to resolve values."
602 (let* ((default (srecode-insert-ask-default sti dictionary
))
604 (srecode-field-value (oref sti
:object-name
)
606 :defaultvalue default
))
608 ;; Return this special compound value as the thing to insert.
609 ;; This special compound value will repeat our asked question
610 ;; across multiple locations.
613 (defmethod srecode-dump ((ins srecode-template-inserter-ask
) indent
)
614 "Dump the state of the SRecode template inserter INS."
617 (princ (oref ins prompt
))
621 (defclass srecode-template-inserter-width
(srecode-template-inserter-variable)
625 "The character code used to identify inserters of this style.")
627 "Inserts the value of a dictionary variable with a specific width.
628 The second argument specifies the width, and a pad, seperated by a colon.
629 thus a specification of `10:left' will insert the value of A
630 to 10 characters, with spaces added to the left. Use `right' for adding
631 spaces to the right.")
633 (defmethod srecode-insert-variable-secondname-handler
634 ((sti srecode-template-inserter-width
) dictionary value width
)
635 "For VALUE handle WIDTH behaviors for this variable inserter.
636 Return the result as a string.
637 By default, treat as a function name."
639 ;; Trim or pad to new length
640 (let* ((split (split-string width
":"))
641 (width (string-to-number (nth 0 split
)))
642 (second (nth 1 split
))
643 (pad (cond ((or (null second
) (string= "right" second
))
645 ((string= "left" second
)
648 (error "Unknown pad type %s" second
)))))
649 (if (>= (length value
) width
)
650 ;; Simple case - too long.
651 (substring value
0 width
)
652 ;; We need to pad on one side or the other.
653 (let ((padchars (make-string (- width
(length value
)) ?
)))
655 (concat padchars value
)
656 (concat value padchars
)))))
657 (error "Width not specified for variable/width inserter.")))
659 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-width
)
660 escape-start escape-end
)
661 "Insert an example using inserter INS.
662 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
665 (princ "|A:10:right")
670 (defvar srecode-template-inserter-point-override nil
671 "When non-nil, the point inserter will do this functin instead.")
673 (defclass srecode-template-inserter-point
(srecode-template-inserter)
677 "The character code used to identify inserters of this style.")
678 (point :type
(or null marker
)
681 "Record the value of (point) in this class slot.
682 It is the responsibility of the inserter algorithm to clear this
683 after a successful insertion."))
684 "Record the value of (point) when inserted.
685 The cursor is placed at the ^ macro after insertion.
686 Some inserter macros, such as `srecode-template-inserter-include-wrap'
687 will place text at the ^ macro from the included macro.")
689 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-point
)
690 escape-start escape-end
)
691 "Insert an example using inserter INS.
692 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
700 (defmethod srecode-insert-method ((sti srecode-template-inserter-point
)
702 "Insert the STI inserter.
703 Save point in the class allocated 'point' slot.
704 If `srecode-template-inserter-point-override' then this generalized
705 marker will do something else. See `srecode-template-inserter-include-wrap'
707 (if srecode-template-inserter-point-override
708 ;; Disable the old override while we do this.
709 (let ((over srecode-template-inserter-point-override
)
710 (srecode-template-inserter-point-override nil
))
711 (funcall over dictionary
)
713 (oset sti point
(point-marker))
716 (defclass srecode-template-inserter-subtemplate
(srecode-template-inserter)
718 "Wrap a section of a template under the control of a macro."
721 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-subtemplate
)
722 escape-start escape-end
)
723 "Insert an example using inserter INS.
724 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
726 (princ " Template Text to control")
735 (defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate
)
737 "Insert a subtemplate for the inserter STI with dictionary DICT."
738 ;; make sure that only dictionaries are used.
739 (when (not (srecode-dictionary-child-p dict
))
740 (error "Only section dictionaries allowed for %s"
741 (object-name-string sti
)))
742 ;; Output the code from the sub-template.
743 (srecode-insert-method (slot-value sti slot
) dict
)
746 (defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate
)
748 "Do the work for inserting the STI inserter.
749 Loops over the embedded CODE which was saved here during compilation.
750 The template to insert is stored in SLOT."
751 (let ((dicts (srecode-dictionary-lookup-name
752 dictionary
(oref sti
:object-name
))))
753 ;; If there is no section dictionary, then don't output anything
754 ;; from this section.
756 (srecode-insert-subtemplate sti
(car dicts
) slot
)
757 (setq dicts
(cdr dicts
)))))
759 (defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate
)
761 "Insert the STI inserter.
762 Calls back to `srecode-insert-method-helper' for this class."
763 (srecode-insert-method-helper sti dictionary
'template
))
766 (defclass srecode-template-inserter-section-start
(srecode-template-inserter-subtemplate)
770 "The character code used to identify inserters of this style.")
771 (template :initarg
:template
773 "A Template used to frame the codes from this inserter.")
775 "Apply values from a sub-dictionary to a template section.
776 The dictionary saved at the named dictionary entry will be
777 applied to the text between the section start and the
778 `srecode-template-inserter-section-end' macro.")
780 (defmethod srecode-parse-input ((ins srecode-template-inserter-section-start
)
782 "For the section inserter INS, parse INPUT.
783 Shorten input until the END token is found.
784 Return the remains of INPUT."
785 (let* ((out (srecode-compile-split-code tag input STATE
786 (oref ins
:object-name
))))
787 (oset ins template
(srecode-template
788 (object-name-string ins
)
794 (defmethod srecode-dump ((ins srecode-template-inserter-section-start
) indent
)
795 "Dump the state of the SRecode template inserter INS."
798 (srecode-dump-code-list (oref (oref ins template
) code
)
802 (defclass srecode-template-inserter-section-end
(srecode-template-inserter)
806 "The character code used to identify inserters of this style.")
808 "All template segments between the secion-start and section-end
809 are treated specially.")
811 (defmethod srecode-insert-method ((sti srecode-template-inserter-section-end
)
813 "Insert the STI inserter."
816 (defmethod srecode-match-end ((ins srecode-template-inserter-section-end
) name
)
818 "For the template inserter INS, do I end a section called NAME?"
819 (string= name
(oref ins
:object-name
)))
821 (defclass srecode-template-inserter-include
(srecode-template-inserter-subtemplate)
825 "The character code used to identify inserters of this style.")
827 :initarg
:includedtemplate
829 "The template included for this inserter."))
830 "Include a different template into this one.
831 The included template will have additional dictionary entries from the subdictionary
832 stored specified by this macro.")
834 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-include
)
835 escape-start escape-end
)
836 "Insert an example using inserter INS.
837 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
840 (princ ">DICTNAME:contextname:templatename")
845 (defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include
)
847 "For the template inserter STI, lookup the template to include.
848 Finds the template with this macro function part and stores it in
849 this template instance."
850 (let* ((templatenamepart (oref sti
:secondname
))
852 ;; If there was no template name, throw an error
853 (if (not templatenamepart
)
854 (error "Include macro %s needs a template name." (oref sti
:object-name
)))
855 ;; Find the template by name, and save it.
856 (if (or (not (slot-boundp sti
'includedtemplate
))
857 (not (oref sti includedtemplate
)))
858 (let ((tmpl (srecode-template-get-table (srecode-table)
860 (active (oref srecode-template active
))
863 ;; If it isn't just available, scan back through
864 ;; the active template stack, searching for a matching
866 (while (and (not tmpl
) active
)
867 (setq ctxt
(oref (car active
) context
))
868 (setq tmpl
(srecode-template-get-table (srecode-table)
872 (when (slot-boundp (car active
) 'table
)
873 (let ((app (oref (oref (car active
) table
) application
)))
875 (setq tmpl
(srecode-template-get-table
880 (setq active
(cdr active
)))
882 ;; If it wasn't in this context, look to see if it
883 ;; defines it's own context
884 (setq tmpl
(srecode-template-get-table (srecode-table)
887 (oset sti
:includedtemplate tmpl
)))
889 (if (not (oref sti includedtemplate
))
890 ;; @todo - Call into a debugger to help find the template in question.
891 (error "No template \"%s\" found for include macro `%s'"
892 templatenamepart
(oref sti
:object-name
)))
895 (defmethod srecode-insert-method ((sti srecode-template-inserter-include
)
897 "Insert the STI inserter.
898 Finds the template with this macro function part, and inserts it
899 with the dictionaries found in the dictinary."
900 (srecode-insert-include-lookup sti dictionary
)
901 ;; Insert the template.
902 ;; Our baseclass has a simple way to do this.
903 (if (srecode-dictionary-lookup-name dictionary
(oref sti
:object-name
))
904 ;; If we have a value, then call the next method
905 (srecode-insert-method-helper sti dictionary
'includedtemplate
)
906 ;; If we don't have a special dictitonary, then just insert with the
907 ;; current dictionary.
908 (srecode-insert-subtemplate sti dictionary
'includedtemplate
))
912 ;; This template combines the include template and the sectional template.
913 ;; It will first insert the included template, then insert the embedded
914 ;; template wherever the $^$ in the included template was.
916 ;; Since it uses dual inheretance, it will magically get the end-matching
917 ;; behavior of #, with the including feature of >.
919 (defclass srecode-template-inserter-include-wrap
(srecode-template-inserter-include srecode-template-inserter-section-start
)
923 "The character code used to identify inserters of this style.")
925 "Include a different template into this one, and add text at the ^ macro.
926 The included template will have additional dictionary entries from the subdictionary
927 stored specified by this macro. If the included macro includes a ^ macro,
928 then the text between this macro and the end macro will be inserted at
931 (defmethod srecode-inserter-prin-example :STATIC
((ins srecode-template-inserter-include-wrap
)
932 escape-start escape-end
)
933 "Insert an example using inserter INS.
934 Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
937 (princ "<DICTNAME:contextname:templatename")
940 (princ " Template Text to insert at ^ macro")
949 (defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap
)
951 "Insert the template STI.
952 This will first insert the include part via inheritance, then
953 insert the section it wraps into the location in the included
954 template where a ^ inserter occurs."
955 ;; Step 1: Look up the included inserter
956 (srecode-insert-include-lookup sti dictionary
)
957 ;; Step 2: Temporarilly override the point inserter.
958 (let* ((vaguely-unique-name sti
)
959 (srecode-template-inserter-point-override
961 (if (srecode-dictionary-lookup-name
962 dict2
(oref vaguely-unique-name
:object-name
))
963 ;; Insert our sectional part with looping.
964 (srecode-insert-method-helper
965 vaguely-unique-name dict2
'template
)
966 ;; Insert our sectional part just once.
967 (srecode-insert-subtemplate vaguely-unique-name
970 ;; Do a regular insertion for an include, but with our override in
975 (provide 'srecode
/insert
)
978 ;; generated-autoload-file: "loaddefs.el"
979 ;; generated-autoload-feature: srecode/loaddefs
980 ;; generated-autoload-load-name: "srecode/insert"
983 ;;; srecode/insert.el ends here