# HG changeset patch # User Steve Losh # Date 1527451253 14400 # Node ID 3f9040eb223f60be73580a5871991ba1c3896de2 Initial commit diff -r 000000000000 -r 3f9040eb223f .ffignore --- /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 diff -r 000000000000 -r 3f9040eb223f .hgignore --- /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 diff -r 000000000000 -r 3f9040eb223f .lispwords diff -r 000000000000 -r 3f9040eb223f LICENSE.markdown --- /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. diff -r 000000000000 -r 3f9040eb223f Makefile --- /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 diff -r 000000000000 -r 3f9040eb223f README.markdown --- /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:** (this `README`) +* **Mercurial:** +* **Git:** + +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? diff -r 000000000000 -r 3f9040eb223f bobbin.asd --- /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 " + :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 " + :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")))) diff -r 000000000000 -r 3f9040eb223f package.lisp --- /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)) diff -r 000000000000 -r 3f9040eb223f package.test.lisp --- /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)) diff -r 000000000000 -r 3f9040eb223f src/main.lisp --- /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)))) diff -r 000000000000 -r 3f9040eb223f test/run.lisp --- /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) diff -r 000000000000 -r 3f9040eb223f test/tests.lisp --- /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")))