Hi Alan,
you are right in that you look for precision/safety.
The safety leak does not seem to be that big; what
I found: Only if you have the (very rare) string "styl\0"
within your text your programme will fuddle (or
did I miss something?)
You could ask in the beginning of your script:
"styl\0" more often than once in the scrap? And if so:
-> error message.
Or you do not search for ANY occurance of "styl\0",
but for THE LAST. Hopefully the "styl"-information
will contain that "styl\0"-string only in the very beginning.
To find this last "styl\0" I added 4 lines to your script;
now you can put as many times"styl\0" into the text as
you like.
Or drop the "\0" and look for the last 'styl' only.
#!perl # # # # # # # # # # # # # # # # # # # # # # # # # # # #
## Extracting style places from the scrap
## By Alan Fry; lines 27 ->30 by D.L.
## Based largely on 'readStylTest2.pl' by Nobumis friend
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
use Mac::LowMem;
use Mac::Fonts;
my $lmh = LMGetScrapHandle;
my $str = $lmh->get;
my $fmt = "%7s|%7s|%7s|%8s|%9s|%7s|%10s|%6s|%6s|%6s|\n";
my @heading = qw(offset height ascent font_ID font_name
style font_size Red Green Blue);
my @line = qw(------- ------- ------- -------- ---------
------- ---------- ------ ------ ------);
# a debatable line to keep Microsoft 'Word' happy
if ($str =~ /stylTEXTPICTNATVOLNK/) {$str = $'};
if ($str =~ /TEXT/) {
my @l = unpack("La*", $');
print substr($l[1], 0, $l[0]), "\n\n" }
else {
print "No TEXT on clipboard\n";
exit }
while ($str =~ m,styl\0,g) { ## If someone knows a more elegant way for
$oldold=$old; ## finding out the last-but-one occurance
$old=$' } ## of "styl\0", please let me know
$str = $oldold; ## This should contain 0 or 1 times "styl\0"
if ($str =~ /styl\0/) {
my @l = unpack("LSa*", chr(0).$');
my $nsty = $l[1];
print "Number of styles = $nsty\n";
print "--------------------\n\n";
printf $fmt, @heading;
printf $fmt, @line;
my $all_styles = substr($l[2], 0, $l[0]-2);
my($offset, $styl);
for($offset = 0, $styl = 0; $styl < $nsty; ++$styl, $offset += 20) {
my @elements = unpack("NnnnB8Cnnnn", substr($all_styles, $offset, 20));
my $face = '';
foreach(qw{B I U O S C E R}) { $face .= $_ if chop($elements[4]) }
$face = $face ? $face : 'Plain';
splice(@elements, 4, 2, GetFontName($elements[3]), $face);
printf $fmt, @elements; } }
else {
print "No 'styl' present"; }
__END__
So after this talking about safety issues we can look for
a very USEFUL APPLICATION of knowing these style places:
Applying REGEX’ ON STYLED TEXT in the scrap!! Afterwards
we put it via scrap back to the application; for example
for FileMaker (which does not have an editor-like search
and replace tool).
Somehow like in this following script the necessary
calculating of the new style places could be done; excuse
me that I'm not skilled in packing those styles back to the
scrap; for sure someone else is better in this:
#!perl ##########################
# Recalculating the (simulated) style places after
# finding and replacing
##############################
## This is an arbitrary replacing task:
$_ = " foo-bar foo-bar foo-bar foo-bar foo-bar foo-bar foo-bar";
$search = "foo-bar";
$replace = "foobar";
$diff = length($search)-length($replace);
$diff_offset = 3; ## will be needed if styles change within a changed word
print "string-diff.: $diff";
## For the sake of inexpensive demonstration
## (because I dont know how to extract them)
## style places are simulated by word endings:
while (m,r\b,g) { push @styl1, pos }
print "\nstyl1: @styl1"; ## f o u n d "styles" before replacing
print "\nfound: @found\n"; ## where each search string ends
@stylC = @styl1;
for ($j=$#found; $j>=0; $j--) {
$i = $#stylC;
while ($stylC[$i] >= $found[$j] && $i>=0 ) {
$stylC[$i] -= $diff;
$i-- ; } }
s,$search,$replace,g;
print "\n\$_: $_\n";
while (m,r\b,g) { push @styl2, pos }
print "\nstyl2: @styl2"; ## "styles" f o u n d after replacing
print "\nstylC: @stylC"; ## c a l c u l a t e d "styles"
=will produce this output: = = = = = = = = = = = = = = = = = = = = =
$_: foo-bar foo-bar foo-bar foo-bar foo-bar foo-bar foo-bar
string-diff.: 1
styl1: 10 20 30 40 50 60 70
$_: foobar foobar foobar foobar foobar foobar foobar
styl2: 9 18 27 36 45 54 63
stylC: 9 18 27 36 45 54 63
And this means: found styles and calculated styles match each other,
so calculation should be right.
__END__
Who can put the style places from the scrap into that array "@style1"
and put the array "@stylC" back to the scrap?
asks Detlef Lindenthal
