#!/usr/local/bin/perl ;# ;# fold.pl: line folding library for Perl as well as a fold(1) clone. ;# ;# You can include this file from other Perl program or execute ;# directly as a command. ;# ;# Copyright (c) 1993 Kazumasa Utashiro ;# Software Research Associates, Inc. ;# ;# Copyright (c) 1995 Kazumasa Utashiro ;# Internet Initiative Japan Inc. ;# ;# Original version: 25 Mar 1993 ;# $Id: fold.pl,v 1.4 1995/02/01 17:21:39 utashiro Exp $ ;# if (__FILE__ eq $0) { $myname = ('whoami?', split('/', $0)); Usage: $usage = <<" ;"; $myname [-width] [-w] [-p] -width: specify folding width (default 80) -w: fold on word boundaries -p: put padding spaces at the end of line -t: truncate by width -f: replace final newline by space and fill text -s: delete leading space ; $width = 80; while ($_ = $ARGV[$[], s/^-(.+)$/$1/ && shift) { next unless length; if (s/^\d+//) { $width = $&; redo; } if (s/^w//) { $onword = 1; redo; } if (s/^p//) { $padding = 1; redo; } if (s/^t//) { $truncate = 1; redo; } if (s/^f//) { $/ = ''; redo; } if (s/^s//) { $delete_leading_space = 1; redo; } if (s/^e//) { ($expand = shift) && redo; } print STDERR "Usage:", $usage, "$rcsid\n"; exit(!/^h/); } while (<>) { while (length) { s/\n([^\n])/ $1/g; ($l, $_) = &fold($_, $width, $padding, $onword, $expand); $l =~ s/^ // if $delete_leading_space; print $l; print "\n" if length; last if $truncate; } } exit(0); } ###################################################################### package fold; ;# ;# SYNOPSIS ;# ;# ($folded, $rest) = &fold(LINE, WIDTH, PADDING, ONWORD, EXPAND, COLUMN); ;# ;# DESCRIPTION ;# ;# Pass the line to be folded as a first argument and folding width as ;# a second argument. If optional third argument is true, space ;# character will be padded at the end of the line if necessary. If ;# the fourth argument is true, the line is folded on the word ;# boundaries. The fifth argument is a string which specifies what ;# character is expanded by spaces and backspaces ('r' for carriage ;# return, 't' for tab and 'a' for all). The sixth argument specifies ;# start column of the string to caliculate tab stop. ;# ;# Return value is a list of a folded line and the rest. ;# ;; $rcsid = q$Id: fold.pl,v 1.4 1995/02/01 17:21:39 utashiro Exp $; ;# sub main'fold { local($_, $width, $padding, $onword, $expand, $start) = @_; local($l, $room) = ('', $width); local($n, $c, $r, $mb); while (length) { if (s/^\cH//) { $c = $&; if ($room < $width) { $room++; } elsif ($start > 0) { $start--; } next; } if (s/^\r//) { $c = $expand =~ /[ar]/ ? "\cH" x ($width - $room + $start) : $&; $room = $width + $start; $start = 0; next; } last if $room <= 0 || (/^[\200-\377]/ && $room < 2); if (s/^\t//) { $space = 8 - ($start + $width - $room) % 8; if ($expand =~ /[at]/) { $_ = (' ' x $space) . $_; redo; } else { $room -= $space; $c = $&; $l .= $c, last if $room <= 0; next; } } if (($mb = s/^([\200-\377].)+//) || s/[^\t\b\r\200-\377]+//) { $n = $room; $n -= $room % 2 if $mb; ($c, $r) = unpack("a$n a*", $&); $room -= length($c); $_ = $r . $_; } else { die "&fold: panic"; } } continue { $l .= $c; } if ($onword && /^\w/ && !$mb && $l =~ s/([^\w\b])([\w\b]+)$/\1/) { $cut = $2; if ($l =~ /[\200-\377]$/) { # This check is not necessary for EUC local(@tmp) = $l =~ /[\200-\377]?./g; (pop(@tmp) =~ /^[\200-\377]$/) && ($cut =~ s/^.//) && ($l .= $&); } $_ = $cut . $_; $room += &pwidth($cut) if $padding; } $l .= ' ' x $room if $padding; ($l, $_); } sub pwidth { local($_) = @_; return(length) unless /[\cH\f\r]/; s/^.*[\f\r]//; 1 while s/[^\cH]\cH//; s/^\cH+//; length; } 1;