#
# $Id: Textutil.pm,v 1.1.1.1 1998/02/25 21:13:00 schwartz Exp $
#
# *Experimentary* package, handles text format documents.
#
# Don't use it in its current state! No documentation, therefore!
#
# It is actually part of Elser, a program to handle word 6 documents, but
# Elser is not yet ported to perl 5.
#
# Copyright (C) 1996, 1997, 1998 Martin Schwartz
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, 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 the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, you should find it at:
#
# http://wwwwbs.cs.tu-berlin.de/~schwartz/pmh/COPYING
#
# You can contact me via schwartz@cs.tu-berlin.de
#
package OLE::Storage::Textutil;
use strict;
sub new {
my ($proto, $parH) = @_;
my $S = bless ({}, ref($proto) || $proto);
$S->width (-1);
$S->white ([" "]);
$S->hyphen ("-");
$S->newline ("\n");
$S->newpar ("\n");
$S->pardel ("\x0d");
$S->tabdel ("\x09");
$S->mode (0);
if ($parH) {
$S -> Startup ($parH->{"STARTUP"}) if $parH->{"STARTUP"};
}
$S;
}
sub _member { my $S=shift; my $n=shift if @_; $S->{$n}=shift if @_; $S->{$n}}
sub width { shift->_member("WIDTH", @_) }
sub white { shift->_member("WHITE", @_) }
sub hyphen { shift->_member("HYPHEN", @_) }
sub newline { shift->_member("NL", @_) }
sub newpar { shift->_member("NP", @_) }
sub pardel { shift->_member("PDEL", @_) }
sub tabdel { shift->_member("TDEL", @_) }
sub mode { shift->_member("MODE", @_) }
##
## --- Module Interfaces --------------------------------------------------
##
sub Startup { shift->_member("STARTUP", @_) }
sub _error { my $S=shift; $S->{STARTUP} ? $S->{STARTUP}->error(@_) : 0 }
sub _msg { my $S=shift; $S->Startup ? $S->Startup->msg(@_) : 0 }
##
## --- Code ---------------------------------------------------------------
##
sub wrap {
#
# 1||0 == wrap(\$buf)
#
# mode 0 Keep a long line, if a word is longer than a line.
# 1 Break a word with a $hyphen, if it is longer than a line.
#
my ($S, $bufR, $mode) = @_;
my $par = $S -> pardel();
my $len;
my @Tab = ();
my @Len = ();
for (0 .. split(/$par/, $$bufR, -1)) {
push (@Len, $len=length($_[$_]));
push (@Tab, $S->tab_pos(\$_[$_], $len));
# missing: tab handling
$S->_column(\$_[$_], $S->width, $len);
}
#$S->print_statistic(\@Tab, \@Len);
$$bufR = join($S->newpar, @_);
1}
sub _column {
#
my ($S, $bufR, $w, $l) = @_;
if ($w==1) {
# Special case: width == 1
$$bufR = join ($S->newline(), split(//, $$bufR));
return 1;
} elsif ($w<0) {
# Special case: invalid width
return $S->_error ("Cannot handle negative width.");
}
my ($mpos, $mlen, $l1);
my $pos = 0;
while (($pos+$w)<$l) {
my $status = 0;
($mpos, $mlen) = $S->match_white($bufR, $pos, $w);
if ($mpos < 0) {
my $sep = $S->mode();
if ($sep==1) {
($mpos, $status) = $S->sep_lite($bufR, $pos, $w);
$mpos = $l if $mpos > $l;
} elsif (ref($sep)) {
# 2do
}
if ((!$sep) || ($mpos<0)) {
# No line breaks made. Leave overlong lines.
$pos = $S->next_white($bufR, $pos)-$w+1;
next;
}
}
$l1 = "";
if ($status) {
$l1 .= $S->hyphen() if $status == 1;
$mlen = 0;
};
$l1 .= $S->newline();
substr($$bufR, $mpos, $mlen) = $l1;
$l += length($l1) - $mlen;
$pos = $mpos+length($l1);
}
1}
sub sep_lite {
#
# 0||1||2 = $S->sep_lite($bufR, $pos, $free)
#
my ($S, $bufR, $pos, $free) = @_;
my $mpos = $pos+$free-1;
if (substr($$bufR, $mpos-1, 1) =~ /[a-zA-ZÄÖÜäöüß]/) {
return ($mpos, 1);
} else {
return ($mpos, 2);
}
}
sub next_paragraph {
my ($S, $bufR, $pos) = @_;
index($$bufR, $S->pardel(), $pos);
}
sub next_tab {
my ($S, $bufR, $pos) = @_;
index($$bufR, $S->tabdel(), $pos);
}
sub next_word {
my ($S, $bufR, $pos) = @_;
my $end = $S->next_white($bufR, $pos);
substr($$bufR, $pos, $end-$pos);
}
sub next_white {
#
# $pos = $S -> next_white ($bufR, $pos)
#
my ($S, $bufR, $pos) = @_;
my $us = 0;
my $os = 0xffffffff;
for (@{$S->white()}) {
$us = index($$bufR, $_, $pos);
next if $us == -1;
$os = $us if $us < $os;
}
$os = length($$bufR) if $os == -1;
$os;
}
sub match_white {
#
# ($breakpos, $breaklen) = $S -> match_white ($bufR, $pos, $width)
#
my ($S, $bufR, $pos, $w) = @_;
my $min = $pos;
my $max = $min + $w -1;
my $us;
my $os = $min;
for (@{$S->white()}) {
$us = rindex($$bufR, $_, $max);
$os = $us if $us > $os;
}
return -1 if $os <= $min;
my ($left, $right, $l, $flag);
$right = $os;
$flag=0;
while (!$flag) {
$flag = 1;
for (@{$S->white()}) {
$l = length($_);
while (substr($$bufR, $right, $l) =~ /$_/) {
$right += $l; $flag=0;
}
}
}
$left=$os;
$flag=0;
while (!$flag) {
$flag = 1;
for (@{$S->white()}) {
$l = length($_);
while (substr($$bufR, $left-$l, $l) =~ /$_/) {
$left -= $l; $flag=0;
}
}
}
($left, $right-$left);
}
##
## --- Tabulators ----------------------------------------------------------
##
sub tab_pos {
my ($S, $bufR, $l) = @_;
my $tpos = -1;
my @tabs = ();
while( $tpos < $l ) {
$tpos = $S -> next_tab ($bufR, $tpos+1);
last if ($tpos > $l);
last if ($tpos < 0);
push (@tabs, $tpos);
}
\@tabs;
}
sub print_statistic {
my ($S, $LT, $LL) = @_;
print "\nTabulator statistic:\n";
for (0 .. $#$LT) {
if (defined $LT->[$_]) {
printf " %03d (%3d): " . "%d " x ($#{$LT->[$_]}+1) . "\n",
$_, $LL->[$_], @{$LT->[$_]}
;
} else {
printf(" %03d (%03d)\n", $_, $LL->[$_]);
}
}
print "\n";
}
"Atomkraft? Nein, danke!";
__END__
1 Tabulator:
Tab in Position 1: Einrückung gemäß Tabulator 1 in vorhergehender Zeile
bzw. Anschluß an vorhergehende Zeile
N (fast) konsekutive Zeilen, Tab mittlere Position, kurze Zeilenlängen: Index
1 Zeile, Tab linke Position, kurze Zeilenlänge: Überschrift
1 Zeile, Tab linke Position, lange Zeilenlänge: Eingerückter Absatz
N Tabulator:
1 Zeile: Tabulatoren nur zur manuellen Korrektor verwandt -> Space.
Gruppen:
Mehrere 1 Tab Gruppen, dicht beieinander: Gemeinsame Tabulatorposition