-;;; srecode/insert --- Insert srecode templates to an output stream.
+;;; srecode/insert.el --- Insert srecode templates to an output stream.
-;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2012 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(require 'srecode/find)
(require 'srecode/dictionary)
(require 'srecode/args)
+(require 'srecode/filters)
(defvar srecode-template-inserter-point)
(declare-function srecode-overlaid-activate "srecode/fields")
;; area. Return value is not important.
))
+(declare-function data-debug-new-buffer "data-debug")
+(declare-function data-debug-insert-stuff-list "data-debug")
+(declare-function data-debug-insert-thing dictionary "data-debug")
+
+(defun srecode-insert-show-error-report (dictionary format &rest args)
+ "Display an error report based on DICTIONARY, FORMAT and ARGS.
+This is intended to diagnose problems with failed template
+insertions."
+ (with-current-buffer (data-debug-new-buffer "*SRECODE INSERTION ERROR*")
+ (erase-buffer)
+ ;; Insert the stack of templates that are currently being
+ ;; inserted.
+ (insert (propertize "Template Stack" 'face '(:weight bold))
+ (propertize " (most recent at bottom)" 'face '(:slant italic))
+ ":\n")
+ (data-debug-insert-stuff-list
+ (reverse (oref srecode-template active)) "> ")
+ ;; Show the current dictionary.
+ (insert (propertize "Dictionary" 'face '(:weight bold)) "\n")
+ (data-debug-insert-thing dictionary "" "> ")
+ ;; Show the error message.
+ (insert (propertize "Error" 'face '(:weight bold)) "\n")
+ (insert (apply #'format format args))
+ (pop-to-buffer (current-buffer))))
+
+(defun srecode-insert-report-error (dictionary format &rest args)
+ ;; TODO only display something when inside an interactive call?
+ (srecode-insert-show-error-report dictionary format args)
+ (apply #'error format args))
+
;;; TEMPLATE ARGUMENTS
;;
;; Some templates have arguments. Each argument is associated with
(let ((c (oref st code)))
(srecode-push st)
(srecode-insert-code-stream c dictionary))
- ;; Poping the stack is protected
+ ;; Popping the stack is protected.
(srecode-pop st)))
(defun srecode-insert-code-stream (code dictionary)
(setq doit nil)))
(goto-char pm)
)
- ;; Do indentation reguardless of the newline.
+ ;; Do indentation regardless of the newline.
(when (and (eq i t) inbuff)
(indent-according-to-mode)
(goto-char pm))
(let ((srecode-inserter-variable-current-dictionary dictionary))
(funcall fcnpart value))
;; Else, warn.
- (error "Variable insertion second arg %s is not a function"
- secondname)))
+ (srecode-insert-report-error
+ dictionary
+ "Variable inserter %s: second argument `%s' is not a function"
+ (object-print sti) secondname)))
value))
(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
;; 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)
- )
- )
+ (setq do-princ nil)))
+
;; Dictionaries... not allowed in this style
((srecode-dictionary-child-p val)
- (error "Macro %s cannot insert a dictionary - use section macros instead"
- name))
+ (srecode-insert-report-error
+ dictionary
+ "Macro %s cannot insert a dictionary - use section macros instead"
+ name))
+
;; Other stuff... convert
(t
- (error "Macro %s cannot insert arbitrary data" name)
- ;;(if (and val (not (stringp val)))
- ;; (setq val (format "%S" val))))
- ))
+ (srecode-insert-report-error
+ dictionary
+ "Macro %s cannot insert arbitrary data" name)))
;; Output the dumb thing unless the type of thing specifically
;; did the inserting for us.
(when do-princ
"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)))))
+ (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
+ (srecode-insert-report-error
+ dictionary
+ "Unknown default for prompt: %S" defaultfcn)))))
(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary)
"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)))))
- (error "Width not specified for variable/width inserter")))
+ ;; Cannot work without width.
+ (unless width
+ (srecode-insert-report-error
+ dictionary
+ "Width not specified for variable/width inserter"))
+
+ ;; 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
+ (srecode-insert-report-error
+ dictionary
+ "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))))))
(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
escape-start escape-end)
(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)))
+ ;; Make sure that only dictionaries are used.
+ (unless (srecode-dictionary-child-p dict)
+ (srecode-insert-report-error
+ dict
+ "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)
- )
+ (srecode-insert-method (slot-value sti slot) dict))
(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot)
(let ((dicts (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(when (not (listp dicts))
- (error "Cannot insert section %S from non-section variable."
- (oref sti :object-name)))
+ (srecode-insert-report-error
+ dictionary
+ "Cannot insert section %S from non-section variable."
+ (oref sti :object-name)))
;; If there is no section dictionary, then don't output anything
;; from this section.
(while dicts
(when (not (srecode-dictionary-p (car dicts)))
- (error "Cannot insert section %S from non-section variable."
- (oref sti :object-name)))
+ (srecode-insert-report-error
+ dictionary
+ "Cannot insert section %S from non-section variable."
+ (oref sti :object-name)))
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
"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)
- (error "Include macro %s needs a template name" (oref sti :object-name)))
+ (let ((templatenamepart (oref sti :secondname)))
+ ;; If there was no template name, throw an error.
+ (unless templatenamepart
+ (srecode-insert-report-error
+ dictionary
+ "Include macro `%s' needs a template name"
+ (oref sti :object-name)))
;; NOTE: We used to cache the template and not look it up a second time,
;; but changes in the template tables can change which template is
(setq active (cdr active)))
(when (not tmpl)
;; If it wasn't in this context, look to see if it
- ;; defines it's own context
+ ;; defines its own context
(setq tmpl (srecode-template-get-table (srecode-table)
templatenamepart)))
)
;; Store the found template into this object for later use.
(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)))
- ))
+ (unless (oref sti includedtemplate)
+ ;; @todo - Call into a debugger to help find the template in question.
+ (srecode-insert-report-error
+ dictionary
+ "No template \"%s\" found for include macro `%s'"
+ templatenamepart (oref sti :object-name)))))
(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary)
(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
+ ;; If we don't have a special dictionary, then just insert with the
;; current dictionary.
(srecode-insert-subtemplate sti dictionary 'includedtemplate))
)
;; 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
+;; Since it uses dual inheritance, 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)