other
(in-package "XDOC")
other
(include-book "std/util/bstar" :dir :system)
other
(include-book "std/strings/defs-program" :dir :system)
other
(program)
normalize-whitespace-auxfunction
(defun normalize-whitespace-aux (x n xl acc) (b* (((when (>= n xl)) acc) (char-n (char x n)) (whitespace '(#\ #\ #\ #\ #\ )) (sentence-ends '(#\. #\! #\?)) (closers '(#\" #\' #\` #\) #\] #\} #\>)) (acc (cond ((not (member char-n whitespace)) (cons char-n acc)) ((or (>= (+ n 1) xl) (not (member (char x (+ n 1)) whitespace)) (and (>= n 1) (or (member (char x (- n 1)) sentence-ends) (and (>= n 2) (member (char x (- n 1)) closers) (member (char x (- n 2)) sentence-ends))))) (cons #\ acc)) (t acc)))) (normalize-whitespace-aux x (+ n 1) xl acc)))
normalize-whitespacefunction
(defun normalize-whitespace (x) (declare (type string x)) (rchars-to-string (normalize-whitespace-aux x 0 (length x) nil)))
other
(defconst *escape-char* (code-char 27))
extend-col-for-sgrfunction
(defun extend-col-for-sgr (x n col) (let* ((n+1 (+ n 1)) (p (search "m" x :start2 n+1))) (cond ((and p (eql (char x n+1) #\[)) (+ col (1+ (- p n)))) (t (er hard 'word-wrap-paragraph-aux "Found unexpected escape character at position ~x0 in ~ string:~|~x1" n x)))))
add-word-to-paragraphfunction
(defun add-word-to-paragraph (x n xl col next-wrap-col acc) "Returns (MV N COL ACC)" (b* (((when (>= n xl)) (mv n col next-wrap-col acc)) (char-n (char x n)) ((when (eql char-n #\ )) (mv n col next-wrap-col acc))) (add-word-to-paragraph x (+ n 1) xl (+ 1 col) (if (eql char-n *escape-char*) (extend-col-for-sgr x n next-wrap-col) next-wrap-col) (cons char-n acc))))
remove-spaces-from-frontfunction
(defun remove-spaces-from-front (x) (if (atom x) x (if (eql (car x) #\ ) (remove-spaces-from-front (cdr x)) x)))
word-wrap-paragraph-auxfunction
(defun word-wrap-paragraph-aux (x n xl col next-wrap-col wrap-col indent acc) (b* (((when (>= n xl)) acc) (char-n (char x n)) ((when (eql char-n #\ )) (word-wrap-paragraph-aux x (+ n 1) xl (+ col 1) next-wrap-col wrap-col indent (cons char-n acc))) ((mv spec-n spec-col next-wrap-col spec-acc) (add-word-to-paragraph x n xl col next-wrap-col acc)) ((when (or (< spec-col next-wrap-col) (= col indent))) (word-wrap-paragraph-aux x spec-n xl spec-col next-wrap-col wrap-col indent spec-acc)) (acc (remove-spaces-from-front acc)) (acc (cons #\ acc)) (acc (append (make-list indent :initial-element #\ ) acc))) (word-wrap-paragraph-aux x n xl indent wrap-col wrap-col indent acc)))
word-wrap-paragraphfunction
(defun word-wrap-paragraph (x indent wrap-col) (let* ((acc (word-wrap-paragraph-aux x 0 (length x) 0 wrap-col wrap-col indent nil)) (acc (remove-spaces-from-front acc)) (acc (reverse acc)) (acc (remove-spaces-from-front acc))) (implode acc)))