(*
 * Copyright (C) 2003:
 *    Stefano Zacchiroli <zack@cs.unibo.it>
 *    for the HELM Team http://helm.cs.unibo.it/
 *
 *  This file is part of HELM, an Hypertextual, Electronic
 *  Library of Mathematics, developed at the Computer Science
 *  Department, University of Bologna, Italy.
 *
 *  HELM is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation; either version 2
 *  of the License, or (at your option) any later version.
 *
 *  HELM is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with HELM; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 *  MA  02111-1307, USA.
 *
 *  For details, see the HELM World-Wide-Web page,
 *  http://helm.cs.unibo.it/
 *)

open Printf;;

exception Stylesheet_not_found of string;;
exception Stylesheet_already_in of string;;

class styles =
  object (self)
    (* INVARIANT: 'stylesheets' and 'uris' are in sync *)

    val mutable stylesheets = []
    val mutable uris = []
    val domImpl = Gdome.domImplementation ()

      (** process an XSLT stylesheet *)
    method private process uri = domImpl#createDocumentFromURI ~uri ()

    method get keys =
      let rev_keys = List.rev keys in
      let last_key = List.hd rev_keys in
      let p_stylesheets =
        List.fold_left
          (fun collected_styles key ->
            let (key, stylesheet) =
              try
                List.find (fun (k, _) -> k = key) stylesheets
              with Not_found -> raise (Stylesheet_not_found key)
            in
            (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
          []
          rev_keys
      in
      let last_stylesheet =
        snd (List.find (fun (k, _) -> k = last_key) stylesheets)
      in
      (p_stylesheets, last_stylesheet)

    method add key uri =
      if (List.mem_assoc key uris) then
        raise (Stylesheet_already_in key)
      else begin
        uris <- (key, uri) :: uris;
        stylesheets <- (key, self#process uri) :: stylesheets
      end

    method remove key =
      if not (List.mem_assoc key uris) then
        raise (Stylesheet_not_found key)
      else begin
        uris <- List.remove_assoc key uris;
        stylesheets <- List.remove_assoc key stylesheets
      end

    method removeAll = uris <- []; stylesheets <- []

    method list =
      List.map
        (fun (key, uri) ->
          sprintf "key = %s, uri = %s" key (List.assoc key uris))
        uris

    method reload key =
      (try
        let uri = List.assoc key uris in
        stylesheets <-
          (key, self#process uri) :: (List.remove_assoc key stylesheets)
      with Not_found ->
        raise (Stylesheet_not_found key))

    method reloadAll =
      stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris

  end