;;; @Package tabexpand ;;; @Subtitle Tab Character Expansion in Scheme ;;; @HomePage http://www.neilvandyke.org/tabexpand-scheme/ ;;; @Author Neil Van Dyke ;;; @Version 0.3 ;;; @Date 2009-03-03 ;;; @PLaneT neil/tabexpand:1:1 ;; $Id: tabexpand.ss,v 1.12 2009/03/04 04:41:01 neilpair Exp $ ;;; @legal ;;; Copyright @copyright{} 2004--2009 Neil Van Dyke. This program is Free ;;; Software; you can redistribute it and/or modify it under the terms of the ;;; GNU Lesser General Public License as published by the Free Software ;;; Foundation; either version 3 of the License (LGPL 3), or (at your option) ;;; any later version. This program is distributed in the hope that it will be ;;; useful, but without any warranty; without even the implied warranty of ;;; merchantability or fitness for a particular purpose. See ;;; @indicateurl{http://www.gnu.org/licenses/} for details. For other licenses ;;; and consulting, please contact the author. ;;; @end legal #lang scheme/base ;;; @section Introduction ;;; There is no denying that ASCII tab characters are an archaic abomination. ;;; Savvy Emacs users might have noticed that the ;;; @uref{http://www.neilvandyke.org/quack/, Quack} option variable ;;; @code{quack-tabs-are-evil-p} defaults to true. Note also that ;;; @code{quack-tidy} gladly slays any tab in sight, laughing maniacally as ;;; only the truly righteous can. Sadly, not all strings in the universe are ;;; Scheme code subject to the wrath of Quack, therefore... ;;; ;;; This very simple Scheme library provides procedures for expanding tab ;;; characters. It was written early one Sunday morning to complement the ;;; plethora of PLT-specific solutions being offered to the problem on the ;;; nascent Schematics cookbook Wiki. Its source code is a bit verbose, but it ;;; tries not to generate much garbage, it supports non-zero starting columns, ;;; and it should work with any R5RS Scheme implementation that supports ;;; SRFI-6. (A future edition of this continuing epic might remove the ;;; dependency on SRFI-6, should we bother to benchmark and find that some ;;; implementations are not as efficient as we'd like.) ;;; ;;; At time of this writing, the author notes with no small amount of interest ;;; that the Internet domain name @code{tabexpand.com} has not yet been taken. ;;; @section Procedures ;;; Three procedures are provided. Most applications will use the simple ;;; @code{tabexpand}. ;;; @defproc tabexpand/stop/col str stop col ;;; @defprocx tabexpand/stop str stop ;;; @defprocx tabexpand str ;;; ;;; Yields a new string that is equivalent to string @var{str} except that any ;;; ASCII tab characters have been expanded to space characters. @var{stop}, a ;;; positive integer defaulting to @code{8}, is used as the tabstop. ;;; @var{col}, a nonnegative integer defaulting to @code{0}, is the context ;;; starting column for the beginning of the string, with respect to which tabs ;;; positions should be calculated. All characters other than tab are treated ;;; as if they were normal printable characters with no special effect on the ;;; column. (define tabexpand/stop/col (letrec ((tab-char (integer->char 9)) (tab-space-8-vector (vector "" (make-string 1 #\space) (make-string 2 #\space) (make-string 3 #\space) (make-string 4 #\space) (make-string 5 #\space) (make-string 6 #\space) (make-string 7 #\space) (make-string 8 #\space))) (tab-space-string (lambda (n) (if (<= 0 n 8) (vector-ref tab-space-8-vector n) (make-string n #\space))))) (lambda (str stop col) (let ((len (string-length str))) (let find-first-tab ((col col) (i 0)) (if (= i len) (string-copy str) (if (eqv? (string-ref str i) tab-char) (let ((os (open-output-string))) ;; Note: We could see whether iterating over the substring ;; and calling write-char is faster than allocating a ;; substring for a particular Scheme implementation. (display (substring str 0 i) os) (let expand-tab-and-find-next ((col col) (i i)) (let* ((spaces0 (- stop (modulo col stop))) (spaces (if (= spaces0 0) stop spaces0))) (display (tab-space-string spaces) os) (let find-next-tab ((col (+ col spaces)) (i (+ 1 i))) (if (= i len) (let ((result (get-output-string os))) (close-output-port os) result) (let ((c (string-ref str i))) (if (eqv? c tab-char) (expand-tab-and-find-next col i) (begin (write-char c os) (find-next-tab (+ 1 col) (+ 1 i)))))))))) (find-first-tab (+ 1 col) (+ 1 i))))))))) (define (tabexpand/stop str stop) (tabexpand/stop/col str stop 0)) (define (tabexpand str) (tabexpand/stop/col str 8 0)) ;;; @unnumberedsec History ;;; @table @asis ;;; ;;; @item Version 0.3 --- 2009-03-03 --- PLaneT @code{(1 1)} ;;; License is now LGPL 3. Converted to author's new Scheme administration ;;; system. ;;; ;;; @item Version 0.2 --- 2005-02-24 --- PLaneT @code{(1 0)} ;;; Added Testeez test cases. Packaged for PLaneT. ;;; ;;; @item Version 0.1 --- 2004-05-09 ;;; Wrote as a joke that also made a point about code patterns vs. libraries. ;;; ;;; @end table (provide tabexpand tabexpand/stop tabexpand/stop/col)