home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / RPC / !Perl / riscos / RISCOS / Text / PrettyPrint.pm
Encoding:
Text File  |  1998-07-31  |  4.4 KB  |  143 lines
  1. # Your text editor is going to love this one! -*- perl -*-
  2. package RISCOS::Text::PrettyPrint;
  3.  
  4. =head1 NAME
  5.  
  6. RISCOS::Text::PrettyPrint -- perl module that emulates OS_PrettyPrint
  7.  
  8. =head1 SYNOPSIS
  9.  
  10.     use RISCOS::Text::PrettyPrint;
  11.     $expand = prettyprint_expand ($sometext, $special);
  12.  
  13.     @kernel_dict = read_riscosdict ('Resources:$.Resources.Kernel.Dictionary');
  14.     $expand = prettyprint_expand ($sometext, '', @kernel_dict);
  15.  
  16. =head1 DESCRIPTION
  17.  
  18. S<RISC OS> provides a call C<OS_PrettyPrint> that both formats text in a
  19. I<pretty> fashion and allows a limited form of text compaction by using a
  20. dictionary. C<prettyprint_expand> does not perform the line wrapping or tab
  21. expansion of C<OS_PrettyPrint> (see L<Text::Wrap> and L<Text::Tabs> if this is
  22. needed) but does perform the dictionary expansion and converts the
  23. C<OS_PrettyPrint> codes for non-breaking space and newline (C<<31E<gt>> and
  24. C<<13E<gt>> respectively) to C<<160E<gt>> and C<<10E<gt>> (a newline).
  25.  
  26. The second (optional) parameter to C<prettyprint_expand> is a I<special string>
  27. which is used as dictionary entry zero. The remaining parameters are form the
  28. dictionary. If no dictionary is supplied then the default S<RISC OS> dictionary
  29. is used (as in C<OS_PrettyPrint>), which contains text common to the syntax
  30. messages of many modules.
  31.  
  32. C<read_riscosdict> reads the C<OS_PrettyPrint> dictionary format and converts it
  33. to an array. If passed a string this will be taken as a filename and opened. If
  34. passed a reference to a filehandle this will be read from. (This allows reading
  35. of the default dictionary from the C<DATA> filehadle of this module.
  36.  
  37. =head1 EXAMPLE
  38.  
  39. This will print out the default dictionary.
  40.  
  41.     use RISCOS::Text::PrettyPrint ':DEFAULT', '@default_dict';
  42.  
  43.     foreach $entry (0 .. $#default_dict)
  44.     {
  45.     print prettyprint_expand (sprintf ("%2d: \c[%c\n", $entry, $entry),
  46.                   '<Special string>');
  47.     }
  48.  
  49. =head1 AUTHOR
  50.  
  51. Nicholas Clark <F<nick@unfortu.net>>
  52.  
  53. =cut
  54.  
  55. require Exporter;
  56. use Carp;
  57. use strict;
  58. use vars qw (@ISA @EXPORT @EXPORT_OK $VERSION @default_dict);
  59.  
  60. $VERSION = 0.02;    # Now does open or typeglob
  61. @ISA = qw(Exporter);
  62. @EXPORT = qw(prettyprint_expand read_riscosdict);
  63. @EXPORT_OK = qw(@default_dict);
  64.  
  65. sub prettyprint_expand ($;$@)
  66. {
  67.     my $text = shift;
  68.     my $special = shift;
  69.     my @dict = @_;
  70.     @dict = @default_dict unless @dict;
  71.  
  72.     my $max = $#_;
  73.  
  74.     $dict[0] = defined ($special) ? $special : '';
  75.     # Insert the special string
  76.  
  77.     while ($text =~ s/\c[(.)/$dict[ord $1]/es)
  78.     {
  79.     next if $max--;
  80.     carp sprintf "Deep recursion on expansion of dictionary entry %d",
  81.              ord $1;
  82.     return undef;
  83.     }
  84.  
  85.     $text =~ y/\r\x1F/\n /;    # CR -> NL, <31> to hard space
  86.     $text
  87. }
  88.  
  89. sub read_riscosdict ($)
  90. {
  91.     my $file = shift;
  92.     local *FILE;
  93.  
  94.     if (ref($file) ? (ref($file) eq 'GLOB'
  95.               || UNIVERSAL::isa($file, 'GLOB')
  96.               || UNIVERSAL::isa($file, 'IO::Handle'))
  97.            : (ref(\$file) eq 'GLOB'))
  98.     {
  99.         *FILE = $file;
  100.     }
  101.     else
  102.     {
  103.         open FILE, "<$file" or croak "Unable to open '$file': $!";
  104.     }
  105.  
  106.     my @dict = '';            # First entry is blank
  107.     my ($length, $entry);
  108.  
  109.     while (1)
  110.     {
  111.     unless (read FILE, $length ,1)
  112.     {
  113.         warn printf "Could not read length of dictionary entry %d: $!",
  114.             scalar @dict;
  115.         return;
  116.     }
  117.     $length = ord ($length);    # We've read the length byte already
  118.  
  119.     unless ($length--)        # so subtract it
  120.     {
  121.         warn "Not at end of dictionary file" if ($^W && !eof FILE);
  122.         return @dict;
  123.     }
  124.  
  125.     unless (read FILE, $entry ,$length)
  126.     {
  127.         warn printf "Could not read dictionary entry %d: $!", scalar @dict;
  128.         return;
  129.     }
  130.     chop $entry;            # Remove trailing '\0'
  131.     push @dict, $entry;
  132.     }
  133. }
  134.  
  135. # Use this as the return value:
  136. @default_dict = read_riscosdict (\*DATA);
  137.  
  138. # Your text editor is going to love this
  139. # There is no newline after the final two '\0's
  140. __DATA__
  141.  
  142. Syntax: * the 
  143. directorfiling system    current= to a variable. Other types of value can be assigned with *file
  144. default tion
  145. *Configure name     servernumber <- one or more s that matchgiven wildcard and relocatable module+
  146. C(onfirm)    Prompt for confirma     of each sets [<disc spec.>])}
  147. V(erbose)    Print informa     on each  =Landscape [<XScale> [<YScale> [<Margin> [<Threshold>]]]]]0)used(print a hard copy ofscreen on EPSON-#.
  148. Op    s: (use ~(force off, eg. ~printe     >     select xpression [sprite  displays free space {off}    library parameterobject all disc to  is