(* cpif-dev.sml
 *    A simple pretty-printing device that eventually writes to a
 *    text file unless the current contents of that file coincides
 *    with what's being written.
 *
 * (C) 2002, Lucent Technologies, Bell Labs
 *
 * author: Matthias Blume (blume@research.bell-labs.com)
 *)
structure CPIFDev : sig

    include PP_DEVICE

    val openOut : string * int -> device
    val closeOut : device -> unit

end = struct

    datatype device =
	DEV of { filename: string,
		 buffer : string list ref,
		 wid : int }

    (* no style support *)
    type style = unit
    fun sameStyle _ = true
    fun pushStyle _ = ()
    fun popStyle _ = ()
    fun defaultStyle _ = ()

    (* Allocate an empty buffer and remember the file name. *)
    fun openOut (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 do not coincide, write the file. *)
    fun closeOut (DEV { buffer = ref l, filename, ... }) = let
	val s = concat (rev l)
	fun write () = let
	    val f = TextIO.openOut filename
	in
	    TextIO.output (f, s);
	    TextIO.closeOut f
	end
    in
	let val f = TextIO.openIn filename
	    val s' = TextIO.inputAll f
	in
	    TextIO.closeIn f;
	    if s = s' then () else write ()
	end handle _ => write ()
    end

    (* maximum printing depth (in terms of boxes) *)
    fun depth _ = NONE

    (* the width of the device *)
    fun lineWidth (DEV{wid, ...}) = SOME wid
    (* the suggested maximum width of text on a line *)
    fun textWidth _ = NONE

    (* output 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.str c)
    fun space (d, n) = string (d, StringCvt.padLeft #" " n "")
    fun newline d = string (d, "\n")

    fun flush d = ()
end
