insert.el 34.3 KB
Newer Older
Chong Yidong's avatar
Chong Yidong committed
1 2
;;; srecode/insert --- Insert srecode templates to an output stream.

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2005, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
Chong Yidong's avatar
Chong Yidong committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

;; Author: Eric M. Ludlam <zappo@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Define and implements specific inserter objects.
;;
;; Manage the insertion process for a template.
;;

(require 'srecode/compile)
(require 'srecode/find)
(require 'srecode/dictionary)
32
(require 'srecode/args)
Chong Yidong's avatar
Chong Yidong committed
33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72

(defvar srecode-template-inserter-point)
(declare-function srecode-overlaid-activate "srecode/fields")
(declare-function srecode-template-inserted-region "srecode/fields")

;;; Code:

(defcustom srecode-insert-ask-variable-method 'ask
  "Determine how to ask for a dictionary value when inserting a template.
Only the ASK style inserter will query the user for a value.
Dictionary value references that ask begin with the ? character.
Possible values are:
  'ask   - Prompt in the minibuffer as the value is inserted.
  'field - Use the dictionary macro name as the inserted value,
           and place a field there.  Matched fields change together.

NOTE: The field feature does not yet work with XEmacs."
  :group 'srecode
  :type '(choice (const :tag "Ask" ask)
		 (cons :tag "Field" field)))

(defvar srecode-insert-with-fields-in-progress nil
  "Non-nil means that we are actively inserting a template with fields.")

;;; INSERTION COMMANDS
;;
;; User level commands for inserting stuff.
(defvar srecode-insertion-start-context nil
  "The context that was at point at the beginning of the template insertion.")

(defun srecode-insert-again ()
  "Insert the previously inserted template (by name) again."
  (interactive)
  (let ((prev (car srecode-read-template-name-history)))
    (if prev
	(srecode-insert prev)
      (call-interactively 'srecode-insert))))

;;;###autoload
(defun srecode-insert (template-name &rest dict-entries)
Glenn Morris's avatar
Glenn Morris committed
73
  "Insert the template TEMPLATE-NAME into the current buffer at point.
Chong Yidong's avatar
Chong Yidong committed
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
DICT-ENTRIES are additional dictionary values to add."
  (interactive (list (srecode-read-template-name "Template Name: ")))
  (if (not (srecode-table))
      (error "No template table found for mode %s" major-mode))
  (let ((newdict (srecode-create-dictionary))
	(temp (srecode-template-get-table (srecode-table) template-name))
	(srecode-insertion-start-context (srecode-calculate-context))
	)
    (if (not temp)
	(error "No Template named %s" template-name))
    (while dict-entries
      (srecode-dictionary-set-value newdict
				    (car dict-entries)
				    (car (cdr dict-entries)))
      (setq dict-entries (cdr (cdr dict-entries))))
    ;;(srecode-resolve-arguments temp newdict)
    (srecode-insert-fcn temp newdict)
    ;; Don't put code here.  We need to return the end-mark
    ;; for this insertion step.
    ))

(defun srecode-insert-fcn (template dictionary &optional stream skipresolver)
  "Insert TEMPLATE using DICTIONARY into STREAM.
Optional SKIPRESOLVER means to avoid refreshing the tag list,
or resolving any template arguments.  It is assumed the caller
has set everything up already."
  ;; Perform the insertion.
  (let ((standard-output (or stream (current-buffer)))
	(end-mark nil))
    (unless skipresolver
      ;; Make sure the semantic tags are up to date.
      (semantic-fetch-tags)
      ;; Resolve the arguments
      (srecode-resolve-arguments template dictionary))
    ;; Insert
    (if (bufferp standard-output)
	;; If there is a buffer, turn off various hooks.  This will cause
	;; the mod hooks to be buffered up during the insert, but
	;; prevent tools like font-lock from fontifying mid-template.
	;; Especialy important during insertion of complex comments that
	;; cause the new font-lock to comment-color stuff after the inserted
	;; comment.
	;;
	;; I'm not sure about the motion hooks.  It seems like a good
	;; idea though.
	;;
	;; Borrowed these concepts out of font-lock.
	;;
	;; I tried `combine-after-change-calls', but it did not have
	;; the effect I wanted.
	(let ((start (point)))
	  (let ((inhibit-point-motion-hooks t)
		(inhibit-modification-hooks t)
		)
	    (srecode--insert-into-buffer template dictionary)
	    )
	  ;; Now call those after change functions.
	  (run-hook-with-args 'after-change-functions
			      start (point) 0)
	  )
      (srecode-insert-method template dictionary))
    ;; Handle specialization of the POINT inserter.
    (when (and (bufferp standard-output)
	       (slot-boundp 'srecode-template-inserter-point 'point)
	       )
      (set-buffer standard-output)
      (setq end-mark (point-marker))
      (goto-char  (oref srecode-template-inserter-point point)))
    (oset-default 'srecode-template-inserter-point point eieio-unbound)

    ;; Return the end-mark.
    (or end-mark (point)))
  )

(defun srecode--insert-into-buffer (template dictionary)
  "Insert a TEMPLATE with DICTIONARY into a buffer.
Do not call this function yourself.  Instead use:
  `srecode-insert' - Inserts by name.
  `srecode-insert-fcn' - Insert with objects.
This function handles the case from one of the above functions when
the template is inserted into a buffer.  It looks
at `srecode-insert-ask-variable-method' to decide if unbound dictionary
entries ask questions or insert editable fields.

Buffer based features related to change hooks is handled one level up."
  ;; This line prevents the field archive from being let bound
  ;; while the field insert tool is loaded via autoloads during
  ;; the insert.
  (when (eq srecode-insert-ask-variable-method 'field)
163
    (require 'srecode/fields))
Chong Yidong's avatar
Chong Yidong committed
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192

  (let ((srecode-field-archive nil) ; Prevent field leaks during insert
	(start (point)) ; Beginning of the region.
	)
    ;; This sub-let scopes the 'in-progress' piece so we know
    ;; when to setup the end-template.
    (let ((srecode-insert-with-fields-in-progress
	   (if (eq srecode-insert-ask-variable-method 'field) t nil))
	  )
      (srecode-insert-method template dictionary)
      )
    ;; If we are not in-progress, and we insert fields, then
    ;; create the end-template with fields editable area.
    (when (and (not srecode-insert-with-fields-in-progress)
	       (eq srecode-insert-ask-variable-method 'field) ; Only if user asked
	       srecode-field-archive ; Only if there were fields created
	       )
      (let ((reg
	     ;; Create the field-driven editable area.
	     (srecode-template-inserted-region
	      "TEMPLATE" :start start :end (point))))
	(srecode-overlaid-activate reg))
      )
    ;; We return with 'point being the end of the template insertion
    ;; area.  Return value is not important.
    ))

;;; TEMPLATE ARGUMENTS
;;
Juanma Barranquero's avatar
Juanma Barranquero committed
193
;; Some templates have arguments.  Each argument is associated with
Chong Yidong's avatar
Chong Yidong committed
194 195 196 197 198 199 200 201 202 203
;; a function that can resolve the inputs needed.
(defun srecode-resolve-arguments (temp dict)
  "Resolve all the arguments needed by the template TEMP.
Apply anything learned to the dictionary DICT."
  (srecode-resolve-argument-list (oref temp args) dict temp))

(defun srecode-resolve-argument-list (args dict &optional temp)
  "Resolve arguments in the argument list ARGS.
ARGS is a list of symbols, such as :blank, or :file.
Apply values to DICT.
Juanma Barranquero's avatar
Juanma Barranquero committed
204
Optional argument TEMP is the template that is getting its arguments resolved."
Chong Yidong's avatar
Chong Yidong committed
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336
  (let ((fcn nil))
    (while args
      (setq fcn (intern-soft (concat "srecode-semantic-handle-"
				     (symbol-name (car args)))))
      (if (not fcn)
	  (error "Error resolving template argument %S" (car args)))
      (if temp
	  (condition-case nil
	      ;; Allow some to accept a 2nd argument optionally.
	      ;; They throw an error if not available, so try again.
	      (funcall fcn dict temp)
	    (wrong-number-of-arguments (funcall fcn dict)))
	(funcall fcn dict))
      (setq args (cdr args)))
    ))

;;; INSERTION STACK & METHOD
;;
;; Code managing the top-level insert method and the current
;; insertion stack.
;;
(defmethod srecode-push ((st srecode-template))
  "Push the srecoder template ST onto the active stack."
  (oset st active (cons st (oref st active))))

(defmethod srecode-pop :STATIC ((st srecode-template))
  "Pop the srecoder template ST onto the active stack.
ST can be a class, or an object."
  (oset st active (cdr (oref st active))))

(defmethod srecode-peek :STATIC ((st srecode-template))
  "Fetch the topmost active template record.  ST can be a class."
  (car (oref st active)))

(defmethod srecode-insert-method ((st srecode-template) dictionary)
  "Insert the srecoder template ST."
  ;; Merge any template entries into the input dictionary.
  (when (slot-boundp st 'dictionary)
    (srecode-dictionary-merge dictionary (oref st dictionary)))
  ;; Do an insertion.
  (unwind-protect
      (let ((c (oref st code)))
	(srecode-push st)
	(srecode-insert-code-stream c dictionary))
    ;; Poping the stack is protected
    (srecode-pop st)))

(defun srecode-insert-code-stream (code dictionary)
  "Insert the CODE from a template into `standard-output'.
Use DICTIONARY to resolve any macros."
  (while code
    (cond ((stringp (car code))
	   (princ (car code)))
	  (t
	   (srecode-insert-method (car code) dictionary)))
    (setq code (cdr code))))

;;; INSERTERS
;;
;; Specific srecode inserters.
;; The base class is from srecode-compile.
;;
;; Each inserter handles various macro codes from the temlate.
;; The `code' slot specifies a character used to identify which
;; inserter is to be created.
;;
(defclass srecode-template-inserter-newline (srecode-template-inserter)
  ((key :initform "\n"
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   (hard :initform nil
	 :initarg :hard
	 :documentation
	 "Is this a hard newline (always inserted) or optional?
Optional newlines don't insert themselves if they are on a blank line
by themselves.")
   )
  "Insert a newline, and possibly do indenting.
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")

(defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
				  dictionary)
  "Insert the STI inserter."
  ;; To be safe, indent the previous line since the template will
  ;; change what is there to indent
  (let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
	(inbuff (bufferp standard-output))
	(doit t)
	(pm (point-marker)))
    (when (and inbuff (not (oref sti hard)))
      ;; If this is not a hard newline, we need do the calculation
      ;; and set "doit" to nil.
      (beginning-of-line)
      (save-restriction
	(narrow-to-region (point) pm)
	(when (looking-at "\\s-*$")
	  (setq doit nil)))
      (goto-char pm)
      )
    ;; Do indentation reguardless of the newline.
    (when (and (eq i t) inbuff)
      (indent-according-to-mode)
      (goto-char pm))

    (when doit
      (princ "\n")
      ;; Indent after the newline, particularly for numeric indents.
      (cond ((and (eq i t) (bufferp standard-output))
	     ;; WARNING - indent according to mode requires that standard-output
	     ;;           is a buffer!
	     ;; @todo - how to indent in a string???
	     (setq pm (point-marker))
	     (indent-according-to-mode)
	     (goto-char pm))
	    ((numberp i)
	     (princ (make-string i " ")))
	    ((stringp i)
	     (princ i))))))

(defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
  "Dump the state of the SRecode template inserter INS."
  (call-next-method)
  (when (oref ins hard)
    (princ " : hard")
    ))

(defclass srecode-template-inserter-blank (srecode-template-inserter)
   ((key :initform "\r"
	 :allocation :class
	 :documentation
Juanma Barranquero's avatar
Juanma Barranquero committed
337
	 "The character representing this inserter style.
Chong Yidong's avatar
Chong Yidong committed
338 339 340 341
Can't be blank, or it might be used by regular variable insertion.")
    (where :initform 'begin
	   :initarg :where
	   :documentation
Juanma Barranquero's avatar
Juanma Barranquero committed
342
	   "This should be 'begin or 'end, indicating where to insert a CR.
Chong Yidong's avatar
Chong Yidong committed
343
When set to 'begin, it will insert a CR if we are not at 'bol'.
Juanma Barranquero's avatar
Juanma Barranquero committed
344
When set to 'end it will insert a CR if we are not at 'eol'.")
Chong Yidong's avatar
Chong Yidong committed
345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409
    ;; @TODO - Add slot and control for the number of blank
    ;;         lines before and after point.
   )
   "Insert a newline before and after a template, and possibly do indenting.
Specify the :blank argument to enable this inserter.")

(defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
				  dictionary)
  "Make sure there is no text before or after point."
  (let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
	(inbuff (bufferp standard-output))
	(pm (point-marker)))
    (when (and inbuff
	       ;; Don't do this if we are not the active template.
	       (= (length (oref srecode-template active)) 1))

      (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin)))
	(indent-according-to-mode)
	(goto-char pm))

      (cond ((and (eq (oref sti where) 'begin) (not (bolp)))
	     (princ "\n"))
	    ((eq (oref sti where) 'end)
	     ;; If there is whitespace after pnt, then clear it out.
	     (when (looking-at "\\s-*$")
	       (delete-region (point) (point-at-eol)))
	     (when (not (eolp))
	       (princ "\n")))
	    )
      (setq pm (point-marker))
      (when (and (eq i t) inbuff (not (eq (oref sti where) 'end)))
	(indent-according-to-mode)
	(goto-char pm))
      )))

(defclass srecode-template-inserter-comment (srecode-template-inserter)
  ((key :initform ?!
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   )
  "Allow comments within template coding.  This inserts nothing.")

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (princ "   ")
  (princ escape-start)
  (princ "! Miscellaneous text commenting in your template. ")
  (princ escape-end)
  (terpri)
  )

(defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
				  dictionary)
  "Don't insert anything for comment macros in STI."
  nil)


(defclass srecode-template-inserter-variable (srecode-template-inserter)
  ((key :initform nil
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style."))
Juanma Barranquero's avatar
Juanma Barranquero committed
410
  "Insert the value of a dictionary entry.
Chong Yidong's avatar
Chong Yidong committed
411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
If there is no entry, insert nothing.")

(defvar srecode-inserter-variable-current-dictionary nil
  "The active dictionary when calling a variable filter.")

(defmethod srecode-insert-variable-secondname-handler
  ((sti srecode-template-inserter-variable) dictionary value secondname)
  "For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string.
By default, treat as a function name.
If SECONDNAME is nil, return VALUE."
  (if secondname
      (let ((fcnpart (read secondname)))
	(if (fboundp fcnpart)
	    (let ((srecode-inserter-variable-current-dictionary dictionary))
	      (funcall fcnpart value))
	  ;; Else, warn.
Glenn Morris's avatar
Glenn Morris committed
428
	  (error "Variable insertion second arg %s is not a function"
Chong Yidong's avatar
Chong Yidong committed
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
		 secondname)))
    value))

(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
				  dictionary)
  "Insert the STI inserter."
  ;; Convert the name into a name/fcn pair
  (let* ((name (oref sti :object-name))
	 (fcnpart (oref sti :secondname))
	 (val (srecode-dictionary-lookup-name
	       dictionary name))
	 (do-princ t)
	 )
    ;; Alert if a macro wasn't found.
    (when (not val)
      (message "Warning: macro %S was not found in the dictionary." name)
      (setq val ""))
    ;; If there was a functional part, call that function.
    (cond ;; Strings
       ((stringp val)
	(setq val (srecode-insert-variable-secondname-handler
		   sti dictionary val fcnpart)))
       ;; Compound data value
       ((srecode-dictionary-compound-value-child-p val)
	;; Force FCN to be a symbol
	(when fcnpart (setq fcnpart (read fcnpart)))
	;; Convert compound value to a string with the fcn.
	(setq val (srecode-compound-toString val fcnpart dictionary))
	;; If the value returned is nil, then it may be a special
	;; field inserter that requires us to set do-princ to nil.
	(when (not val)
	  (setq do-princ nil)
	  )
	)
       ;; Dictionaries... not allowed in this style
       ((srecode-dictionary-child-p val)
Glenn Morris's avatar
Glenn Morris committed
465
	(error "Macro %s cannot insert a dictionary - use section macros instead"
Chong Yidong's avatar
Chong Yidong committed
466 467 468
	       name))
       ;; Other stuff... convert
       (t
Glenn Morris's avatar
Glenn Morris committed
469
	(error "Macro %s cannot insert arbitrary data" name)
Chong Yidong's avatar
Chong Yidong committed
470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495
	;;(if (and val (not (stringp val)))
	;;    (setq val (format "%S" val))))
	))
    ;; Output the dumb thing unless the type of thing specifically
    ;; did the inserting forus.
    (when do-princ
      (princ val))))

(defclass srecode-template-inserter-ask (srecode-template-inserter-variable)
  ((key :initform ??
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   (prompt :initarg :prompt
	   :initform nil
	   :documentation
	   "The prompt used to query for this dictionary value.")
   (defaultfcn :initarg :defaultfcn
	       :initform nil
	       :documentation
	       "The function which can calculate a default value.")
   (read-fcn :initarg :read-fcn
	     :initform 'read-string
	     :documentation
	     "The function used to read in the text for this prompt.")
   )
Juanma Barranquero's avatar
Juanma Barranquero committed
496
  "Insert the value of a dictionary entry.
Chong Yidong's avatar
Chong Yidong committed
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628
If there is no entry, prompt the user for the value to use.
The prompt text used is derived from the previous PROMPT command in the
template file.")

(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter-ask) STATE)
  "For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match."
  (let ((prompts (oref STATE prompts))
	)
    (while prompts
      (when (string= (semantic-tag-name (car prompts))
		     (oref ins :object-name))
	(oset ins :prompt
	      (semantic-tag-get-attribute (car prompts) :text))
	(oset ins :defaultfcn
	      (semantic-tag-get-attribute (car prompts) :default))
	(oset ins :read-fcn
	      (or (semantic-tag-get-attribute (car prompts) :read)
		  'read-string))
	)
      (setq prompts (cdr prompts)))
    ))

(defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
				  dictionary)
  "Insert the STI inserter."
  (let ((val (srecode-dictionary-lookup-name
	      dictionary (oref sti :object-name))))
    (if val
	;; Does some extra work.  Oh well.
	(call-next-method)

      ;; How is our -ask value determined?
      (if srecode-insert-with-fields-in-progress
	  ;; Setup editable fields.
	  (setq val (srecode-insert-method-field sti dictionary))
	;; Ask the question...
	(setq val (srecode-insert-method-ask sti dictionary)))

      ;; After asking, save in the dictionary so that
      ;; the user can use the same name again later.
      (srecode-dictionary-set-value
       (srecode-root-dictionary dictionary)
       (oref sti :object-name) val)

      ;; Now that this value is safely stowed in the dictionary,
      ;; we can do what regular inserters do.
      (call-next-method))))

(defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
				       dictionary)
  "Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
  (let ((defaultfcn (oref sti :defaultfcn)))
    (cond ((stringp defaultfcn)
	   defaultfcn)
	  ((functionp defaultfcn)
	   (funcall defaultfcn))
	  ((and (listp defaultfcn)
		(eq (car defaultfcn) 'macro))
	   (srecode-dictionary-lookup-name
	    dictionary (cdr defaultfcn)))
	  ((null defaultfcn)
	   "")
	  (t
	   (error "Unknown default for prompt: %S"
		  defaultfcn)))))

(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
				      dictionary)
  "Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values."
  (let* ((prompt (oref sti prompt))
	 (default (srecode-insert-ask-default sti dictionary))
	 (reader (oref sti :read-fcn))
	 (val nil)
	 )
    (cond ((eq reader 'y-or-n-p)
	   (if (y-or-n-p (or prompt
			     (format "%s? "
				     (oref sti :object-name))))
	       (setq val default)
	     (setq val "")))
	  ((eq reader 'read-char)
	   (setq val (format
		      "%c"
		      (read-char (or prompt
				     (format "Char for %s: "
					     (oref sti :object-name))))))
	   )
	  (t
	   (save-excursion
	     (setq val (funcall reader
				(or prompt
				    (format "Specify %s: "
					    (oref sti :object-name)))
				default
				)))))
    ;; Return our derived value.
    val)
  )

(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
					dictionary)
  "Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values."
  (let* ((default (srecode-insert-ask-default sti dictionary))
	 (compound-value
	  (srecode-field-value (oref sti :object-name)
			       :firstinserter sti
			       :defaultvalue default))
	 )
    ;; Return this special compound value as the thing to insert.
    ;; This special compound value will repeat our asked question
    ;; across multiple locations.
    compound-value))

(defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
  "Dump the state of the SRecode template inserter INS."
  (call-next-method)
  (princ " : \"")
  (princ (oref ins prompt))
  (princ "\"")
  )

(defclass srecode-template-inserter-width (srecode-template-inserter-variable)
  ((key :initform ?|
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   )
  "Inserts the value of a dictionary variable with a specific width.
Juanma Barranquero's avatar
Juanma Barranquero committed
629 630
The second argument specifies the width, and a pad, separated by a colon.
Thus a specification of `10:left' will insert the value of A
Chong Yidong's avatar
Chong Yidong committed
631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657
to 10 characters, with spaces added to the left.  Use `right' for adding
spaces to the right.")

(defmethod srecode-insert-variable-secondname-handler
  ((sti srecode-template-inserter-width) dictionary value width)
  "For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
By default, treat as a function name."
  (if width
      ;; Trim or pad to new length
      (let* ((split (split-string width ":"))
	     (width (string-to-number (nth 0 split)))
	     (second (nth 1 split))
	     (pad (cond ((or (null second) (string= "right" second))
			 'right)
			((string= "left" second)
			 'left)
			(t
			 (error "Unknown pad type %s" second)))))
	(if (>= (length value) width)
	    ;; Simple case - too long.
	    (substring value 0 width)
	  ;; We need to pad on one side or the other.
	  (let ((padchars (make-string (- width (length value)) ? )))
	    (if (eq pad 'left)
		(concat padchars value)
	      (concat value padchars)))))
Glenn Morris's avatar
Glenn Morris committed
658
    (error "Width not specified for variable/width inserter")))
Chong Yidong's avatar
Chong Yidong committed
659 660 661 662 663 664 665 666 667 668 669 670 671

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (princ "   ")
  (princ escape-start)
  (princ "|A:10:right")
  (princ escape-end)
  (terpri)
  )

(defvar srecode-template-inserter-point-override nil
Glenn Morris's avatar
Glenn Morris committed
672
  "When non-nil, the point inserter will do this function instead.")
Chong Yidong's avatar
Chong Yidong committed
673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773

(defclass srecode-template-inserter-point (srecode-template-inserter)
  ((key :initform ?^
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   (point :type (or null marker)
	  :allocation :class
	  :documentation
	  "Record the value of (point) in this class slot.
It is the responsibility of the inserter algorithm to clear this
after a successful insertion."))
  "Record the value of (point) when inserted.
The cursor is placed at the ^ macro after insertion.
Some inserter macros, such as `srecode-template-inserter-include-wrap'
will place text at the ^ macro from the included macro.")

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (princ "   ")
  (princ escape-start)
  (princ "^")
  (princ escape-end)
  (terpri)
  )

(defmethod srecode-insert-method ((sti srecode-template-inserter-point)
				  dictionary)
  "Insert the STI inserter.
Save point in the class allocated 'point' slot.
If `srecode-template-inserter-point-override' then this generalized
marker will do something else.  See `srecode-template-inserter-include-wrap'
as an example."
  (if srecode-template-inserter-point-override
      ;; Disable the old override while we do this.
      (let ((over srecode-template-inserter-point-override)
	    (srecode-template-inserter-point-override nil))
	(funcall over dictionary)
	)
    (oset sti point (point-marker))
    ))

(defclass srecode-template-inserter-subtemplate (srecode-template-inserter)
  ()
  "Wrap a section of a template under the control of a macro."
  :abstract t)

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (call-next-method)
  (princ "     Template Text to control")
  (terpri)
  (princ "   ")
  (princ escape-start)
  (princ "/VARNAME")
  (princ escape-end)
  (terpri)
  )

(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
				       dict slot)
  "Insert a subtemplate for the inserter STI with dictionary DICT."
  ;; make sure that only dictionaries are used.
  (when (not (srecode-dictionary-child-p dict))
    (error "Only section dictionaries allowed for %s"
	   (object-name-string sti)))
  ;; Output the code from the sub-template.
  (srecode-insert-method (slot-value sti slot) dict)
  )

(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
					 dictionary slot)
  "Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation.
The template to insert is stored in SLOT."
  (let ((dicts (srecode-dictionary-lookup-name
		dictionary (oref sti :object-name))))
    ;; If there is no section dictionary, then don't output anything
    ;; from this section.
    (while dicts
      (srecode-insert-subtemplate sti (car dicts) slot)
      (setq dicts (cdr dicts)))))

(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
				  dictionary)
  "Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class."
  (srecode-insert-method-helper sti dictionary 'template))


(defclass srecode-template-inserter-section-start (srecode-template-inserter-subtemplate)
  ((key :initform ?#
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   (template :initarg :template
	     :documentation
Juanma Barranquero's avatar
Juanma Barranquero committed
774
	     "A template used to frame the codes from this inserter.")
Chong Yidong's avatar
Chong Yidong committed
775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808
   )
  "Apply values from a sub-dictionary to a template section.
The dictionary saved at the named dictionary entry will be
applied to the text between the section start and the
`srecode-template-inserter-section-end' macro.")

(defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
				tag input STATE)
  "For the section inserter INS, parse INPUT.
Shorten input until the END token is found.
Return the remains of INPUT."
  (let* ((out (srecode-compile-split-code tag input STATE
					  (oref ins :object-name))))
    (oset ins template (srecode-template
			(object-name-string ins)
			:context nil
			:args nil
			:code (cdr out)))
    (car out)))

(defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
  "Dump the state of the SRecode template inserter INS."
  (call-next-method)
  (princ "\n")
  (srecode-dump-code-list (oref (oref ins template) code)
			  (concat indent "    "))
  )

(defclass srecode-template-inserter-section-end (srecode-template-inserter)
  ((key :initform ?/
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   )
Juanma Barranquero's avatar
Juanma Barranquero committed
809
  "All template segments between the section-start and section-end
Chong Yidong's avatar
Chong Yidong committed
810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854
are treated specially.")

(defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
				  dictionary)
  "Insert the STI inserter."
  )

(defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)

  "For the template inserter INS, do I end a section called NAME?"
  (string= name (oref ins :object-name)))

(defclass srecode-template-inserter-include (srecode-template-inserter-subtemplate)
  ((key :initform ?>
	:allocation :class
	:documentation
	"The character code used to identify inserters of this style.")
   (includedtemplate
    :initarg :includedtemplate
    :documentation
    "The template included for this inserter."))
   "Include a different template into this one.
The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.")

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (princ "   ")
  (princ escape-start)
  (princ ">DICTNAME:contextname:templatename")
  (princ escape-end)
  (terpri)
  )

(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
					  dictionary)
  "For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
this template instance."
  (let* ((templatenamepart (oref sti :secondname))
	 )
    ;; If there was no template name, throw an error
    (if (not templatenamepart)
Glenn Morris's avatar
Glenn Morris committed
855
	(error "Include macro %s needs a template name" (oref sti :object-name)))
Chong Yidong's avatar
Chong Yidong committed
856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883
    ;; Find the template by name, and save it.
    (if (or (not (slot-boundp sti 'includedtemplate))
	    (not (oref sti includedtemplate)))
	(let ((tmpl (srecode-template-get-table (srecode-table)
						templatenamepart))
	      (active (oref srecode-template active))
	      ctxt)
	  (when (not tmpl)
	    ;; If it isn't just available, scan back through
	    ;; the active template stack, searching for a matching
	    ;; context.
	    (while (and (not tmpl) active)
	      (setq ctxt (oref (car active) context))
	      (setq tmpl (srecode-template-get-table (srecode-table)
						     templatenamepart
						     ctxt))
	      (when (not tmpl)
		(when (slot-boundp (car active) 'table)
		  (let ((app (oref (oref (car active) table) application)))
		    (when app
		      (setq tmpl (srecode-template-get-table
				  (srecode-table)
				  templatenamepart
				  ctxt app)))
		    )))
	      (setq active (cdr active)))
	    (when (not tmpl)
	      ;; If it wasn't in this context, look to see if it
Juanma Barranquero's avatar
Juanma Barranquero committed
884
	      ;; defines its own context
Chong Yidong's avatar
Chong Yidong committed
885 886 887 888 889 890 891 892 893 894 895 896 897 898 899
	      (setq tmpl (srecode-template-get-table (srecode-table)
						     templatenamepart)))
	    )
	  (oset sti :includedtemplate tmpl)))

    (if (not (oref sti includedtemplate))
	;; @todo - Call into a debugger to help find the template in question.
	(error "No template \"%s\" found for include macro `%s'"
	       templatenamepart (oref sti :object-name)))
    ))

(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
				  dictionary)
  "Insert the STI inserter.
Finds the template with this macro function part, and inserts it
Juanma Barranquero's avatar
Juanma Barranquero committed
900
with the dictionaries found in the dictionary."
Chong Yidong's avatar
Chong Yidong committed
901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954
  (srecode-insert-include-lookup sti dictionary)
  ;; Insert the template.
  ;; Our baseclass has a simple way to do this.
  (if (srecode-dictionary-lookup-name dictionary (oref sti :object-name))
      ;; If we have a value, then call the next method
      (srecode-insert-method-helper sti dictionary 'includedtemplate)
    ;; If we don't have a special dictitonary, then just insert with the
    ;; current dictionary.
    (srecode-insert-subtemplate sti dictionary 'includedtemplate))
  )

;;
;; This template combines the include template and the sectional template.
;; It will first insert the included template, then insert the embedded
;; template wherever the $^$ in the included template was.
;;
;; Since it uses dual inheretance, it will magically get the end-matching
;; behavior of #, with the including feature of >.
;;
(defclass srecode-template-inserter-include-wrap (srecode-template-inserter-include srecode-template-inserter-section-start)
   ((key :initform ?<
	 :allocation :class
	 :documentation
	 "The character code used to identify inserters of this style.")
    )
   "Include a different template into this one, and add text at the ^ macro.
The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.  If the included macro includes a ^ macro,
then the text between this macro and the end macro will be inserted at
the ^ macro.")

(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap)
						  escape-start escape-end)
  "Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
  (princ "   ")
  (princ escape-start)
  (princ "<DICTNAME:contextname:templatename")
  (princ escape-end)
  (terpri)
  (princ "     Template Text to insert at ^ macro")
  (terpri)
  (princ "   ")
  (princ escape-start)
  (princ "/DICTNAME")
  (princ escape-end)
  (terpri)
  )

(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
				  dictionary)
  "Insert the template STI.
This will first insert the include part via inheritance, then
insert the section it wraps into the location in the included
Juanma Barranquero's avatar
Juanma Barranquero committed
955
template where a ^ inserter occurs."
Chong Yidong's avatar
Chong Yidong committed
956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982
  ;; Step 1: Look up the included inserter
  (srecode-insert-include-lookup sti dictionary)
  ;; Step 2: Temporarilly override the point inserter.
  (let* ((vaguely-unique-name sti)
	 (srecode-template-inserter-point-override
	  (lambda (dict2)
	    (if (srecode-dictionary-lookup-name
		 dict2 (oref vaguely-unique-name :object-name))
		;; Insert our sectional part with looping.
		(srecode-insert-method-helper
		 vaguely-unique-name dict2 'template)
	      ;; Insert our sectional part just once.
	      (srecode-insert-subtemplate vaguely-unique-name
					  dict2 'template))
	   )))
    ;; Do a regular insertion for an include, but with our override in
    ;; place.
    (call-next-method)
    ))

(provide 'srecode/insert)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "srecode/insert"
;; End:

Miles Bader's avatar
Miles Bader committed
983
;; arch-tag: a5aa3401-924a-4617-8513-2f0f01256872
Chong Yidong's avatar
Chong Yidong committed
984
;;; srecode/insert.el ends here