From 30f49a11f18b58509d389e68ec2b96cb1a2ea8ba Mon Sep 17 00:00:00 2001 From: malc Date: Mon, 18 Feb 2013 02:40:54 +0400 Subject: [PATCH] Move some common functionality into utils module --- build.ml | 2 +- build.sh | 2 ++ buildall.sh | 3 +++ main.ml | 15 ++++----------- utils.ml | 23 +++++++++++++++++++++++ wsi.ml | 20 ++------------------ wsi.mli | 3 --- 7 files changed, 35 insertions(+), 33 deletions(-) create mode 100644 utils.ml diff --git a/build.ml b/build.ml index 57802a7..f107410 100644 --- a/build.ml +++ b/build.ml @@ -138,7 +138,7 @@ let () = cmopp ~flags:"-g -w A-7-6-4 -I +lablGL -thread" ~dirname name; (name ^ ".cmo") in - let cmos = so :: List.map mkcmo ["help"; "parser"; "wsi"; "main"] in + let cmos = so :: List.map mkcmo ["help"; "utils"; "parser"; "wsi"; "main"] in prog "llpp" cmos; ;; diff --git a/build.sh b/build.sh index 408f528..104efd4 100644 --- a/build.sh +++ b/build.sh @@ -16,6 +16,7 @@ sh $srcpath/mkhelp.sh $srcpath/keystoml.ml $srcpath/KEYS > help.ml ocamlc -c -o link.o -ccopt "$ccopt" $srcpath/link.c ocamlc -c -o help.cmo help.ml +ocamlc -c -o utils.cmo $srcpath/utils.ml ocamlc -c -o wsi.cmi $srcpath/wsi.mli ocamlc -c -o wsi.cmo $srcpath/wsi.ml ocamlc -c -o parser.cmo $srcpath/parser.ml @@ -27,6 +28,7 @@ ocamlc -custom -o llpp \ link.o \ -cclib "$cclib" \ help.cmo \ + utils.cmo \ parser.cmo \ wsi.cmo \ main.cmo diff --git a/buildall.sh b/buildall.sh index 05c3d04..7cb06ff 100644 --- a/buildall.sh +++ b/buildall.sh @@ -89,6 +89,7 @@ if test "$1" = "opt"; then link.o \ -cclib "$cclib" \ help.cmx \ + utils.cmx \ parser.cmx \ wsi.cmx \ main.cmx @@ -103,6 +104,7 @@ else link.o \ -cclib "$cclib" \ help.cmo \ + utils.cmo \ parser.cmo \ wsi.cmo \ main.cmo @@ -111,6 +113,7 @@ fi $comp -c -o link.o -ccopt "$ccopt" $srcpath/link.c $comp -c -o help.$cmsuf help.ml +$comp -c -o utils.$cmsuf $srcpath/utils.ml $comp -c -o wsi.cmi $srcpath/wsi.mli $comp -c -o wsi.$cmsuf $srcpath/wsi.ml $comp -c -o parser.$cmsuf $srcpath/parser.ml diff --git a/main.ml b/main.ml index 37ceee6..65ca9b9 100644 --- a/main.ml +++ b/main.ml @@ -1,6 +1,6 @@ -exception Quit;; +open Utils;; -let tempfailureretry = Wsi.tempfailureretry;; +exception Quit;; type under = | Unone @@ -13,9 +13,6 @@ type under = | Uremote of (string * int) and facename = string;; -let dolog fmt = Printf.kprintf prerr_endline fmt;; -let now = Unix.gettimeofday;; - type params = (angle * proportional * trimparams * texcount * sliceheight * memsize * colorspace * fontpath * trimcachepath @@ -96,14 +93,12 @@ external pagebbox : opaque -> (int * int * int * int) = "ml_getpagebox";; external platform : unit -> platform = "ml_platform";; external setaalevel : int -> unit = "ml_setaalevel";; external realloctexts : int -> bool = "ml_realloctexts";; -external cloexec : Unix.file_descr -> unit = "ml_cloexec";; external findlink : opaque -> linkdir -> link = "ml_findlink";; external getlink : opaque -> int -> under = "ml_getlink";; external getlinkrect : opaque -> int -> irect = "ml_getlinkrect";; external getlinkcount : opaque -> int = "ml_getlinkcount";; external findpwl : int -> int -> pagewithlinks = "ml_find_page_with_links" external popen : string -> (Unix.file_descr * int) list -> unit = "ml_popen";; -external mbtoutf8 : string -> string = "ml_mbtoutf8";; external getpbo : width -> height -> colorspace -> string = "ml_getpbo";; external freepbo : string -> unit = "ml_freepbo";; external unmappbo : string -> unit = "ml_unmappbo";; @@ -628,8 +623,6 @@ let geturl s = else "" ;; -let exntos = Wsi.exntos;; - let gotouri uri = if String.length conf.urilauncher = 0 then print_endline uri @@ -2655,7 +2648,7 @@ let linkndone f s = let textentry text key = if key land 0xff00 = 0xff00 then TEcont text - else TEcont (text ^ Wsi.toutf8 key) + else TEcont (text ^ toutf8 key) ;; let reqlayout angle proportional = @@ -3442,7 +3435,7 @@ object (self) ); | key when (key != 0 && key land 0xff00 != 0xff00) -> - let pattern = m_qsearch ^ Wsi.toutf8 key in + let pattern = m_qsearch ^ toutf8 key in let active, first = match search m_active pattern 1 with | None -> diff --git a/utils.ml b/utils.ml new file mode 100644 index 0000000..bbfea10 --- /dev/null +++ b/utils.ml @@ -0,0 +1,23 @@ +let tempfailureretry f a = + let rec g () = + try f a with Unix.Unix_error (Unix.EINTR, _, _) -> g () + in g () +;; + +external cloexec : Unix.file_descr -> unit = "ml_cloexec";; +external hasdata : Unix.file_descr -> bool = "ml_hasdata";; +external toutf8 : int -> string = "ml_keysymtoutf8";; +external mbtoutf8 : string -> string = "ml_mbtoutf8";; + +let dolog fmt = Format.kprintf prerr_endline fmt;; + +let exntos = function + | Unix.Unix_error (e, s, a) -> Printf.sprintf "%s(%s) : %s (%d)" + s a (Unix.error_message e) (Obj.magic e) + | exn -> Printexc.to_string exn; +;; + +let error fmt = Printf.kprintf failwith fmt;; + +let now = Unix.gettimeofday;; + diff --git a/wsi.ml b/wsi.ml index 2fb43ea..6b86426 100644 --- a/wsi.ml +++ b/wsi.ml @@ -1,3 +1,5 @@ +open Utils;; + type cursor = | CURSOR_INHERIT | CURSOR_INFO @@ -12,20 +14,10 @@ type winstate = | Fullscreen ;; -let tempfailureretry f a = - let rec g () = - try f a with Unix.Unix_error (Unix.EINTR, _, _) -> g () - in g () -;; - -external cloexec : Unix.file_descr -> unit = "ml_cloexec";; external glx : int -> unit = "ml_glx";; external glxsync : unit -> unit = "ml_glxsync";; external swapb : unit -> unit = "ml_swapb";; -external hasdata : Unix.file_descr -> bool = "ml_hasdata";; -external toutf8 : int -> string = "ml_keysymtoutf8";; -let dolog fmt = Format.kprintf prerr_endline fmt;; let vlog fmt = Format.kprintf ignore fmt;; let onot = object @@ -154,14 +146,6 @@ let r32 s pos = (u lsl 16) lor l ;; -let exntos = function - | Unix.Unix_error (e, s, a) -> Printf.sprintf "%s(%s) : %s (%d)" - s a (Unix.error_message e) (Obj.magic e) - | exn -> Printexc.to_string exn; -;; - -let error fmt = Printf.kprintf failwith fmt;; - let readstr sock n = let s = String.create n in let rec loop pos n = diff --git a/wsi.mli b/wsi.mli index 9f3afe5..8b3ccef 100644 --- a/wsi.mli +++ b/wsi.mli @@ -39,12 +39,9 @@ val withctrl : int -> bool;; val withshift : int -> bool;; val withmeta : int -> bool;; val withnone : int -> bool;; -val toutf8 : int -> string;; val metamask : int;; val altmask : int;; val shiftmask : int;; val ctrlmask : int;; val keyname : int -> string;; val namekey : string -> int;; -val tempfailureretry : ('a -> 'b) -> 'a -> 'b;; -val exntos : exn -> string;; -- 2.11.4.GIT