- (cond ((escapep char)
- ;; It can't be a number, even if it's 1\23.
- ;; Read next char here, so it won't be casified.
- (push *ouch-ptr* escapes)
- (let ((nextchar (read-char stream nil *eof-object*)))
- (if (eofp nextchar)
- (reader-eof-error stream "after escape character")
- (ouch-read-buffer nextchar))))
- ((multiple-escape-p char)
- ;; Read to next multiple-escape, escaping single chars
- ;; along the way.
- (loop
- (let ((ch (read-char stream nil *eof-object*)))
- (cond
- ((eofp ch)
- (reader-eof-error stream "inside extended token"))
- ((multiple-escape-p ch) (return))
- ((escapep ch)
- (let ((nextchar (read-char stream nil *eof-object*)))
- (cond ((eofp nextchar)
- (reader-eof-error stream "after escape character"))
- (t
- (push *ouch-ptr* escapes)
- (ouch-read-buffer nextchar)))))
- (t
- (push *ouch-ptr* escapes)
- (ouch-read-buffer ch))))))
- (t
- (when (and (constituentp char)
- (eql (get-secondary-attribute char)
- +char-attr-package-delimiter+)
- (not colon))
- (setq colon *ouch-ptr*))
- (ouch-read-buffer char))))))
+ (cond ((single-escape-p char)
+ ;; It can't be a number, even if it's 1\23.
+ ;; Read next char here, so it won't be casified.
+ (push *ouch-ptr* escapes)
+ (let ((nextchar (read-char stream nil *eof-object*)))
+ (if (eofp nextchar)
+ (reader-eof-error stream "after escape character")
+ (ouch-read-buffer nextchar))))
+ ((multiple-escape-p char)
+ ;; Read to next multiple-escape, escaping single chars
+ ;; along the way.
+ (loop
+ (let ((ch (read-char stream nil *eof-object*)))
+ (cond
+ ((eofp ch)
+ (reader-eof-error stream "inside extended token"))
+ ((multiple-escape-p ch) (return))
+ ((single-escape-p ch)
+ (let ((nextchar (read-char stream nil *eof-object*)))
+ (cond ((eofp nextchar)
+ (reader-eof-error stream "after escape character"))
+ (t
+ (push *ouch-ptr* escapes)
+ (ouch-read-buffer nextchar)))))
+ (t
+ (push *ouch-ptr* escapes)
+ (ouch-read-buffer ch))))))
+ (t
+ (when (and (constituentp char)
+ (eql (get-constituent-trait char)
+ +char-attr-package-delimiter+)
+ (not colon))
+ (setq colon *ouch-ptr*))
+ (ouch-read-buffer char))))))