Filtering...

word-wrap

books/xdoc/word-wrap
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))
other
(defconst *sgr-prefix*
  (coerce (list *escape-char* #\[) 'string))
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)))