## cpif-dev.pkg
## (C) 2002, Lucent Technologies, Bell Labs
## author: Matthias Blume (blume@research.bell-labs.com)
# Compiled by:
# src/app/c-glue-maker/c-glue-maker.lib# A simple pretty-printing device that eventually writes to a
# text file unless the current contents of that file coincide
# with what was written.
package cpifdev
: (weak)
api {
include Prettyprint_Device; # Prettyprint_Device is from src/lib/prettyprint/big/src/prettyprint-device.api open: (String, Int) -> Device;
close: Device -> Void;
}
{
Device = DEV { filename: String,
buffer: Ref( List( String ) ),
wid: Int
};
Style = Void; # Bo style support
fun same_style _ = TRUE;
fun push_style _ = ();
fun pop_style _ = ();
fun default_style _ = ();
# Allocate an empty buffer and remember the file name.
fun open (f, w)
=
DEV { filename => f,
buffer => REF [],
wid => w
};
# Calculate the final output and
# compare it with the current
# contents of the file.
#
# If they differ, write the file:
fun close (DEV { buffer => REF l, filename, ... } )
=
{ s = cat (reverse l);
fun write ()
=
{ f = file::open_for_write filename;
file::write (f, s);
file::close_output f;
};
{ f = file::open_for_read filename;
s' = file::read_all f;
file::close_input f;
if (s == s' ) (); else write ();fi;
}
except
_ = write ();
};
# Maximum printing depth (in terms of boxes)
#
fun depth _ = NULL;
# The width of the device
#
fun line_width (DEV { wid, ... } ) = THE wid;
# The suggested maximum width of text on a line
#
fun text_width _ = NULL;
# Write a string/character in the current style to the device
#
fun string (DEV { buffer, ... }, s) = buffer := s ! *buffer;
fun char (d, c) = string (d, string::from_char c);
fun space (d, n) = string (d, number_string::pad_left ' ' n "");
fun newline d = string (d, "\n");
fun flush d = ();
};