src/code/format-directive.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB!FORMAT")
  11 \f
  12 (define-condition format-error (error reference-condition)
  13   ((complaint :reader format-error-complaint :initarg :complaint)
  14    (args :reader format-error-args :initarg :args :initform nil)
  15    (control-string :reader format-error-control-string
  16                    :initarg :control-string
  17                    :initform *default-format-error-control-string*)
  18    (offset :reader format-error-offset :initarg :offset
  19            :initform *default-format-error-offset*)
  20    (second-relative :reader format-error-second-relative
  21                     :initarg :second-relative :initform nil)
  22    (print-banner :reader format-error-print-banner :initarg :print-banner
  23                  :initform t))
  24   (:report %print-format-error)
  25   (:default-initargs :references nil))
  26
  27 (defun %print-format-error (condition stream)
  28   (format stream
  29           "~:[~*~;error in ~S: ~]~?~@[~%  ~A~%  ~V@T^~@[~V@T^~]~]"
  30           (format-error-print-banner condition)
  31           'format
  32           (format-error-complaint condition)
  33           (format-error-args condition)
  34           (format-error-control-string condition)
  35           (format-error-offset condition)
  36           (format-error-second-relative condition)))
  37
  38 (defun format-error* (complaint args &rest initargs &key &allow-other-keys)
  39   (apply #'error 'format-error :complaint complaint :args args initargs))
  40
  41 (defun format-error (complaint &rest args)
  42   (format-error* complaint args))
  43
  44 (defun format-error-at* (control-string offset complaint args
  45                          &rest initargs &key &allow-other-keys)
  46   (apply #'error 'format-error
  47          :complaint complaint :args args
  48          :control-string (or control-string *default-format-error-control-string*)
  49          :offset (or offset *default-format-error-offset*)
  50          initargs))
  51
  52 (defun format-error-at (control-string offset complaint &rest args)
  53   (format-error-at* control-string offset complaint args))
  54
  55 \f
  56 (defstruct format-directive
  57   (string (missing-arg) :type simple-string)
  58   (start (missing-arg) :type (and unsigned-byte fixnum))
  59   (end (missing-arg) :type (and unsigned-byte fixnum))
  60   (character (missing-arg) :type character)
  61   (colonp nil :type (member t nil))
  62   (atsignp nil :type (member t nil))
  63   (params nil :type list))
  64 (defmethod print-object ((x format-directive) stream)
  65   (print-unreadable-object (x stream)
  66     (write-string (format-directive-string x)
  67                   stream
  68                   :start (format-directive-start x)
  69                   :end (format-directive-end x))))
  70
  71 (defun check-modifier (modifier-name value)
  72   (when value
  73     (let ((modifiers (ensure-list modifier-name)))
  74       (format-error "The ~{~A~^ and the ~} modifier~P cannot be used ~
  75                      ~:*~[~;~;simultaneously ~]with this directive."
  76                     modifiers (length modifiers)))))