+ (let* ((directive (parse-directive string next-directive))
+ (char (format-directive-character directive)))
+ ;; this processing is required by CLHS 22.3.5.2
+ (cond
+ ((char= char #\<) (push directive block))
+ ((and block (char= char #\;) (format-directive-colonp directive))
+ (setf semicolon directive))
+ ((char= char #\>)
+ (aver block)
+ (cond
+ ((format-directive-colonp directive)
+ (unless pprint
+ (setf pprint (car block)))
+ (setf semicolon nil))
+ (semicolon
+ (unless justification-semicolon
+ (setf justification-semicolon semicolon))))
+ (pop block))
+ ;; block cases are handled by the #\< expander/interpreter
+ ((not block)
+ (case char
+ ((#\W #\I #\_) (unless pprint (setf pprint directive)))
+ (#\T (when (and (format-directive-colonp directive)
+ (not pprint))
+ (setf pprint directive))))))