X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaMisc.ml;h=0c4329e554350936ea863f1c2e581e13df8ca5d9;hb=771ee8b9d122fa963881c876e86f90531bb7434f;hp=dd84abcbd00de0e7ffc32b60907f409a1158a029;hpb=7deafec4fd4b2eebf4d4061f21ee5c47bd15b062;p=helm.git diff --git a/helm/matita/matitaMisc.ml b/helm/matita/matitaMisc.ml index dd84abcbd..0c4329e55 100644 --- a/helm/matita/matitaMisc.ml +++ b/helm/matita/matitaMisc.ml @@ -1,4 +1,4 @@ -(* Copyright (C) 2004, HELM Team. +(* Copyright (C) 2004-2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -23,19 +23,18 @@ * http://helm.cs.unibo.it/ *) +(* $Id$ *) + open Printf -let is_dir fname = (Unix.stat fname).Unix.st_kind = Unix.S_DIR -let is_regular fname = (Unix.stat fname).Unix.st_kind = Unix.S_REG +(** Functions "imported" from Http_getter_misc *) -let input_file fname = - let size = (Unix.stat fname).Unix.st_size in - let buf = Buffer.create size in - let ic = open_in fname in - Buffer.add_channel buf ic size; - close_in ic; - Buffer.contents buf +let normalize_dir = Http_getter_misc.normalize_dir +let strip_suffix = Http_getter_misc.strip_suffix +let absolute_path file = + if file.[0] = '/' then file else Unix.getcwd () ^ "/" ^ file + let is_proof_script fname = true (** TODO Zack *) let is_proof_object fname = true (** TODO Zack *) @@ -45,17 +44,6 @@ let append_phrase_sep s = else s -let strip_trailing_blanks = - let rex = Pcre.regexp "\\s*$" in - fun s -> Pcre.replace ~rex s - -let empty_mathml = - let doc = - Misc.domImpl#createDocument ~namespaceURI:(Some Misc.mathml_ns) - ~qualifiedName:(Gdome.domString "math") ~doctype:None - in - doc#get_documentElement - exception History_failure type 'a memento = 'a array * int * int * int (* data, hd, tl, cur *) @@ -67,17 +55,30 @@ class type ['a] history = method previous : 'a method load: 'a memento -> unit method save: 'a memento + method is_begin: bool + method is_end: bool end +class basic_history (head, tail, cur) = + object + val mutable hd = head (* insertion point *) + val mutable tl = tail (* oldest inserted item *) + val mutable cur = cur (* current item for the history *) + + method is_begin = cur <= tl + method is_end = cur >= hd + end + + class shell_history size = let size = size + 1 in let decr x = let x' = x - 1 in if x' < 0 then size + x' else x' in let incr x = (x + 1) mod size in object (self) val data = Array.create size "" - val mutable hd = 0 (* insertion point *) - val mutable tl = -1 (* oldest inserted item *) - val mutable cur = -1 (* current item for the history *) + + inherit basic_history (0, -1 , -1) + method add s = data.(hd) <- s; if tl = -1 then tl <- hd; @@ -103,9 +104,9 @@ class ['a] browser_history ?memento size init = object (self) initializer match memento with Some m -> self#load m | _ -> () val data = Array.create size init - val mutable hd = 0 - val mutable tl = 0 - val mutable cur = 0 + + inherit basic_history (0, 0, 0) + method previous = if cur = tl then raise History_failure; cur <- cur - 1; @@ -117,12 +118,15 @@ class ['a] browser_history ?memento size init = if cur = size then cur <- 0; data.(cur) method add (e:'a) = - cur <- cur + 1; - if cur = size then cur <- 0; - if cur = tl then tl <- tl + 1; - if tl = size then tl <- 0; - hd <- cur; - data.(cur) <- e + if e <> data.(cur) then + begin + cur <- cur + 1; + if cur = size then cur <- 0; + if cur = tl then tl <- tl + 1; + if tl = size then tl <- 0; + hd <- cur; + data.(cur) <- e + end method load (data', hd', tl', cur') = assert (Array.length data = Array.length data'); hd <- hd'; tl <- tl'; cur <- cur'; @@ -130,13 +134,19 @@ class ['a] browser_history ?memento size init = method save = (Array.copy data, hd, tl, cur) end -let dbd_instance = - let dbd = lazy ( - Mysql.quick_connect - ~host:(Helm_registry.get "db.host") - ~user:(Helm_registry.get "db.user") - ~database:(Helm_registry.get "db.database") - ()) - in - fun () -> Lazy.force dbd +let singleton f = + let instance = lazy (f ()) in + fun () -> Lazy.force instance +let image_path n = sprintf "%s/%s" BuildTimeConf.images_dir n + +let end_ma_RE = Pcre.regexp "\\.ma$" + +let list_tl_at ?(equality=(==)) e l = + let rec aux = + function + | [] -> raise Not_found + | hd :: tl as l when equality hd e -> l + | hd :: tl -> aux tl + in + aux l