Find file
Fetching contributors…
Cannot retrieve contributors at this time
190 lines (165 sloc) 5.19 KB
;;;; linebreaker.lisp
(defpackage #:linebreaker
(:use #:cl)
(:export #:make-break-stream
(:export #:*default-wide-break-chars*
(in-package #:linebreaker)
;;; break-stream
(defclass break-stream ()
:initarg :input
:accessor input)
:initarg :pos
:initform 0
:accessor pos
"The position of the next object to return from INPUT.")
:initarg :output-start
:initform 0
:accessor output-start
"The start of the current output subsequence.")
:initarg :output-end
:accessor output-end
:initform nil
"The end of the current output subsequence.")
:initarg :input-resume
:accessor input-resume
:initform nil
"The POS after a revert.")
:initarg :lines
:accessor lines
:initform nil)))
(defun make-break-stream (input)
(make-instance 'break-stream :input input))
(defgeneric finished (break-stream)
(:method (break-stream)
(<= (length (input break-stream)) (pos break-stream))))
(defgeneric advance (break-stream)
(:method (break-stream)
(unless (finished break-stream)
(aref (input break-stream) (pos break-stream))
(incf (pos break-stream))))))
(defgeneric mark-break (break-stream)
(:method (break-stream)
(let ((pos (pos break-stream)))
(setf (output-end break-stream) pos
(input-resume break-stream) pos)
(defgeneric mark-wide-break (break-stream)
(:method (break-stream)
(let ((pos (pos break-stream)))
(setf (output-end break-stream) (1- pos)
(input-resume break-stream) pos))))
(defgeneric break-line (break-stream)
(:method (break-stream)
(let ((start (output-start break-stream))
(end (or (output-end break-stream) (1- (pos break-stream)))))
(when (and (<= end start)
(not (output-end break-stream)))
(error "Empty line break"))
(let ((line (subseq (input break-stream) start end)))
(push line (lines break-stream))
(cond ((input-resume break-stream)
(setf (pos break-stream) (input-resume break-stream)))
(decf (pos break-stream))))
(setf (output-start break-stream) (pos break-stream))
;; clear marks
(setf (output-end break-stream) nil
(input-resume break-stream) nil)
(defgeneric finish (break-stream)
(:method (break-stream)
(let ((start (output-start break-stream))
(end (min (pos break-stream)
(length (input break-stream)))))
(push (subseq (input break-stream) start end)
(lines break-stream))
(nreverse (lines break-stream)))))
;;; Strategies
(defvar *default-wide-break-chars*
(defvar *default-new-line-chars*
(defvar *default-break-chars*
(defclass breaker-strategy ()
:initarg :wide-break-chars
:accessor wide-break-chars)
:initarg :new-line-chars
:accessor new-line-chars)
:initarg :break-chars
:accessor break-chars)
:initarg :line-width
:accessor line-width))
:wide-break-chars *default-wide-break-chars*
:new-line-chars *default-new-line-chars*
:break-chars *default-break-chars*))
(defgeneric wide-break-char-p (char strategy)
(:method (char strategy)
(member char (wide-break-chars strategy))))
(defgeneric new-line-char-p (char strategy)
(:method (char strategy)
(member char (new-line-chars strategy))))
(defgeneric break-char-p (char strategy)
(:method (char strategy)
(member char (break-chars strategy))))
(defgeneric char-width (char strategy)
(:method (char strategy)
(defgeneric line-width (strategy))
(defgeneric break-into-lines (string strategy)
(:method (string strategy)
(let ((breaker (make-instance 'break-stream :input string))
(width 0)
(max-width (line-width strategy)))
(let ((char (advance breaker)))
(when char
(incf width (char-width char strategy)))
(cond ((null char)
(return (finish breaker)))
((wide-break-char-p char strategy)
(mark-wide-break breaker))
((new-line-char-p char strategy)
(setf width 0)
(mark-wide-break breaker)
(break-line breaker))
((break-char-p char strategy)
(mark-break breaker)))
(when (< max-width width)
(setf width 0)
(break-line breaker)))))))
(defun width-breaker (width)
(make-instance 'breaker-strategy :line-width width))