Filtering...

xdoc-error

books/xdoc/xdoc-error
other
(in-package "XDOC")
initialize-xdoc-errorsfunction
(defun initialize-xdoc-errors
  (flg)
  (declare (xargs :guard (member-eq flg '(t nil :same))))
  (cond ((eq flg :same) (wormhole-eval 'xdoc-errors
        '(lambda (whs)
          (let* ((old (wormhole-data whs)) (new (if old
                  0
                  nil)))
            (set-wormhole-data whs new)))
        nil))
    (flg (wormhole-eval 'xdoc-errors
        '(lambda (whs) (set-wormhole-data whs 0))
        nil))
    (t (wormhole-eval 'xdoc-errors
        '(lambda (whs) (set-wormhole-data whs nil))
        nil))))
show-xdoc-errorsfunction
(defun show-xdoc-errors
  nil
  (wormhole-eval 'xdoc-errors
    '(lambda (whs)
      (prog2$ (cw "Value of xdoc-errors: ~x0~%"
          (wormhole-data whs))
        whs))
    nil))
report-xdoc-errorsfunction
(defun report-xdoc-errors
  (ctx)
  (declare (xargs :guard t))
  (prog2$ (wormhole-eval 'xdoc-errors
      '(lambda (whs)
        (let* ((old (wormhole-data whs)) (new (cond ((natp old) (- old))
                ((integerp old) 0)
                (t nil))))
          (set-wormhole-data whs new)))
      nil)
    (wormhole-eval 'xdoc-errors
      '(lambda (whs)
        (let* ((data (wormhole-data whs)) (count (if (integerp data)
                (- data)
                0)))
          (cond ((> count 0) (er hard?
                ctx
                "at least one syntax error was encountered by ~
                              XDOC; search above for "xdoc error" (but the ~
                              same error may be reported more than once)."))
            (t whs))))
      count)))
note-xdoc-errorfunction
(defun note-xdoc-error
  nil
  (declare (xargs :guard t))
  (wormhole-eval 'xdoc-errors
    '(lambda (whs)
      (let ((count (wormhole-data whs)))
        (and count
          (set-wormhole-data whs (1+ (nfix count))))))
    nil))
other
(encapsulate (((print-xdoc-error * *) =>
     *
     :formals (str args)
     :guard (and (stringp str) (true-listp args))))
  (local (defun print-xdoc-error
      (str args)
      (declare (xargs :guard (and (stringp str) (true-listp args))))
      (declare (ignore str args))
      nil))
  (defthm print-xdoc-error-is-nil
    (equal (print-xdoc-error str args) nil)))
print-xdoc-error-defaultfunction
(defun print-xdoc-error-default
  (str args)
  (declare (xargs :guard (and (stringp str) (true-listp args))))
  (fmt-to-comment-window str
    (pairlis2 *base-10-chars* args)
    0
    nil
    nil))
other
(defattach print-xdoc-error
  print-xdoc-error-default)
xdoc-errormacro
(defmacro xdoc-error
  (str ctx &rest args)
  (declare (xargs :guard (stringp str)))
  `(prog2$ (note-xdoc-error)
    (print-xdoc-error (concatenate 'string
        "; xdoc error in ~x0: "
        ,XDOC::STR
        "~%")
      (list ,XDOC::CTX . ,XDOC::ARGS))))