106 lines
4.6 KiB
Common Lisp
106 lines
4.6 KiB
Common Lisp
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HTML-TEMPLATE-LISP; Base: 10 -*-
|
|
;;; $Header: /usr/local/cvsrep/html-template/errors.lisp,v 1.8 2007-01-01 23:49:16 edi Exp $
|
|
|
|
;;; Copyright (c) 2003-2007, Dr. Edmund Weitz. All rights reserved.
|
|
|
|
;;; Redistribution and use in source and binary forms, with or without
|
|
;;; modification, are permitted provided that the following conditions
|
|
;;; are met:
|
|
|
|
;;; * Redistributions of source code must retain the above copyright
|
|
;;; notice, this list of conditions and the following disclaimer.
|
|
|
|
;;; * Redistributions in binary form must reproduce the above
|
|
;;; copyright notice, this list of conditions and the following
|
|
;;; disclaimer in the documentation and/or other materials
|
|
;;; provided with the distribution.
|
|
|
|
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
|
|
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
|
|
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
|
|
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
|
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
(in-package #:html-template)
|
|
|
|
(defstruct syntax-error-location
|
|
"Structure to store parser locations consisting of a stream, a line
|
|
number, and a column number."
|
|
line col stream)
|
|
|
|
(defvar *syntax-error-location* (make-syntax-error-location)
|
|
"Used internally to remember the last position which made sense to
|
|
the parser.")
|
|
|
|
(define-condition template-error (simple-error)
|
|
()
|
|
(:documentation "All errors signaled by HTML-TEMPLATE are of
|
|
this type."))
|
|
|
|
(define-condition template-invocation-error (template-error)
|
|
()
|
|
(:documentation "Signaled when HTML-TEMPLATE functions are
|
|
invoked with wrong arguments."))
|
|
|
|
(define-condition template-missing-value-error (template-error)
|
|
()
|
|
(:documentation "Signaled when a TMPL_VAR printer is provided
|
|
with a NIL value and *CONVERT-NIL-TO-EMPTY-STRING* is false."))
|
|
|
|
(define-condition template-not-a-string-error (template-error)
|
|
((value :initarg :value
|
|
:reader template-not-a-string-error-value))
|
|
(:documentation "Signaled when a TMPL_VAR printer is provided
|
|
with a non-string value."))
|
|
|
|
(define-condition template-syntax-error (template-error)
|
|
((line :initarg :line
|
|
:reader template-syntax-error-line)
|
|
(col :initarg :col
|
|
:reader template-syntax-error-col)
|
|
(stream :initarg :stream
|
|
:reader template-syntax-error-stream))
|
|
(:default-initargs
|
|
:line (syntax-error-location-line *syntax-error-location*)
|
|
:col (syntax-error-location-col *syntax-error-location*)
|
|
:stream (syntax-error-location-stream *syntax-error-location*))
|
|
(:report (lambda (condition stream)
|
|
(format stream "~?~%[Line ~A, column ~A, stream ~A]"
|
|
(simple-condition-format-control condition)
|
|
(simple-condition-format-arguments condition)
|
|
(template-syntax-error-line condition)
|
|
(template-syntax-error-col condition)
|
|
(template-syntax-error-stream condition))))
|
|
(:documentation "Signaled when a syntax error occurs while
|
|
parsing a template."))
|
|
|
|
(defmacro signal-template-invocation-error (format-control &rest format-arguments)
|
|
`(error 'template-invocation-error
|
|
:format-control ,format-control
|
|
:format-arguments (list ,@format-arguments)))
|
|
|
|
(defmacro signal-template-missing-value-error (format-control &rest format-arguments)
|
|
`(error 'template-missing-value-error
|
|
:format-control ,format-control
|
|
:format-arguments (list ,@format-arguments)))
|
|
|
|
(defmacro signal-template-syntax-error (format-control &rest format-arguments)
|
|
`(error 'template-syntax-error
|
|
:format-control ,format-control
|
|
:format-arguments (list ,@format-arguments)))
|
|
|
|
(defmacro with-syntax-error-location ((&rest rest) &body body)
|
|
"This is wrapped around forms in order to remember a meaningful
|
|
position within the stream in case an error has to be signaled."
|
|
(declare (ignore rest))
|
|
`(let ((*syntax-error-location* (make-syntax-error-location
|
|
:line *current-line*
|
|
:col *current-column*
|
|
:stream *standard-input*)))
|
|
,@body))
|