15.4.9  src/app/c-glue-maker/cpif-dev.pkg

## 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.


stipulate
    package fil =  file__premicrothread;                                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
herein

    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 = fil::open_for_write filename;
                        fil::write (f, s);
                        fil::close_output f;
                    };

                {   f = fil::open_for_read filename;
                    s' = fil::read_all f;

                    fil::close_input f;

                    if (s != s')    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 = ();
    };
end;