(* Pager *)
(* $Id$ *)

let call f =
  let old_behavior = Sys.signal
    Sys.sigpipe (Sys.Signal_handle (fun _ -> raise End_of_file))
  in
  let restore () = Sys.set_signal Sys.sigpipe old_behavior in
  let cmd = Config.current#get_string "ara.commands.pager" in
  let close oc =
    Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
    begin
      try
        match Util.string_of_process_status
          (Printf.sprintf "Pager command (%S)" cmd)
          (Unix.close_process_out oc) with
        | None -> ()
        | Some x -> Printf.printf "%s.\n" x
      with
      | x ->
          Debug.debug 1 (Debug.sf "Pager: close_process_out: %s" (Printexc.to_string x));
          ()
    end
  in
  try
    let oc = Unix.open_process_out cmd in
    try
      f oc;
      close oc
    with
    | x -> close_out_noerr oc; close oc; raise x
  with
  | End_of_file -> restore ();
  | x -> restore (); raise x
;;

let page text = call (fun oc -> output_string oc text);;

let page_if_necessary text =
  if !Opt.use_pager & Util.count_lines text + 1 > !Opt.rows then
    call (fun oc -> output_string oc text)
  else
    print_string text
;;
