--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.ffignore Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,1 @@
+docs/build
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,5 @@
+syntax: glob
+
+scratch.lisp
+*.png
+docs/build
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/LICENSE.markdown Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,19 @@
+Copyright (c) 2018 Steve Losh and contributors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,22 @@
+.PHONY: test test-sbcl test-ccl test-ecl test-abcl
+
+heading_printer = $(shell which heading || echo 'true')
+
+# Testing ---------------------------------------------------------------------
+test: test-sbcl test-ccl test-ecl test-abcl
+
+test-sbcl:
+ $(heading_printer) computer 'SBCL'
+ sbcl --load test/run.lisp
+
+test-ccl:
+ $(heading_printer) slant 'CCL'
+ ccl --load test/run.lisp
+
+test-ecl:
+ $(heading_printer) roman 'ECL'
+ ecl --load test/run.lisp
+
+test-abcl:
+ $(heading_printer) broadway 'ABCL'
+ abcl --load test/run.lisp
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/README.markdown Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,97 @@
+Bobbin is a simple (50 LOC) word-wrapping library for strings in Common Lisp.
+It depends only on `split-sequence`.
+
+* **License:** MIT
+* **Documentation:** <http://github.com/sjl/bobbin/> (this `README`)
+* **Mercurial:** <http://bitbucket.org/sjl/bobbin/>
+* **Git:** <http://github.com/sjl/bobbin/>
+
+Documentation
+-------------
+
+Bobbin's API only has a single function:
+
+ (bobbin:wrap string-or-strings width)
+
+The simplest way to use Bobbin is to pass it a string:
+
+ (bobbin:wrap "hello, world!" 10)
+ "hello,
+ world!"
+
+Every line in the string returned by `wrap` will contain at most `width`
+characters (not including the newline itself).
+
+Philosophy
+----------
+
+Bobbin is about fifty lines of code. It aims to be simple, work well most of
+the time, and fail gracefully for edge cases.
+
+Bobbin will try to break lines at whitespace. It will only break a word in the
+middle if there's no other choice. It does not try to hyphenate, or parse
+hyphenation:
+
+ (bobbin:wrap "This is a test of Bobbin's line-breaking." 10)
+ "This is a
+ test of
+ Bobbin's
+ line-break
+ ing."
+
+Initial whitespace (e.g. indentation) will be preserved, unless even the first
+word cannot be fit if it were included. Bobbin does not try to indent any
+broken lines, but this may be added in the future:
+
+ (bobbin:wrap " foo bar baz" 10)
+ " foo
+ bar baz"
+
+ (bobbin:wrap " thisisjusttoolong" 10)
+ "thisisjust
+ toolong"
+
+Whitespace between words will be preserved, unless a line is broken at that
+point. This does the right thing for those of us who put two spaces after
+a period, [as God
+intended](https://web.archive.org/web/20171125050610/http://www.heracliteanriver.com/?p=324):
+
+ (bobbin:wrap "there are two spaces between these words" 12)
+ "there are
+ two spaces
+ between
+ these words"
+
+Existing line breaks in the text are preserved. Bobbin will only ever *add*
+line breaks, never remove them:
+
+ (bobbin:wrap (format nil "foo~%bar baz frob") 7)
+ "foo
+ bar baz
+ frob"
+
+Lists
+-----
+
+For convenience, you can also pass `wrap` a list of strings. Each string is
+treated as a separate line and wrapped as described above. The results are
+returned as a (flat) list of lines, each of which will be no more than `width`
+characters long:
+
+ (bobbin:wrap '("here is a line." "" "and here is another line") 8)
+ ("here is"
+ "a line."
+ ""
+ "and here"
+ "is"
+ "another"
+ "line")
+
+TODO
+----
+
+* Handle tab characters.
+* Handle non-printing characters.
+* Handle wide characters.
+* `unwrap` function to make writing paragraphs easier.
+* Maybe reindent broken lines?
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bobbin.asd Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,34 @@
+(asdf:defsystem :bobbin
+ :description "Simple (word) wrapping utilities for strings."
+ :author "Steve Losh <steve@stevelosh.com>"
+ :homepage "https://sjl.bitbucket.io/bobbin/"
+
+ :license "MIT"
+ :version "0.0.1"
+
+ :depends-on (:split-sequence)
+
+ :in-order-to ((asdf:test-op (asdf:test-op :bobbin/test)))
+
+ :serial t
+ :components ((:file "package")
+ (:module "src" :serial t
+ :components ((:file "main")))))
+
+
+(asdf:defsystem :bobbin/test
+ :description "Test suite for bobbin"
+
+ :author "Steve Losh <steve@stevelosh.com>"
+ :license "MIT"
+
+ :depends-on (:bobbin :1am)
+
+ :serial t
+ :components ((:file "package.test")
+ (:module "test"
+ :serial t
+ :components ((:file "tests"))))
+
+ :perform (asdf:test-op (op system)
+ (funcall (read-from-string "bobbin.test:run-tests"))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/package.lisp Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,3 @@
+(defpackage :bobbin
+ (:use :cl)
+ (:export :wrap))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/package.test.lisp Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,3 @@
+(defpackage :bobbin.test
+ (:use :cl :1am :bobbin)
+ (:export :run-tests))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/main.lisp Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,99 @@
+(in-package :bobbin)
+
+(defun wrap-line (line width)
+ "Wrap the single-line string `line` to `width`, returning a multi-line string."
+ (with-output-to-string (*standard-output*)
+ (let ((pos 0)
+ (spaces 0)
+ (words (split-sequence:split-sequence #\space line))
+ (fresh t)
+ word
+ len)
+ (flet ((add (s)
+ (incf pos (length s))
+ (princ s))
+ (linebreak ()
+ (setf pos 0 spaces 0)
+ (terpri)))
+ (loop
+ :until (null words)
+ :do
+ (setf word (pop words)
+ len (length word))
+ (cond
+ ;; chomp leading whitespace
+ ((and (not fresh) (zerop pos) (zerop len))
+ nil)
+ ;; if we have multiple spaces in a row, preserve them (maybe)
+ ((zerop len)
+ (incf spaces))
+ ;; if we're dealing with a single word that's too long, reluctantly
+ ;; split it into pieces
+ ((and (zerop pos) (> len width))
+ (setf fresh nil)
+ (add (subseq word 0 width))
+ (linebreak)
+ (push (subseq word width) words))
+ ;; if this would send us beyond the limit, break
+ ((> (+ spaces len pos) width)
+ (if fresh
+ (setf pos 0 spaces 0)
+ (linebreak))
+ (setf fresh nil)
+ (push word words))
+ ;; otherwise concat
+ (t
+ (setf fresh nil)
+ (add (make-string spaces :initial-element #\space))
+ (add word)
+ (setf spaces 1))))))))
+
+(defun wrap-lines (strings width)
+ "Wrap a list of `strings` to `width`, returning a list of strings."
+ (mapcan (lambda (string)
+ (split-sequence:split-sequence #\newline (wrap-line string width)))
+ strings))
+
+(defun wrap-string (string width)
+ "Wrap a multi-line string, returning a multi-line string."
+ (format nil "~{~A~^~%~}"
+ (mapcar (lambda (line)
+ (wrap-line line width))
+ (split-sequence:split-sequence #\newline string))))
+
+(defun wrap (string-or-strings width)
+ "Wrap `string-or-strings` to `width`.
+
+ `string-or-strings` can be a string or a list of strings. A list of strings
+ is treated as multiple lines. In either case the string(s) may also contain
+ newlines. All of these linebreaks will be included in the output — wrapping
+ will only add linebreaks, never remove them.
+
+ The result with be of the same type as the argument: either a single string
+ (containing newlines) or a list of strings (not containing newlines).
+
+ Examples:
+
+ (print (wrap (format nil \"foo bar baz\") 3))
+ foo
+ bar
+ baz
+
+ (print (wrap (format nil \"foo bar baz\") 7))
+ foo bar
+ baz
+
+ (print (wrap (format nil \"foo~%bar baz\") 7))
+ foo
+ bar baz
+
+ (print (wrap '(\"foo\" \"bar baz\") 7))
+ (\"foo\" \"bar baz\")
+
+ (print (wrap '(\"foo\" \"bar baz\") 3))
+ (\"foo\" \"bar\" \"baz\")
+
+ "
+ (etypecase string-or-strings
+ (string (wrap-string string-or-strings width))
+ (list (wrap-lines string-or-strings width))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/run.lisp Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,5 @@
+#+ecl (setf compiler:*user-cc-flags* "-Wno-shift-negative-value")
+
+(ql:quickload :bobbin)
+(time (asdf:test-system :bobbin))
+(quit)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/tests.lisp Sun May 27 16:00:53 2018 -0400
@@ -0,0 +1,76 @@
+(in-package :bobbin.test)
+
+
+;;;; Utils --------------------------------------------------------------------
+(defmacro define-test (name &body body)
+ `(test ,(intern (concatenate 'string (symbol-name 'test-) (symbol-name name)))
+ (let ((*package* ,*package*))
+ ,@body)))
+
+
+(defun run-tests ()
+ (1am:run))
+
+(defmacro check (input width result)
+ (if (stringp input)
+ `(is (string= (format nil ,result)
+ (bobbin:wrap (format nil ,input) ,width)))
+ `(is (equal ',result (bobbin:wrap ',input ,width)))))
+
+
+;;;; Tests --------------------------------------------------------------------
+(define-test noop
+ (check "" 10 "")
+ (check "foo bar" 10 "foo bar"))
+
+(define-test basic-strings
+ (check "foo bar baz" 11 "foo bar baz")
+ (check "foo bar baz" 10 "foo bar~%baz")
+ (check "foo bar baz" 3 "foo~%bar~%baz")
+ (check "foo bar baz" 5 "foo~%bar~%baz")
+ (check "foo bar baz" 6 "foo~%bar~%baz"))
+
+(define-test long-words
+ (check "abcdefghijklmnopqrstuvwxyz" 5 "abcde~%fghij~%klmno~%pqrst~%uvwxy~%z")
+ (check "foo abcdefghijklmnopqrstuvwxyz" 5 "foo~%abcde~%fghij~%klmno~%pqrst~%uvwxy~%z"))
+
+(define-test spaces
+ (check "foo bar baz" 100 "foo bar baz")
+ (check "foo bar baz" 4 "foo~%bar~%baz")
+ (check "foo bar baz" 8 "foo bar~%baz")
+ (check "foo bar baz" 9 "foo bar~%baz")
+ (check "foo bar baz" 10 "foo bar~%baz")
+ (check "foo bar baz" 11 "foo bar~%baz"))
+
+(define-test markdown
+ (check "This is a paragraph of text. It contains some words and some spaces."
+ 20
+ "This is a paragraph~@
+ of text. It~@
+ contains some words~@
+ and some spaces.")
+ (check "Here is a list of a couple of things:~@
+ ~@
+ * foo~@
+ * bar"
+ 20
+ "Here is a list of a~@
+ couple of things:~@
+ ~@
+ * foo~@
+ * bar"))
+
+(define-test indentation
+ (check " foo~% bar" 50 " foo~% bar")
+ (check " foo bar" 3 "foo~%bar"))
+
+(define-test lists
+ (check ("foo bar baz")
+ 3
+ ("foo" "bar" "baz"))
+ (check ("foo bar baz")
+ 7
+ ("foo bar" "baz"))
+ (check ("foo" "bar baz")
+ 7
+ ("foo" "bar baz")))