pax_global_header00006660000000000000000000000064136142723000014510gustar00rootroot0000000000000052 comment=5b517c293fa6268247f2aa7d8fd66a5a96c63d63 zed-2.0.5/000077500000000000000000000000001361427230000122765ustar00rootroot00000000000000zed-2.0.5/.github/000077500000000000000000000000001361427230000136365ustar00rootroot00000000000000zed-2.0.5/.github/CODEOWNERS000066400000000000000000000000101361427230000152200ustar00rootroot00000000000000* @diml zed-2.0.5/.gitignore000066400000000000000000000001301361427230000142600ustar00rootroot00000000000000_build/ /zed-*.tar.gz /setup.data /setup.log /setup.exe /setup-dev.exe .merlin *.installzed-2.0.5/.travis.yml000066400000000000000000000005001361427230000144020ustar00rootroot00000000000000language: c sudo: required install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh script: bash -ex .travis-opam.sh env: - OCAML_VERSION=4.02 - OCAML_VERSION=4.03 - OCAML_VERSION=4.04 - OCAML_VERSION=4.05 - OCAML_VERSION=4.06 - OCAML_VERSION=4.07 os: - linux - osx zed-2.0.5/CHANGES.md000066400000000000000000000064401361427230000136740ustar00rootroot000000000000002.0.5 (2020-01-29) ------------------ * Zed\_rope.Zip: fix a bug in function `make_b` 2.0.4 (2019-12-31) ------------------ * add wanted\_column support for wide width character * Zed\_lines: `get_idx_by_width set row column_width` return the offset of the character at `[row, column_width]` 2.0.3 (2019-08-09) ------------------ * Zed\_string * `exception Invalid of string * string` raised when an invalid Zed\_char sequence is encounted * `next_ofs : t -> int -> int` returns the offset of the next zchar in `t` * `prev_ofs : t -> int -> int` returns the offset of the prev zchar in `t` 2.0.2 (2019-06-21) ------------------ * Zed\_utf8: fix an ofs-stepping bug in function `unsafe_extract_prev` 2.0.1 (2019-06-04) ------------------ * Zed\_char: add an `indv_combining` option to the transforming functions(`of_uChars, zChars_of_uChars, of_utf8`) to determine whether to extract individual combining marks from the parameter (#18) * Zed\_char: clarify some documentation comments (#18) 2.0 (2019-05-17) ---------------- ### Additions * module Zed\_char * module Zed\_string * Zed\_cursor * `column_display: Zed_cursor.t -> int React.signal` * `get_column: Zed_cursor.t -> int` * `coordinates_display: Zed_cursor.t -> (int * int) React.signal` * `get_coordinates: Zed_cursor.t -> int * int` * Zed\_edit * `regexp_word_core: Zed_re.Core.t` * `regexp_word_raw: Zed_re.raw.t` * `match_by_regexp_core` * `match_by_regexp_raw` ### Breaking * Zed\_rope * Zed\_rope.empty is a function now * Other functions in this module take `Zed_char.t` or `Zed_string.t` as arguemnts instead of `UChar.t` or `Zed_utf8.t` * module Zipper is divided into two modules, Zip and Zip\_raw, to navigate over a rope by Zed\_char.t or UChar.t, respectively * module Text is divided into three modules, Text, Text\_core, Text\_raw, to manager Zed\_rope by Zed\_char.t, the core UChar.t of a `Zed_char.t` and raw `UChar.t`, respectively * Zed\_re is therefore divided into two modules: Core and Raw * Zed\_cursor: the type `changes` is defined as a structure and has two more fields: `added_width` and `removed_width` ### General * README: Add Travis badge (Kevin Ji, #11) * Add travis config (Anurag Soni, #10) * Switch to dune (Anurag Soni, #9) 1.6 (2017-11-05) ---------------- * safe-string compatibility (#8) 1.5 (2017-04-26) ---------------- * Switch to jbuilder (Rudi Gringberg, #4) * Make `{delete_,kill_,}{next,prev}_word` consistent near the start/end of the buffer (Fabian (github use copy), #5) 1.4 (2015-01-07) ---------------- * added `Zed_edit.get_line` * added `Zed_line.line_{length,stop}` * fix a bug in cursor updates * fix some invalid use of react 1.3 (2014-04-21) ---------------- * `Zed_rope` fixes: - `rev_map`: fix recursion - enforce evaluation order in `map` & `rev_map` 1.2 (2012-07-30) ---------------- * add escaping functions * add `Zed_utf8.next_error` 1.1 (2011-08-06) ---------------- * add the `{delete,kill}-{prev,next}-word` actions and functions * add `Zed_edit.Insert(ch)` * add `Zed_edit.replace` * raise an exception when editing a read-only part of a text * disable the move function * add support for undo * add `Zed_input` to ease writing key binders * add `Zed_macro` to ease writing macro system * fix `Zed_rope.Zip.sub` * add `Zed_edit.new_clipboard` * add `Zed_utf8.add` zed-2.0.5/LICENSE000066400000000000000000000027561361427230000133150ustar00rootroot00000000000000Copyright (c) 2011, Jeremie Dimino All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jeremie Dimino nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. zed-2.0.5/Makefile000066400000000000000000000003171361427230000137370ustar00rootroot00000000000000build: dune build test: dune runtest all-supported-ocaml-versions: dune build @install @runtest --workspace dune-workspace.dev clean: dune clean .PHONY: build all-supported-ocaml-versions clean test zed-2.0.5/README.md000066400000000000000000000022031361427230000135520ustar00rootroot00000000000000Zed === [![Build Status](https://travis-ci.org/ocaml-community/zed.svg?branch=master)](https://travis-ci.org/ocaml-community/zed) Zed is an abstract engine for text edition. It can be used to write text editors, edition widgets, readlines, ... You just have to _connect_ an engine to your inputs and rendering functions to get an editor. Zed provides: * edition state management, * multiple cursor support, * key-binding helpers, * general purpose unicode rope manipulation functions. Installation ------------ To build and install zed, use opam: $ opam install zed Modules ------- * `Zed_edit`: the main module, it defines edition engines. * `Zed_cursor`: manages cursors. Cursors are automatically updated when the text is modified. * `Zed_lines`: maintains the offsets of beginning of lines. * `Zed_input`: helpers for implementing key bindings. * `Zed_macro`: helpers for writing macro systems. * `Zed_utf8`: general purpose UTF-8 strings manipulation. * `Zed_rope`: general purpose unicode ropes manipulation. * `Zed_char`: general purpose unicode characters manipulation. * `Zed_string`: general purpose unicode strings manipulation. zed-2.0.5/dune-project000066400000000000000000000000331361427230000146140ustar00rootroot00000000000000(lang dune 1.1) (name zed) zed-2.0.5/dune-workspace.dev000066400000000000000000000004231361427230000157240ustar00rootroot00000000000000(lang dune 1.1) ;; This file is used by `make all-supported-ocaml-versions` (context (opam (switch 4.02.3))) (context (opam (switch 4.03.0))) (context (opam (switch 4.04.2))) (context (opam (switch 4.05.0))) (context (opam (switch 4.06.1))) (context (opam (switch 4.07.0))) zed-2.0.5/pkg/000077500000000000000000000000001361427230000130575ustar00rootroot00000000000000zed-2.0.5/pkg/pkg.ml000066400000000000000000000000561361427230000141730ustar00rootroot00000000000000#use "topfind" #require "topkg-jbuilder.auto" zed-2.0.5/src/000077500000000000000000000000001361427230000130655ustar00rootroot00000000000000zed-2.0.5/src/dune000066400000000000000000000002311361427230000137370ustar00rootroot00000000000000(library (name zed) (public_name zed) (wrapped false) (flags (:standard -safe-string)) (libraries bytes react camomile result charInfo_width)) zed-2.0.5/src/zed_char.ml000066400000000000000000000103731361427230000152020ustar00rootroot00000000000000(* * zed_char.ml * ----------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile open Result type t= Zed_utf8.t type char_prop= | Printable of int | Other | Null let to_raw= Zed_utf8.explode let to_array t= Array.of_list (Zed_utf8.explode t) let zero= String.make 1 (Char.chr 0) let core t= Zed_utf8.unsafe_extract t 0 let combined t= List.tl (Zed_utf8.explode t) let prop_uChar uChar= match CharInfo_width.width uChar with | -1 -> Other | 0-> if UChar.code uChar = 0 then Null else Printable 0 | w-> Printable w let prop t= prop_uChar (Zed_utf8.unsafe_extract t 0) let is_printable uChar= match prop_uChar uChar with | Printable _ -> true | _-> false let is_printable_core uChar= match prop_uChar uChar with | Printable w when w > 0 -> true | _-> false let is_combining_mark uChar= match prop_uChar uChar with | Printable w when w = 0 -> true | _-> false let length= Zed_utf8.length let size= length let width t= CharInfo_width.width (Zed_utf8.unsafe_extract t 0) let out_of_range t i= i < 0 || i >= size t let get= Zed_utf8.get let get_opt t i= try Some (get t i) with _-> None let append ch mark= match prop_uChar mark with | Printable 0-> ch ^ (Zed_utf8.singleton mark) | _-> failwith "combining mark expected" let compare_core t1 t2= let core1= Zed_utf8.unsafe_extract t1 0 and core2= Zed_utf8.unsafe_extract t2 0 in UChar.compare core1 core2 let compare_raw= Zed_utf8.compare let compare= compare_raw let mix_uChar zChar uChar= match prop_uChar uChar with | Printable 0-> Ok (zChar ^ (Zed_utf8.singleton uChar)) | _-> Error (Zed_utf8.singleton uChar) let first_core ?(trim=false) uChars= let rec aux uChars= match uChars with | []-> None, [] | uChar::tl-> let prop= prop_uChar uChar in match prop with | Printable w-> if w > 0 then Some (prop, uChar), tl else aux tl | Other-> Some (prop, uChar), tl | Null-> Some (prop, uChar), tl in match uChars with | []-> None, [] | uChar::_-> if not trim && is_combining_mark uChar then None, uChars else aux uChars let rec subsequent uChars= match uChars with | []-> [], [] | uChar::tl-> let prop= prop_uChar uChar in match prop with | Printable w-> if w > 0 then [], uChars else let seq, remain= subsequent tl in uChar :: seq, remain | _-> [], uChars let of_uChars ?(trim=false) ?(indv_combining=true) uChars= match uChars with | []-> None, [] | uChar::tl-> match first_core ~trim uChars with | None, _-> if indv_combining then Some (Zed_utf8.singleton uChar), tl else None, uChars | Some (Printable _w, uChar), tl-> let combined, tl= subsequent tl in Some (Zed_utf8.implode (uChar::combined)), tl | Some (Null, uChar), tl-> Some (Zed_utf8.singleton uChar) ,tl | Some (Other, uChar), tl-> Some (Zed_utf8.singleton uChar) ,tl let zChars_of_uChars ?(trim=false) ?(indv_combining=true) uChars= let rec aux zChars uChars= match of_uChars ~trim ~indv_combining uChars with | None, tl-> List.rev zChars, tl | Some zChar, tl-> aux (zChar::zChars) tl in aux [] uChars external id : 'a -> 'a = "%identity" let unsafe_of_utf8 : string -> t= fun str-> if String.length str > 0 then str else failwith "malformed Zed_char sequence" let of_utf8 ?(indv_combining=true) str= match of_uChars ~indv_combining (Zed_utf8.explode str) with | Some zChar, []-> zChar | _-> failwith "malformed Zed_char sequence" let to_utf8 : t -> string= id let unsafe_of_char c= Zed_utf8.singleton (UChar.of_char c) let unsafe_of_uChar uChar= Zed_utf8.singleton uChar let for_all= Zed_utf8.for_all let iter= Zed_utf8.iter module US(US:UnicodeString.Type) = struct module Convert = Zed_utils.Convert(US) let of_t t= Zed_utf8.explode t |> Convert.of_list let to_t us= let len= US.length us in let rec create i= if i < len then US.get us i :: create (i+1) else [] in let uChars= create 0 in of_uChars uChars let to_t_exn us= match to_t us with | Some t, _-> t | _-> failwith "to_t_exn" end zed-2.0.5/src/zed_char.mli000066400000000000000000000147621361427230000153610ustar00rootroot00000000000000(* * zed_char.mli * ------------ * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibrary open Result (** The type for glyphs. *) type t (** To represent a grapheme in unicode is a bit more complicated than what is expected: a printable UChar. For example, diacritics are added to IPA(international phonetic alphabet) letter to produce a modified pronunciation. Variation selectors are added to a CJK character to specify a specific glyph variant for the character. Therefore the logical type definition of [Zed_char.t] can be seen as {[ type Zed_char.t= { core: UChar.t; combined: UChar.t list; } ]} *) type char_prop = Printable of int | Other | Null (** The property of a character. It can be either [Printable of width], [Other](unprintable character) or [Null](code 0). *) val to_raw : t -> UChar.t list val to_array : t -> UChar.t array val core : t -> UChar.t (** [core char] returns the core of the [char] *) val combined : t -> UChar.t list (** [combined char] returns the combining marks of the [char] *) val unsafe_of_utf8 : string -> t (** [unsafe_of_utf8 str] returns a [zed_char] from utf8 encoded [str] without any validation. *) val of_utf8 : ?indv_combining:bool -> string -> t (** [of_utf8 str] returns a [zed_char] from utf8 encoded [str]. This function checks whether [str] represents a single [UChar] or a legal grapheme, i.e. a printable core with optional combining marks. It will raise [Failure "malformed Zed_char sequence"] If the validation is not passed. @param indv_combining allow to create a [Zed_char.t] from a single combining mark, default to [true] *) val to_utf8 : t -> string (** [to_utf8 chr] converts a [chr] to a string encoded in UTF-8. *) val zero : t (** The Character 0. *) val prop_uChar : UChar.t -> char_prop (** [prop_uChar uChar] returns the char_prop of [uChar] *) val prop : t -> char_prop (** [prop ch] returns the char_prop of [ch] *) val is_printable : UChar.t -> bool (** Returns whether a [UChar.t] is a printable character or not. *) val is_printable_core : UChar.t -> bool (** Returns whether a [UChar.t] is a printable character and its width is not zero. *) val is_combining_mark : UChar.t -> bool (** Returns whether a [UChar.t] is a combining mark. *) val size : t -> int (** [size ch] returns the size (number of characters) of [ch]. *) val length : t -> int (** Aliase of size *) val width : t -> int (** [width ch] returns the width of [ch]. *) val out_of_range : t -> int -> bool (** [out_of_range ch idx] returns whether [idx] is out of range of [ch]. *) val get : t -> int -> UChar.t (** [get ch n] returns the [n]-th character of [ch]. *) val get_opt : t -> int -> UChar.t option (** [get ch n] returns an optional value of the [n]-th character of [ch]. *) val append : t -> UChar.t -> t (** [append ch cm] append the combining mark [cm] to ch and returns it. If [cm] is not a combining mark, then the original [ch] is returned. *) val compare_core : t -> t -> int (** [compare_core ch1 ch2] compares the core components of ch1 and ch2*) val compare_raw : t -> t -> int (** [compare_raw ch1 ch2] compares over the internal characters of ch1 and ch2 sequentially *) val compare : t -> t -> int (** Alias of compare_raw *) val mix_uChar : t -> UChar.t -> (t, t) result (** [mix_uChar chr uChar] tries to append [uChar] to [chr] and returns [Ok result]. If [uChar] is not a combining mark, then an [Error (Zed_char.t consists of uChar)] is returned. *) val of_uChars : ?trim:bool -> ?indv_combining:bool -> UChar.t list -> t option * UChar.t list (** [of_uChars uChars] transforms [uChars] to a tuple. The first value is an optional [Zed_char.t] and the second is a list of remaining uChars. The optional [Zed_char.t] is either a legal grapheme(a core printable char with optinal combining marks) or a wrap for an arbitrary UChar.t. After that, all remaining uChars returned as the second value in the tuple. @param trim trim leading combining marks before transforming, default to [false] @param indv_combining create a [Zed_char] from an individual dissociated combining mark, default to [true] *) val zChars_of_uChars : ?trim:bool -> ?indv_combining:bool -> UChar.t list -> t list * UChar.t list (** [zChars of_uChars uChars] transforms [uChars] to a tuple. The first value is a list of [Zed_char.t] and the second is a list of remaining uChars. @param trim trim leading combining marks before transforming, default to [false] @param indv_combining create a [Zed_char] from an individual dissociated combining mark, default to [true] *) val for_all : (UChar.t -> bool) -> t -> bool (** [for_all p zChar] checks if all elements of [zChar] satisfy the predicate [p]. *) val iter : (UChar.t -> unit) -> t -> unit (** [iter f char] applies [f] on all characters of [char]. *) (** The prefix 'unsafe_' of [unsafe_of_char] and [unsafe_of_uChar] means the two functions do not check if [char] or [uChar] being transformed is a valid grapheme. There is no 'safe_' version, because the scenario we should deal with a single [char] or [uChar] is when the char sequence are individual, incomplete. For example, when we are reading user input. Even if a user wants to input a legal grapheme, say, 'a' with a hat(a combining mark) on top. the user will input 'a' and then '^' individually, the later combining mark is always illegal. What we should do is to invoke [unsafe_of_uChar user_input] and send the result to the edit engine. Other modules in zed, like Zed_string, Zed_lines, Zed_edit ... are already well designed to deal with such a situation. They will do combining mark joining, grapheme validation for you automatically. Use the two 'unsafe_' functions directly, you're doing things the right way. *) val unsafe_of_char : char -> t (** [unsafe_of_char ch] returns a [Zed_char] whose core is [ch]. *) val unsafe_of_uChar : UChar.t -> t (** [unsafe_of_uChar ch] returns a [Zed_char] whose core is [ch]. *) (** Converting between [UnicodeString.Type] and [Zed_char.t] *) module US : functor (US : UnicodeString.Type) -> sig module Convert : sig val of_list : UChar.t list -> US.t val of_array : UChar.t array -> US.t val to_uChars : US.t -> UChar.t list end val of_t : t -> US.t val to_t : US.t -> t option * UChar.t list val to_t_exn : US.t -> t end zed-2.0.5/src/zed_cursor.ml000066400000000000000000000107021361427230000155760ustar00rootroot00000000000000(* * zed_cursor.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open React exception Out_of_bounds type changes= { position: int; added: int; removed: int; added_width: int; removed_width: int; } type action = | User_move of int | Text_modification of changes (* start, added, removed *) type t = { position : int signal; send : action -> unit; length : int ref; changes : changes event; get_lines : unit -> Zed_lines.t; coordinates : (int * int) signal; coordinates_display : (int * int) signal; line : int signal; column : int signal; column_display : int signal; wanted_column : int signal; set_wanted_column : int -> unit; } let create length changes get_lines position wanted_column = if position < 0 || position > length then raise Out_of_bounds; let length = ref length in let user_moves, send = E.create () in let update_position position action = match action with | User_move pos -> pos | Text_modification changes -> let delta = changes.added - changes.removed in length := !length + delta; if !length < 0 then raise Out_of_bounds; (* Move the cursor if it is after the start of the changes. *) if position > changes.position then begin if delta >= 0 then (* Text has been inserted, advance the cursor. *) position + delta else if position < changes.position - delta then (* Text has been removed and the removed block contains the cursor, move it at the beginning of the removed block. *) changes.position else (* Text has been removed before the cursor, move back the cursor. *) position + delta end else position in let text_modifications = E.map (fun x -> Text_modification x) changes in let position = S.fold update_position position (E.select [user_moves; text_modifications]) in let compute_coordinates_and_display position = let lines = get_lines () in let index = Zed_lines.line_index lines position in let bol= Zed_lines.line_start lines index in let column= position - bol in let width= Zed_lines.force_width lines bol column in (index, column, bol, width) in let coordinates_and_display= S.map compute_coordinates_and_display position in let coordinates = S.map (fun (row, column,_,_)-> (row, column)) coordinates_and_display in let coordinates_display = S.map (fun (row,_,_,width)-> (row, width)) coordinates_and_display in let line= S.map fst coordinates in let column= S.map snd coordinates in let column_display= S.map snd coordinates_display in let wanted_column, set_wanted_column = S.create wanted_column in { position; send; length; changes; get_lines; coordinates; coordinates_display; line; column; column_display; wanted_column; set_wanted_column; } let copy cursor = create !(cursor.length) cursor.changes cursor.get_lines (S.value cursor.position) (S.value cursor.wanted_column) let position cursor = cursor.position let get_position cursor = S.value cursor.position let line cursor = cursor.line let get_line cursor = S.value cursor.line let column cursor = cursor.column let column_display cursor = cursor.column_display let get_column cursor = S.value cursor.column let get_column_display cursor = S.value cursor.column_display let coordinates cursor = cursor.coordinates let coordinates_display cursor = cursor.coordinates let get_coordinates cursor = S.value cursor.coordinates let get_coordinates_display cursor = S.value cursor.coordinates_display let wanted_column cursor = cursor.wanted_column let get_wanted_column cursor = S.value cursor.wanted_column let set_wanted_column cursor column = cursor.set_wanted_column column let move cursor ?(set_wanted_column=true) delta = let new_position = S.value cursor.position + delta in if new_position < 0 || new_position > !(cursor.length) then raise Out_of_bounds else begin cursor.send (User_move new_position); if set_wanted_column then cursor.set_wanted_column (S.value cursor.column_display) end let goto cursor ?(set_wanted_column=true) position = if position < 0 || position > !(cursor.length) then raise Out_of_bounds else begin cursor.send (User_move position); if set_wanted_column then cursor.set_wanted_column (S.value cursor.column_display) end zed-2.0.5/src/zed_cursor.mli000066400000000000000000000100641361427230000157500ustar00rootroot00000000000000(* * zed_cursor.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Cursors *) (** A cursor is a pointer in an edition buffer. When some text is inserted or removed, all cursors after the modification are automatically moved accordingly. *) open React type t (** Type of a cursor. *) type changes= { position: int; added: int; removed: int; added_width: int; removed_width: int; } exception Out_of_bounds (** Exception raised when trying to move a cursor outside the bounds of the text it points to. *) val create : int -> changes event -> (unit -> Zed_lines.t) -> int -> int -> t (** [create length changes get_lines position wanted_column] creates a new cursor pointing to position [position]. [length] is the current length of the text the cursor points to. It raises {!Out_of_bounds} if [position] is greater than [length]. [changes] is an event which occurs with values of the form [(start, added, removed)] when the text changes, with the same semantic as {!Zed_edit.changes}. [get_lines] is used to retreive the current set of line positions of the text. It is used to compute the line and column of the cursor. [wanted_column] is the column on which the cursor want to be, if there is enough room on the line. *) val copy : t -> t (** [copy cursor] creates a copy of the given cursor. The new cursor initially points to the same location as [cursor]. *) val position : t -> int signal (** [position cursor] returns the signal holding the current position of the given cursor. *) val get_position : t -> int (** [get_position cursor] returns the current position of [cursor]. *) val line : t -> int signal (** [line cursor] returns the signal holding the current line on which the cursor is. *) val get_line : t -> int (** [get_line cursor] returns the current line of the cursor. *) val column : t -> int signal (** [column cursor] returns the signal holding the current column of the cursor. *) val column_display : t -> int React.signal (** [column_display cursor] returns the signal holding the current display column of the cursor. *) val get_column : t -> int (** [get_column cursor] returns the current column of the cursor. *) val get_column_display : t -> int (** [get_column_display cursor] returns the current display column of the cursor. *) val coordinates : t -> (int * int) signal (** [coordinates cursor] returns the signal holding the current line & column of the cursor. *) val coordinates_display : t -> (int * int) React.signal (** [coordinates cursor] returns the signal holding the current line & display column of the cursor. *) val get_coordinates : t -> int * int (** [get_coordinates cursor] returns the current line & column of the cursor. *) val get_coordinates_display : t -> int * int (** [get_coordinates_display cursor] returns the current line & display column of the cursor. *) val wanted_column : t -> int signal (** [wanted_column cursor] returns the signal holding the column on which the cursor wants to be. *) val get_wanted_column : t -> int (** [get_wanted_column cursor] returns the column on which the cursor wants to be. *) val set_wanted_column : t -> int -> unit (** [set_wanted_column cursor] sets the column on which the cursor want to be. *) val goto : t -> ?set_wanted_column : bool -> int -> unit (** [goto cursor position] moves the given cursor to the given position. It raises {!Out_of_bounds} if [position] is outside the bounds of the text. If [set_wanted_column] is [true] (the default), then the wanted column will be set to the column of the cursor at given position. *) val move : t -> ?set_wanted_column : bool -> int -> unit (** [move cursor delta] moves the given cursor by the given number of characters. It raises {!Out_of_bounds} if the result is outside the bounds of the text. *) zed-2.0.5/src/zed_edit.ml000066400000000000000000000745251361427230000152230ustar00rootroot00000000000000(* * zed_edit.ml * ----------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile open React module CaseMap = CaseMap.Make(Zed_rope.Text_core) (* +-----------------------------------------------------------------+ | Types | +-----------------------------------------------------------------+ *) type clipboard = { clipboard_get : unit -> Zed_rope.t; clipboard_set : Zed_rope.t -> unit; } type 'a t = { mutable data : 'a option; (* Custom data attached to the engine. *) mutable text : Zed_rope.t; (* The contents of the engine. *) mutable lines : Zed_lines.t; (* The set of line position of [text]. *) changes : Zed_cursor.changes event; send_changes : Zed_cursor.changes -> unit; (* Changes of the contents. *) erase_mode : bool signal; set_erase_mode : bool -> unit; (* The current erase mode. *) editable : int -> int -> bool; (* The editable function of the engine. *) clipboard : clipboard; (* The clipboard for this engine. *) mutable mark : Zed_cursor.t; (* The cursor that points to the mark. *) selection : bool signal; set_selection : bool -> unit; (* The current selection state. *) match_word : Zed_rope.t -> int -> int option; (* The function for matching words. *) locale : string option signal; (* The buffer's locale. *) undo : (Zed_rope.t * Zed_lines.t * int * int * int * int * int * int) array; (* The undo buffer. It is an array of element of the form [(text, lines, pos, new_pos, added, removed, added_width, removed_width)]. *) undo_size : int; (* Size of the undo buffer. *) mutable undo_start : int; (* Position of the first used cell in the undo buffer. *) mutable undo_index : int; (* Position of the next available cell in the undo buffer. *) mutable undo_count : int; (* Number of used cell in the undo buffer. *) } (* +-----------------------------------------------------------------+ | Creation | +-----------------------------------------------------------------+ *) let dummy_cursor = Zed_cursor.create 0 E.never (fun () -> Zed_lines.empty) 0 0 let match_by_regexp_core re rope idx = match Zed_re.Core.regexp_match ~sem:`Longest re rope idx with | None -> None | Some arr -> match arr.(0) with | Some(_zip1, zip2) -> Some(Zed_rope.Zip.offset zip2) | None -> None let match_by_regexp_raw re rope idx = match Zed_re.Raw.regexp_match ~sem:`Longest re rope idx with | None -> None | Some arr -> match arr.(0) with | Some(_zip1, zip2) -> Some(Zed_rope.Zip_raw.offset zip2) | None -> None let regexp_word_core = let set = UCharInfo.load_property_set `Alphabetic in let set = List.fold_left (fun set ch -> USet.add (UChar.of_char ch) set) set ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'] in Zed_re.Core.compile (`Repn(`Set set, 1, None)) let regexp_word_raw = let set = UCharInfo.load_property_set `Alphabetic in let set = List.fold_left (fun set ch -> USet.add (UChar.of_char ch) set) set ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'] in Zed_re.Raw.compile (`Repn(`Set set, 1, None)) let new_clipboard () = let r = ref (Zed_rope.empty ()) in { clipboard_get = (fun () -> !r); clipboard_set = (fun x -> r := x) } let create ?(editable=fun _pos _len -> true) ?(move = (+)) ?clipboard ?(match_word = match_by_regexp_core regexp_word_core) ?(locale = S.const None) ?(undo_size = 1000) () = (* I'm not sure how to disable the unused warning with ocaml.warning and the argument can't be removed as it's part of the interface *) let _ = move in let changes, send_changes = E.create () in let erase_mode, set_erase_mode = S.create false in let selection, set_selection = S.create false in let clipboard = match clipboard with | Some clipboard -> clipboard | None -> new_clipboard () in let edit = { data = None; text = Zed_rope.empty (); lines = Zed_lines.empty; changes; send_changes; erase_mode; set_erase_mode; editable; clipboard; mark = dummy_cursor; selection; set_selection; match_word; locale; undo = Array.make undo_size (Zed_rope.empty (), Zed_lines.empty, 0, 0, 0, 0, 0, 0); undo_size; undo_start = 0; undo_index = 0; undo_count = 0; } in edit.mark <- Zed_cursor.create 0 changes (fun () -> edit.lines) 0 0; edit (* +-----------------------------------------------------------------+ | State | +-----------------------------------------------------------------+ *) let get_data engine = match engine.data with | Some data -> data | None -> raise Not_found let set_data engine data = engine.data <- Some data let clear_data engine = engine.data <- None let text engine = engine.text let lines engine = engine.lines let changes engine = engine.changes let erase_mode engine = engine.erase_mode let get_erase_mode engine = S.value engine.erase_mode let set_erase_mode engine state = engine.set_erase_mode state let mark engine = engine.mark let selection engine = engine.selection let get_selection engine = S.value engine.selection let set_selection engine state = engine.set_selection state let get_line e i = let txt = text e in let lines = lines e in let start = Zed_lines.line_start lines i in let stop = Zed_lines.line_stop lines i in Zed_rope.sub txt start (stop - start) let update engine cursors = E.select ( E.stamp engine.changes () :: E.stamp (S.changes engine.selection) () :: E.stamp (S.changes (Zed_cursor.position engine.mark)) () :: List.map (fun cursor -> E.stamp (S.changes (Zed_cursor.position cursor)) ()) cursors ) (* +-----------------------------------------------------------------+ | Cursors | +-----------------------------------------------------------------+ *) let new_cursor engine = Zed_cursor.create (Zed_rope.length engine.text) engine.changes (fun () -> engine.lines) 0 0 (* +-----------------------------------------------------------------+ | Actions | +-----------------------------------------------------------------+ *) exception Cannot_edit type 'a context = { edit : 'a t; cursor : Zed_cursor.t; check : bool; } let context ?(check=true) edit cursor = { edit; cursor; check } let edit ctx = ctx.edit let cursor ctx = ctx.cursor let check ctx = ctx.check let with_check check ctx = { ctx with check } let goto ctx ?set_wanted_column new_position = Zed_cursor.goto ctx.cursor ?set_wanted_column new_position let move ctx ?set_wanted_column delta = Zed_cursor.move ctx.cursor ?set_wanted_column delta let next_line_n ctx n = let index = Zed_cursor.get_line ctx.cursor in if index + n > Zed_lines.count ctx.edit.lines then goto ctx ~set_wanted_column:false (Zed_rope.length ctx.edit.text) else begin let stop = if index + n = Zed_lines.count ctx.edit.lines then Zed_rope.length ctx.edit.text else Zed_lines.line_start ctx.edit.lines (index + n + 1) - 1 in let wanted_idx= Zed_lines.get_idx_by_width ctx.edit.lines (index + n) (Zed_cursor.get_wanted_column ctx.cursor) in goto ctx ~set_wanted_column:false (min wanted_idx stop) end let prev_line_n ctx n = let index = Zed_cursor.get_line ctx.cursor in if index - n < 0 then begin goto ctx ~set_wanted_column:false 0 end else begin let stop = Zed_lines.line_start ctx.edit.lines (index - (n - 1)) - 1 in let wanted_idx= Zed_lines.get_idx_by_width ctx.edit.lines (index - n) (Zed_cursor.get_wanted_column ctx.cursor) in goto ctx ~set_wanted_column:false (min wanted_idx stop) end let move_line ctx delta = match delta with | _ when delta < 0 -> prev_line_n ctx (-delta) | _ when delta > 0 -> next_line_n ctx delta | _ -> () let position ctx = Zed_cursor.get_position ctx.cursor let line ctx = Zed_cursor.get_line ctx.cursor let column ctx = Zed_cursor.get_column ctx.cursor let column_display ctx = Zed_cursor.get_column_display ctx.cursor let at_bol ctx = Zed_cursor.get_column ctx.cursor = 0 let at_eol ctx = let position = Zed_cursor.get_position ctx.cursor in let index = Zed_cursor.get_line ctx.cursor in if index = Zed_lines.count ctx.edit.lines then position = Zed_rope.length ctx.edit.text else position = Zed_lines.line_start ctx.edit.lines (index + 1) - 1 let at_bot ctx = Zed_cursor.get_position ctx.cursor = 0 let at_eot ctx = Zed_cursor.get_position ctx.cursor = Zed_rope.length ctx.edit.text let modify { edit ; _ } text lines position new_position added removed added_width removed_width= if edit.undo_size > 0 then begin edit.undo.(edit.undo_index) <- (text, lines, position, new_position, added, removed, added_width, removed_width); edit.undo_index <- (edit.undo_index + 1) mod edit.undo_size; if edit.undo_count = edit.undo_size then edit.undo_start <- (edit.undo_start + 1) mod edit.undo_size else edit.undo_count <- edit.undo_count + 1 end; edit.send_changes {position; added; removed; added_width; removed_width } let insert ctx rope = let position = Zed_cursor.get_position ctx.cursor in if not ctx.check || ctx.edit.editable position 0 then begin let len = Zed_rope.length rope in let text = ctx.edit.text and lines = ctx.edit.lines in if S.value ctx.edit.erase_mode then begin let text_len = Zed_rope.length ctx.edit.text in if position + len > text_len then begin let orig_width= Zed_string.(aval_width (width Zed_rope.(to_string (sub text position (text_len-position))))) in let curr_width= Zed_string.(aval_width (width Zed_rope.(to_string rope))) in ctx.edit.text <- Zed_rope.replace text position (text_len - position) rope; ctx.edit.lines <- Zed_lines.replace ctx.edit.lines position (text_len - position) (Zed_lines.of_rope rope); modify ctx text lines position position len (text_len - position) curr_width orig_width end else begin let orig_width= Zed_string.(aval_width (width Zed_rope.(to_string (sub text position len)))) in let curr_width= Zed_string.(aval_width (width Zed_rope.(to_string rope))) in ctx.edit.text <- Zed_rope.replace text position len rope; ctx.edit.lines <- Zed_lines.replace ctx.edit.lines position len (Zed_lines.of_rope rope); modify ctx text lines position position len len curr_width orig_width; end; move ctx len end else begin let width_add= Zed_string.aval_width (Zed_string.width (Zed_rope.to_string rope)) in ctx.edit.text <- Zed_rope.insert ctx.edit.text position rope; ctx.edit.lines <- Zed_lines.insert ctx.edit.lines position (Zed_lines.of_rope rope); modify ctx text lines position position len 0 width_add 0; move ctx len end end else raise Cannot_edit let insert_char ctx ch = if Zed_char.is_combining_mark ch then let position = Zed_cursor.get_position ctx.cursor in if not ctx.check || ctx.edit.editable position 0 then begin let text = ctx.edit.text and lines = ctx.edit.lines in try ctx.edit.text <- Zed_rope.insert_uChar ctx.edit.text position ch; modify ctx text lines position position 1 1 0 0; move ctx 0; next_line_n ctx 0; with _-> () end else raise Cannot_edit else insert ctx (Zed_rope.of_string (fst (Zed_string.of_uChars [ch]))) let insert_no_erase ctx rope = let position = Zed_cursor.get_position ctx.cursor in if not ctx.check || ctx.edit.editable position 0 then begin let len = Zed_rope.length rope and text = ctx.edit.text and lines = ctx.edit.lines in let width_add= Zed_string.aval_width (Zed_string.width (Zed_rope.to_string rope)) in ctx.edit.text <- Zed_rope.insert text position rope; ctx.edit.lines <- Zed_lines.insert ctx.edit.lines position (Zed_lines.of_rope rope); modify ctx text lines position position len 0 width_add 0; move ctx len end else raise Cannot_edit let remove_next ctx len = let position = Zed_cursor.get_position ctx.cursor in let text_len = Zed_rope.length ctx.edit.text in let len = if position + len > text_len then text_len - position else len in if not ctx.check || ctx.edit.editable position len then begin let text = ctx.edit.text and lines = ctx.edit.lines in let width_remove= Zed_string.(aval_width (width Zed_rope.(to_string (sub text position len)))) in ctx.edit.text <- Zed_rope.remove text position len; ctx.edit.lines <- Zed_lines.remove ctx.edit.lines position len; modify ctx text lines position position 0 len 0 width_remove; end else raise Cannot_edit let remove_prev ctx len = let position = Zed_cursor.get_position ctx.cursor in let len = min position len in if not ctx.check || ctx.edit.editable (position - len) len then begin let text = ctx.edit.text and lines = ctx.edit.lines in let width_remove= Zed_string.(aval_width (width Zed_rope.(to_string (sub text (position-len) len)))) in ctx.edit.text <- Zed_rope.remove text (position - len) len; ctx.edit.lines <- Zed_lines.remove ctx.edit.lines (position - len) len; modify ctx text lines (position - len) position 0 len 0 width_remove; end else raise Cannot_edit let remove = remove_next let replace ctx len rope = let position = Zed_cursor.get_position ctx.cursor in let text_len = Zed_rope.length ctx.edit.text in let len = if position + len > text_len then text_len - position else len in if not ctx.check || ctx.edit.editable position len then begin let rope_len = Zed_rope.length rope and text = ctx.edit.text and lines = ctx.edit.lines in let orig_width= Zed_string.(aval_width (width Zed_rope.(to_string (sub text position len)))) in let curr_width= Zed_string.(aval_width (width Zed_rope.(to_string rope))) in ctx.edit.text <- Zed_rope.replace text position len rope; ctx.edit.lines <- Zed_lines.replace ctx.edit.lines position len (Zed_lines.of_rope rope); modify ctx text lines position position rope_len len curr_width orig_width; move ctx rope_len end else raise Cannot_edit let newline_rope = Zed_rope.singleton (Zed_char.unsafe_of_char '\n') let newline ctx = insert ctx newline_rope let next_char ctx = if not (at_eot ctx) then move ctx 1 let prev_char ctx = if not (at_bot ctx) then move ctx (-1) let next_line ctx = let index = Zed_cursor.get_line ctx.cursor in if index = Zed_lines.count ctx.edit.lines then goto ctx ~set_wanted_column:false (Zed_rope.length ctx.edit.text) else begin let stop = if index + 1 = Zed_lines.count ctx.edit.lines then Zed_rope.length ctx.edit.text else Zed_lines.line_start ctx.edit.lines (index + 2) - 1 in let wanted_idx= Zed_lines.get_idx_by_width ctx.edit.lines (index + 1) (Zed_cursor.get_wanted_column ctx.cursor) in goto ctx ~set_wanted_column:false (min wanted_idx stop) end let prev_line ctx = let index = Zed_cursor.get_line ctx.cursor in if index = 0 then begin goto ctx ~set_wanted_column:false 0 end else begin let stop = Zed_lines.line_start ctx.edit.lines index - 1 in let wanted_idx= Zed_lines.get_idx_by_width ctx.edit.lines (index - 1) (Zed_cursor.get_wanted_column ctx.cursor) in goto ctx ~set_wanted_column:false (min wanted_idx stop) end let goto_bol ctx = goto ctx (Zed_lines.line_start ctx.edit.lines (Zed_cursor.get_line ctx.cursor)) let goto_eol ctx = let index = Zed_cursor.get_line ctx.cursor in if index = Zed_lines.count ctx.edit.lines then goto ctx (Zed_rope.length ctx.edit.text) else goto ctx (Zed_lines.line_start ctx.edit.lines (index + 1) - 1) let goto_bot ctx = goto ctx 0 let goto_eot ctx = goto ctx (Zed_rope.length ctx.edit.text) let delete_next_char ctx = if not (at_eot ctx) then begin ctx.edit.set_selection false; remove_next ctx 1 end let delete_prev_char ctx = if not (at_bot ctx) then begin ctx.edit.set_selection false; remove_prev ctx 1 end let delete_next_line ctx = ctx.edit.set_selection false; let position = Zed_cursor.get_position ctx.cursor in let index = Zed_cursor.get_line ctx.cursor in if index = Zed_lines.count ctx.edit.lines then remove_next ctx (Zed_rope.length ctx.edit.text - position) else remove_next ctx (Zed_lines.line_start ctx.edit.lines (index + 1) - position) let delete_prev_line ctx = ctx.edit.set_selection false; let position = Zed_cursor.get_position ctx.cursor in let start = Zed_lines.line_start ctx.edit.lines (Zed_cursor.get_line ctx.cursor) in remove_prev ctx (position - start) let kill_next_line ctx = let position = Zed_cursor.get_position ctx.cursor in let index = Zed_cursor.get_line ctx.cursor in if index = Zed_lines.count ctx.edit.lines then begin ctx.edit.clipboard.clipboard_set (Zed_rope.after ctx.edit.text position); ctx.edit.set_selection false; remove ctx (Zed_rope.length ctx.edit.text - position) end else begin let len = Zed_lines.line_start ctx.edit.lines (index + 1) - position in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text position len); ctx.edit.set_selection false; remove ctx len end let kill_prev_line ctx = let position = Zed_cursor.get_position ctx.cursor in let start = Zed_lines.line_start ctx.edit.lines (Zed_cursor.get_line ctx.cursor) in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text start (position - start)); ctx.edit.set_selection false; remove_prev ctx (position - start) let switch_erase_mode ctx = ctx.edit.set_erase_mode (not (S.value ctx.edit.erase_mode)) let set_mark ctx = Zed_cursor.goto ctx.edit.mark (Zed_cursor.get_position ctx.cursor); ctx.edit.set_selection true let goto_mark ctx = goto ctx (Zed_cursor.get_position ctx.edit.mark) let copy ctx = if S.value ctx.edit.selection then begin let a = Zed_cursor.get_position ctx.cursor and b = Zed_cursor.get_position ctx.edit.mark in let a = min a b and b = max a b in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text a (b - a)); ctx.edit.set_selection false end let kill ctx = if S.value ctx.edit.selection then begin let a = Zed_cursor.get_position ctx.cursor and b = Zed_cursor.get_position ctx.edit.mark in let a = min a b and b = max a b in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text a (b - a)); ctx.edit.set_selection false; goto ctx a; let a = Zed_cursor.get_position ctx.cursor in if a <= b then remove ctx (b - a) end let yank ctx = ctx.edit.set_selection false; insert ctx (ctx.edit.clipboard.clipboard_get ()) let search_word_forward ctx = let len = Zed_rope.length ctx.edit.text in let rec loop idx = if idx = len then None else match ctx.edit.match_word ctx.edit.text idx with | Some idx' -> Some(idx, idx') | None -> loop (idx + 1) in loop (Zed_cursor.get_position ctx.cursor) let search_word_backward ctx = let rec loop idx = if idx = -1 then None else match ctx.edit.match_word ctx.edit.text idx with | Some idx' -> loop2 (idx - 1) (idx, idx') | None -> loop (idx - 1) and loop2 idx result = if idx = -1 then Some result else match ctx.edit.match_word ctx.edit.text idx with | Some idx' -> loop2 (idx - 1) (idx, idx') | None -> Some result in loop (Zed_cursor.get_position ctx.cursor - 1) let capitalize_word ctx = match search_word_forward ctx with | Some(idx1, idx2) -> goto ctx idx1; if Zed_cursor.get_position ctx.cursor = idx1 && idx1 < idx2 then begin let str = Zed_rope.sub ctx.edit.text idx1 (idx2 - idx1) in let ch, str' = Zed_rope.break str 1 in replace ctx (Zed_rope.length str) (Zed_rope.append (CaseMap.uppercase ?locale:(S.value ctx.edit.locale) ch) (CaseMap.lowercase ?locale:(S.value ctx.edit.locale) str')) end | None -> () let lowercase_word ctx = match search_word_forward ctx with | Some(idx1, idx2) -> goto ctx idx1; if Zed_cursor.get_position ctx.cursor = idx1 then begin let str = Zed_rope.sub ctx.edit.text idx1 (idx2 - idx1) in replace ctx (Zed_rope.length str) (CaseMap.lowercase ?locale:(S.value ctx.edit.locale) str) end | None -> () let uppercase_word ctx = match search_word_forward ctx with | Some(idx1, idx2) -> goto ctx idx1; if Zed_cursor.get_position ctx.cursor = idx1 then begin let str = Zed_rope.sub ctx.edit.text idx1 (idx2 - idx1) in replace ctx (Zed_rope.length str) (CaseMap.uppercase ?locale:(S.value ctx.edit.locale) str) end | None -> () let next_word ctx = match search_word_forward ctx with | Some(_idx1, idx2) -> goto ctx idx2 | None -> goto ctx (Zed_rope.length ctx.edit.text) let prev_word ctx = match search_word_backward ctx with | Some(idx1, _idx2) -> goto ctx idx1 | None -> goto ctx 0 let delete_next_word ctx = let position = Zed_cursor.get_position ctx.cursor in let word_end = match search_word_forward ctx with | Some(_idx1, idx2) -> idx2 | None -> Zed_rope.length ctx.edit.text in remove ctx (word_end - position) let delete_prev_word ctx = let position = Zed_cursor.get_position ctx.cursor in let start = match search_word_backward ctx with | Some(idx1, _idx2) -> idx1 | None -> 0 in remove_prev ctx (position - start) let kill_next_word ctx = let position = Zed_cursor.get_position ctx.cursor in let word_end = match search_word_forward ctx with | Some(_idx1, idx2) -> idx2 | None -> Zed_rope.length ctx.edit.text in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text position (word_end - position)); ctx.edit.set_selection false; remove ctx (word_end - position) let kill_prev_word ctx = let position = Zed_cursor.get_position ctx.cursor in let start = match search_word_backward ctx with | Some(idx1, _idx2) -> idx1 | None -> 0 in ctx.edit.clipboard.clipboard_set (Zed_rope.sub ctx.edit.text start (position - start)); ctx.edit.set_selection false; remove_prev ctx (position - start) let undo { check; edit; cursor } = if edit.undo_count > 0 then begin let index = if edit.undo_index = 0 then edit.undo_size - 1 else edit.undo_index - 1 in let text, lines, pos, new_pos, added, removed, added_width, removed_width = edit.undo.(index) in if not check || edit.editable pos added then begin edit.undo_count <- edit.undo_count - 1; edit.undo_index <- index; edit.text <- text; edit.lines <- lines; edit.send_changes {position= pos; removed; added; added_width; removed_width }; Zed_cursor.goto cursor new_pos end else raise Cannot_edit end (* +-----------------------------------------------------------------+ | Action by names | +-----------------------------------------------------------------+ *) type action = | Insert of Zed_char.t | Newline | Next_char | Prev_char | Next_line | Prev_line | Goto_bol | Goto_eol | Goto_bot | Goto_eot | Delete_next_char | Delete_prev_char | Delete_next_line | Delete_prev_line | Kill_next_line | Kill_prev_line | Switch_erase_mode | Set_mark | Goto_mark | Copy | Kill | Yank | Capitalize_word | Lowercase_word | Uppercase_word | Next_word | Prev_word | Delete_next_word | Delete_prev_word | Kill_next_word | Kill_prev_word | Undo let get_action = function | Insert ch -> (fun ctx -> if Zed_char.length ch = 1 then insert_char ctx (Zed_char.core ch) else insert ctx (Zed_rope.singleton ch)) | Newline -> newline | Next_char -> next_char | Prev_char -> prev_char | Next_line -> next_line | Prev_line -> prev_line | Goto_bol -> goto_bol | Goto_eol -> goto_eol | Goto_bot -> goto_bot | Goto_eot -> goto_eot | Delete_next_char -> delete_next_char | Delete_prev_char -> delete_prev_char | Delete_next_line -> delete_next_line | Delete_prev_line -> delete_prev_line | Kill_next_line -> kill_next_line | Kill_prev_line -> kill_prev_line | Switch_erase_mode -> switch_erase_mode | Set_mark -> set_mark | Goto_mark -> goto_mark | Copy -> copy | Kill -> kill | Yank -> yank | Capitalize_word -> capitalize_word | Lowercase_word -> lowercase_word | Uppercase_word -> uppercase_word | Next_word -> next_word | Prev_word -> prev_word | Delete_next_word -> delete_next_word | Delete_prev_word -> delete_prev_word | Kill_next_word -> kill_next_word | Kill_prev_word -> kill_prev_word | Undo -> undo let doc_of_action = function | Insert _ -> "insert the given character." | Newline -> "insert a newline character." | Next_char -> "move the cursor to the next character." | Prev_char -> "move the cursor to the previous character." | Next_line -> "move the cursor to the next line." | Prev_line -> "move the cursor to the previous line." | Goto_bol -> "move the cursor to the beginning of the current line." | Goto_eol -> "move the cursor to the end of the current line." | Goto_bot -> "move the cursor to the beginning of the text." | Goto_eot -> "move the cursor to the end of the text." | Delete_next_char -> "delete the character after the cursor." | Delete_prev_char -> "delete the character before the cursor." | Delete_next_line -> "delete everything until the end of the current line." | Delete_prev_line -> "delete everything until the beginning of the current line." | Kill_next_line -> "cut everything until the end of the current line." | Kill_prev_line -> "cut everything until the beginning of the current line." | Switch_erase_mode -> "switch the current erasing mode." | Set_mark -> "set the mark to the current position." | Goto_mark -> "move the cursor to the mark." | Copy -> "copy the current region to the clipboard." | Kill -> "cut the current region to the clipboard." | Yank -> "paste the contents of the clipboard at current position." | Capitalize_word -> "capitalize the first word after the cursor." | Lowercase_word -> "convert the first word after the cursor to lowercase." | Uppercase_word -> "convert the first word after the cursor to uppercase." | Next_word -> "move the cursor to the end of the next word." | Prev_word -> "move the cursor to the beginning of the previous word." | Delete_next_word -> "delete up until the next non-word character." | Delete_prev_word -> "delete the word behind the cursor." | Kill_next_word -> "cut up until the next non-word character." | Kill_prev_word -> "cut the word behind the cursor." | Undo -> "revert the last action." let actions = [ Newline, "newline"; Next_char, "next-char"; Prev_char, "prev-char"; Next_line, "next-line"; Prev_line, "prev-line"; Goto_bol, "goto-bol"; Goto_eol, "goto-eol"; Goto_bot, "goto-bot"; Goto_eot, "goto-eot"; Delete_next_char, "delete-next-char"; Delete_prev_char, "delete-prev-char"; Delete_next_line, "delete-next-line"; Delete_prev_line, "delete-prev-line"; Kill_next_line, "kill-next-line"; Kill_prev_line, "kill-prev-line"; Switch_erase_mode, "switch-erase-mode"; Set_mark, "set-mark"; Goto_mark, "goto-mark"; Copy, "copy"; Kill, "kill"; Yank, "yank"; Capitalize_word, "capitalize-word"; Lowercase_word, "lowercase-word"; Uppercase_word, "uppercase-word"; Next_word, "next-word"; Prev_word, "prev-word"; Delete_next_word, "delete-next-word"; Delete_prev_word, "delete-prev-word"; Kill_next_word, "kill-next-word"; Kill_prev_word, "kill-prev-word"; Undo, "undo"; ] let actions_to_names = Array.of_list (List.sort (fun (a1, _) (a2, _) -> compare a1 a2) actions) let names_to_actions = Array.of_list (List.sort (fun (_, n1) (_, n2) -> compare n1 n2) actions) let parse_insert x = if Zed_utf8.starts_with x "insert(" && Zed_utf8.ends_with x ")" then begin let str = String.sub x 7 (String.length x - 8) in if String.length str = 1 && Char.code str.[0] < 128 then Insert(Zed_char.unsafe_of_uChar (UChar.of_char str.[0])) else if String.length str > 2 && str.[0] = 'U' && str.[1] = '+' then let acc = ref 0 in for i = 2 to String.length str - 1 do let ch = str.[i] in acc := !acc * 16 + (match ch with | '0' .. '9' -> Char.code ch - Char.code '0' | 'a' .. 'f' -> Char.code ch - Char.code 'a' + 10 | 'A' .. 'F' -> Char.code ch - Char.code 'A' + 10 | _ -> raise Not_found) done; try Insert(Zed_char.unsafe_of_uChar (UChar.of_int !acc)) with _ -> raise Not_found else raise Not_found end else raise Not_found let action_of_name x = let rec loop a b = if a = b then parse_insert x else let c = (a + b) / 2 in let action, name = Array.unsafe_get names_to_actions c in match compare x name with | d when d < 0 -> loop a c | d when d > 0 -> loop (c + 1) b | _ -> action in loop 0 (Array.length names_to_actions) let name_of_action x = let rec loop a b = if a = b then raise Not_found else let c = (a + b) / 2 in let action, name = Array.unsafe_get actions_to_names c in match compare x action with | d when d < 0 -> loop a c | d when d > 0 -> loop (c + 1) b | _ -> name in match x with | Insert ch -> let code = UChar.code (Zed_char.core ch) in if code <= 255 then let ch = Char.chr (UChar.code (Zed_char.core ch)) in match ch with | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> Printf.sprintf "insert(%c)" ch | _ -> Printf.sprintf "insert(U+%02x)" code else if code <= 0xffff then Printf.sprintf "insert(U+%04x)" code else Printf.sprintf "insert(U+%06x)" code | _ -> loop 0 (Array.length actions_to_names) zed-2.0.5/src/zed_edit.mli000066400000000000000000000333301361427230000153610ustar00rootroot00000000000000(* * zed_edit.mli * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Edition engines *) open CamomileLibrary open React type 'a t (** Type of edition engines. ['a] is the type of custom data attached to the engine in order to extend it. *) (** Type of clipboards. *) type clipboard = { clipboard_get : unit -> Zed_rope.t; (** Returns the current contents of the clipboard. *) clipboard_set : Zed_rope.t -> unit; (** Sets the contents of the clipboard. *) } val new_clipboard : unit -> clipboard (** [new_clipboard ()] creates a new clipboard using a reference. *) val regexp_word_core : Zed_re.Core.t (** regexp to core-match a word a-z, A-Z, 0-9 *) val regexp_word_raw : Zed_re.Raw.t (** regexp to raw-match a word a-z, A-Z, 0-9 *) val create : ?editable : (int -> int -> bool) -> ?move : (int -> int -> int) -> ?clipboard : clipboard -> ?match_word : (Zed_rope.t -> int -> int option) -> ?locale : string option signal -> ?undo_size : int -> unit -> 'a t (** [create ?editable ?move ?clipboard ()] creates a new edition engine in the initial state. [editable] is used to determine whether the text at given position is editable or not. It takes as argument the position and the length of the text to remove. [move] is unused. [clipboard] is the clipboard to use for this engine. If none is defined, a new one using a reference is created. [match_word] is used to recognize words. It must returns the end of the matched word if any. [locale] is the locale of this buffer. It is used for case mapping. [undo_size] is the size of the undo buffer. It is the number of state zed will remember. It defaults to [1000]. *) val match_by_regexp_core : Zed_re.Core.t -> Zed_rope.t -> int -> int option (** [match_by_regexp_core re] creates a core-word-matching function using a regular expression. *) val match_by_regexp_raw : Zed_re.Raw.t -> Zed_rope.t -> int -> int option (** [match_by_regexp_raw re] creates a raw-word-matching function using a regular expression. *) (** {5 State} *) val get_data : 'a t -> 'a (** [get_data edit] returns the custom data attached to the engine. It raises [Not_found] if no data is attached to the engine. *) val set_data : 'a t -> 'a -> unit (** [set_data edit data] attach [data] to the engine. *) val clear_data : 'a t -> unit (** [clear_data edit] removes the custom data of engine. *) val text : 'a t -> Zed_rope.t (** [text edit] returns the signal holding the current contents of the buffer. *) val lines : 'a t -> Zed_lines.t (** [lines edit] returns the set of line position of [text edit]. *) val get_line : 'a t -> int -> Zed_rope.t (** [get_line edit n] returns the rope corresponding to the [n]th line without the newline character. *) val changes : 'a t -> Zed_cursor.changes event (** [changes edit] returns an event which occurs with values of the form [(start, added, removed)] when the contents of the engine changes. [start] is the start of modifications, [added] is the number of characters added and [removed] is the number of characters removed. *) val update : 'a t -> Zed_cursor.t list -> unit event (** [update edit cursors] returns an event which occurs each the rendering of the engine should be updated. *) val erase_mode : 'a t -> bool signal (** [erase_mode edit] returns the ``erase'' mode of the buffer. In this mode character inserted in the buffer erase existing ones. *) val get_erase_mode : 'a t -> bool (** [erase_mode edit] returns the current erase mode of the buffer. *) val set_erase_mode : 'a t -> bool -> unit (** [set_erase_mode edit state] sets the status of the erase mode for the given engine. *) val mark : 'a t -> Zed_cursor.t (** [mark edit] returns the cursor used to for the mark in the given engine. *) val selection : 'a t -> bool signal (** [selection edit] returns the signal holding the current selection state. If [true], text is being selectionned. *) val get_selection : 'a t -> bool (** [selection edit] returns the current selection state. *) val set_selection : 'a t -> bool -> unit (** [set_selection edit state] sets the selection state. *) (** {5 Cursors} *) val new_cursor : 'a t -> Zed_cursor.t (** [new_cursor edit] creates a new cursor for the given edition engine. The cursor initially points to the beginning of the buffer. *) (** {5 Actions} *) exception Cannot_edit (** Exception raised when trying to edit a non-editable portion of a buffer. *) type 'a context (** Type of contexts. Contexts are used to modify an edition buffer. *) val context : ?check : bool -> 'a t -> Zed_cursor.t -> 'a context (** [context ?check edit cursor] creates a new context with given parameters. [cursor] is the cursor that will be used for all modification of the text. If [check] is [true] (the default) then all modification of the text will be checked with the [editable] function of the engine. *) val edit : 'a context -> 'a t (** [edit ctx] returns the edition engine used by the given context. *) val cursor : 'a context -> Zed_cursor.t (** [cursor ctx] returns the cursor used by this context. *) val check : 'a context -> bool (** [check ctx] returns whether the context has been created with the [check] flag. *) val with_check : bool -> 'a context -> 'a context (** [with_check check ctx] retuns [ctx] with the check flag set to [check]. *) val goto : 'a context -> ?set_wanted_column : bool -> int -> unit (** [goto ctx ?set_column position] moves the cursor to the given position. It raises {!Zed_cursor.Out_of_bounds} if the position is outside the bounds of the text. If [set_wanted_column] is [true], the wanted column of the cursor is set to the new column. *) val move : 'a context -> ?set_wanted_column : bool -> int -> unit (** [move ctx ?set_wanted_column delta] moves the cursor by the given number of characters. It raises {!Zed_cursor.Out_of_bounds} if the current plus [delta] is outside the bounds of the text. *) val move_line : 'a context -> int -> unit (** [move_line ctx ?set_wanted_column delta] moves the cursor by the given number of lines. *) val position : 'a context -> int (** [position ctx] returns the position of the cursor. *) val line : 'a context -> int (** [line ctx] returns the line of the cursor. *) val column : 'a context -> int (** [column ctx] returns the column of the cursor. *) val column_display : 'a context -> int (** [column_display ctx] returns the display column of the cursor. *) val at_bol : 'a context -> bool (** [at_bol ctx] returns [true] iff the cursor is at the beginning of the current line. *) val at_eol : 'a context -> bool (** [at_eol ctx] returns [true] iff the cursor is at the end of the current line. *) val at_bot : 'a context -> bool (** [at_bot ctx] returns [true] iff the cursor is at the beginning of the text. *) val at_eot : 'a context -> bool (** [at_eot ctx] returns [true] iff the cursor is at the end of the text. *) val insert : 'a context -> Zed_rope.t -> unit (** [insert ctx rope] inserts the given rope at current position. *) val insert_char : 'a context -> UChar.t -> unit (** [insert ctx rope] inserts the given UChar at current position. *) val insert_no_erase : 'a context -> Zed_rope.t -> unit (** [insert ctx rope] inserts the given rope at current position but do not erase text if the buffer is currently in erase mode. *) val remove_next : 'a context -> int -> unit (** [remove_next ctx n] removes [n] characters at current position. If there is less than [n] characters at current position, it removes everything until the end of the text. *) val remove_prev : 'a context -> int -> unit (** [remove_prev ctx n] removes [n] characters before current position. If there is less than [n] characters before current position, it removes everything until the beginning of the text. *) val remove : 'a context -> int -> unit (** Alias for {!remove_next} *) val replace : 'a context -> int -> Zed_rope.t -> unit (** [replace ctx n rope] does the same as: {[ remove ctx n; insert_no_erase ctx rope ]} but in one atomic operation. *) val newline : 'a context -> unit (** Insert a newline character. *) val next_char : 'a context -> unit (** [next_char ctx] moves the cursor to the next character. It does nothing if the cursor is at the end of the text. *) val prev_char : 'a context -> unit (** [prev_char ctx] moves the cursor to the previous character. It does nothing if the cursor is at the beginning of the text. *) val next_line : 'a context -> unit (** [next_line ctx] moves the cursor to the next line. If the cursor is on the last line, it is moved to the end of the buffer. *) val prev_line : 'a context -> unit (** [prev_line ctx] moves the cursor to the previous line. If the cursor is on the first line, it is moved to the beginning of the buffer. *) val goto_bol : 'a context -> unit (** [goto_bol ctx] moves the cursor to the beginning of the current line. *) val goto_eol : 'a context -> unit (** [goto_eol ctx] moves the cursor to the end of the current line. *) val goto_bot : 'a context -> unit (** [goto_bot ctx] moves the cursor to the beginning of the text. *) val goto_eot : 'a context -> unit (** [goto_eot ctx] moves the cursor to the end of the text. *) val delete_next_char : 'a context -> unit (** [delete_next_char ctx] deletes the character after the cursor, if any. *) val delete_prev_char : 'a context -> unit (** [delete_prev_char ctx] delete the character before the cursor. *) val delete_next_line : 'a context -> unit (** [delete_next_line ctx] delete everything until the end of the current line. *) val delete_prev_line : 'a context -> unit (** [delete_next_line ctx] delete everything until the beginning of the current line. *) val kill_next_line : 'a context -> unit (** [kill_next_line ctx] delete everything until the end of the current line and save it to the clipboard. *) val kill_prev_line : 'a context -> unit (** [kill_next_line ctx] delete everything until the beginning of the current line and save it to the clipboard. *) val switch_erase_mode : 'a context -> unit (** [switch_erase_mode ctx] switch the current erase mode. *) val set_mark : 'a context -> unit (** [set_mark ctx] sets the mark at current position. *) val goto_mark : 'a context -> unit (** [goto_mark ctx] moves the cursor to the mark. *) val copy : 'a context -> unit (** [copy ctx] copies the current selectionned region to the clipboard. *) val kill : 'a context -> unit (** [kill ctx] copies the current selectionned region to the clipboard and remove it. *) val yank : 'a context -> unit (** [yank ctx] inserts the contents of the clipboard at current position. *) val capitalize_word : 'a context -> unit (** [capitalize_word ctx] capitalizes the first word after the cursor. *) val lowercase_word : 'a context -> unit (** [lowercase_word ctx] converts the first word after the cursor to lowercase. *) val uppercase_word : 'a context -> unit (** [uppercase_word ctx] converts the first word after the cursor to uppercase. *) val next_word : 'a context -> unit (** [next_word ctx] moves the cursor to the end of the next word. *) val prev_word : 'a context -> unit (** [prev_word ctx] moves the cursor to the beginning of the previous word. *) val delete_next_word : 'a context -> unit (** [delete_next_word ctx] deletes the word after the cursor. *) val delete_prev_word : 'a context -> unit (** [delete_prev_word ctx] deletes the word before the cursor. *) val kill_next_word : 'a context -> unit (** [kill_next_word ctx] deletes the word after the cursor and save it to the clipboard. *) val kill_prev_word : 'a context -> unit (** [kill_prev_word ctx] deletes the word before the cursor and save it to the clipboard. *) val undo : 'a context -> unit (** [undo ctx] reverts the last performed action. *) (** {5 Action by names} *) (** Type of actions. *) type action = | Insert of Zed_char.t | Newline | Next_char | Prev_char | Next_line | Prev_line | Goto_bol | Goto_eol | Goto_bot | Goto_eot | Delete_next_char | Delete_prev_char | Delete_next_line | Delete_prev_line | Kill_next_line | Kill_prev_line | Switch_erase_mode | Set_mark | Goto_mark | Copy | Kill | Yank | Capitalize_word | Lowercase_word | Uppercase_word | Next_word | Prev_word | Delete_next_word | Delete_prev_word | Kill_next_word | Kill_prev_word | Undo val get_action : action -> ('a context -> unit) (** [get_action action] returns the function associated to the given action. *) val actions : (action * string) list (** List of actions with their names, except {!Insert}. *) val doc_of_action : action -> string (** [doc_of_action action] returns a short description of the action. *) val action_of_name : string -> action (** [action_of_name str] converts the given action name into an action. Action name are the same as function name but with '_' replaced by '-'. It raises [Not_found] if the name does not correspond to an action. [Insert ch] is represented by "insert()" where [] is: - a literal ascii character, such as "a", "b", ... - a unicode character, written "U+< code >", such as "U+0041" *) val name_of_action : action -> string (** [name_of_action act] returns the name of the given action. *) zed-2.0.5/src/zed_input.ml000066400000000000000000000070241361427230000154230ustar00rootroot00000000000000(* * zed_input.ml * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) module type S = sig type event type +'a t val empty : 'a t val add : event list -> 'a -> 'a t -> 'a t val remove : event list -> 'a t -> 'a t val fold : (event list -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val bindings : 'a t -> (event list * 'a) list type 'a resolver type 'a pack val pack : ('a -> 'b) -> 'a t -> 'b pack val resolver : 'a pack list -> 'a resolver type 'a result = | Accepted of 'a | Continue of 'a resolver | Rejected val resolve : event -> 'a resolver -> 'a result end module Make (Event : Map.OrderedType) = struct type event = Event.t module Event_map = Map.Make (Event) type 'a t = 'a node Event_map.t and 'a node = | Set of 'a t | Val of 'a let empty = Event_map.empty let rec add events value set = match events with | [] -> invalid_arg "Zed_input.Make.add" | [event] -> Event_map.add event (Val value) set | event :: events -> match try Some (Event_map.find event set) with Not_found -> None with | None | Some (Val _) -> Event_map.add event (Set (add events value empty)) set | Some (Set s) -> Event_map.add event (Set (add events value s)) set let rec remove events set = match events with | [] -> invalid_arg "Zed_input.Make.remove" | [event] -> Event_map.remove event set | event :: events -> match try Some (Event_map.find event set) with Not_found -> None with | None | Some (Val _) -> set | Some (Set s) -> let s = remove events s in if Event_map.is_empty s then Event_map.remove event set else Event_map.add event (Set s) set let fold f set acc = let rec loop prefix set acc = Event_map.fold (fun event node acc -> match node with | Val v -> f (List.rev (event :: prefix)) v acc | Set s -> loop (event :: prefix) s acc) set acc in loop [] set acc let bindings set = List.rev (fold (fun events action l -> (events, action) :: l) set []) module type Pack = sig type a type b val set : a t val map : a -> b end type 'a pack = (module Pack with type b = 'a) type 'a resolver = 'a pack list let pack (type u) (type v) map set = let module Pack = struct type a = u type b = v let set = set let map = map end in (module Pack : Pack with type b = v) let resolver l = l type 'a result = | Accepted of 'a | Continue of 'a resolver | Rejected let rec resolve_rec : 'a. event -> 'a pack list -> 'a pack list -> 'a result = fun (type u) event acc packs -> match packs with | [] -> if acc = [] then Rejected else Continue (List.rev acc) | p :: packs -> let module Pack = (val p : Pack with type b = u) in match try Some (Event_map.find event Pack.set) with Not_found -> None with | Some (Set set) -> resolve_rec event (pack Pack.map set :: acc) packs | Some (Val v) -> Accepted (Pack.map v) | None -> resolve_rec event acc packs let resolve event sets = resolve_rec event [] sets end zed-2.0.5/src/zed_input.mli000066400000000000000000000041561361427230000155770ustar00rootroot00000000000000(* * zed_input.mli * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Helpers for writing key bindings *) (** Signature for binders. *) module type S = sig type event (** Type of events. *) type +'a t (** Type of set of bindings mapping input sequence to values of type ['a]. *) val empty : 'a t (** The empty set of bindings. *) val add : event list -> 'a -> 'a t -> 'a t (** [add events x bindings] binds [events] to [x]. It raises [Invalid_argument] if [events] is empty. *) val remove : event list -> 'a t -> 'a t (** [remove events bindings] unbinds [events]. It raises [Invalid_argument] if [events] is empty. *) val fold : (event list -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** [fold f set acc] executes [f] on all sequence of [set], accumulating a value. *) val bindings : 'a t -> (event list * 'a) list (** [bindings set] returns all bindings of [set]. *) type 'a resolver (** Type of a resolver. A resolver is used to resolve an input sequence, i.e. to find the value associated to one. It returns a value of type ['a] when a matching sequence is found. *) type 'a pack (** A pack is a pair of a set of bindings and a mapping function. *) val pack : ('a -> 'b) -> 'a t -> 'b pack (** [pack f set] creates a pack. *) val resolver : 'a pack list -> 'a resolver (** [resolver packs] creates a resolver from a list of pack. *) (** Result of a resolving operation. *) type 'a result = | Accepted of 'a (** The sequence is terminated and associated to the given value. *) | Continue of 'a resolver (** The sequence is not terminated. *) | Rejected (** None of the sequences is prefixed by the one. *) val resolve : event -> 'a resolver -> 'a result (** [resolve event resolver] tries to resolve [event] using [resolver]. *) end module Make (Event : Map.OrderedType) : S with type event = Event.t (** [Make (Event)] makes a a new binder. *) zed-2.0.5/src/zed_lines.ml000066400000000000000000000231761361427230000154040ustar00rootroot00000000000000(* * zed_lines.ml * ------------ * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open Result open CamomileLibraryDefault.Camomile exception Out_of_bounds (* +-----------------------------------------------------------------+ | Representation | +-----------------------------------------------------------------+ *) (* Sets are represented by ropes. *) type line= { length: int; width: int; width_info: int array; } type t = | String of line (* [String len] is a string of length [len] without newline character. *) | Return (* A newline character. *) | Concat of t * t * int * int * int (* [Concat(t1, t2, len, count, depth)] *) (* +-----------------------------------------------------------------+ | Basic functions | +-----------------------------------------------------------------+ *) let empty_line ()= { length= 0; width= 0; width_info= [||] } let length = function | String line -> line.length | Return -> 1 | Concat(_, _, len, _, _) -> len let count = function | String _ -> 0 | Return -> 1 | Concat(_, _, _, count, _) -> count let depth = function | String _ | Return -> 0 | Concat(_, _, _, _, d) -> d let empty = String (empty_line ()) let unsafe_width ?(tolerant=false) set idx len= let start= idx and len_all= len and acc= if tolerant then fun a b-> (+) (if a < 0 then 1 else a) (if b < 0 then 1 else b) else (+) in let rec unsafe_width set idx len= if len = 0 then Ok 0 else match set with | Return-> Error (start + len_all - len) | String line-> Ok (Array.fold_left acc 0 (Array.sub line.width_info idx len)) | Concat (set1, set2, _,_,_)-> let len1= length set1 in if idx + len <= len1 then unsafe_width set1 idx len else if idx >= len1 then unsafe_width set2 (idx-len1) len else let r1= unsafe_width set1 idx (len1 - idx) and r2= unsafe_width set2 0 (len - len1 + idx) in match r1, r2 with | Error ofs, _-> Error ofs | Ok _, Error ofs-> Error ofs | Ok w1, Ok w2-> Ok (w1 + w2) in unsafe_width set idx len let width ?(tolerant=false) set idx len = if idx < 0 || len < 0 || idx + len > length set then raise Out_of_bounds else unsafe_width ~tolerant set idx len let force_width set idx len= let acc a b= (+) (if a < 0 then 1 else a) (if b < 0 then 1 else b) in let rec force_width set idx len= if len = 0 then 0 else match set with | Return-> 0 | String line-> Array.fold_left acc 0 (Array.sub line.width_info idx len) | Concat (set1, set2, _,_,_)-> let len1= length set1 in if idx + len <= len1 then force_width set1 idx len else if idx >= len1 then force_width set2 (idx-len1) len else let r1= force_width set1 idx (len1 - idx) and r2= force_width set2 0 (len - len1 + idx) in r1 + r2 in if idx < 0 || len < 0 || idx + len > length set then raise Out_of_bounds else force_width set idx len (* +-----------------------------------------------------------------+ | Offset/line resolution | +-----------------------------------------------------------------+ *) let rec line_index_rec set ofs acc = match set with | String _ -> acc | Return -> if ofs = 0 then acc else acc + 1 | Concat(s1, s2, _, _, _) -> let len1 = length s1 in if ofs < len1 then line_index_rec s1 ofs acc else line_index_rec s2 (ofs - len1) (acc + count s1) let line_index set ofs = if ofs < 0 || ofs > length set then raise Out_of_bounds else line_index_rec set ofs 0 let rec line_start_rec set idx acc = match set with | String _ -> acc | Return -> if idx = 0 then acc else acc + 1 | Concat(s1, s2, _, _, _) -> let count1 = count s1 in if idx <= count1 then line_start_rec s1 idx acc else line_start_rec s2 (idx - count1) (acc + length s1) let line_start set idx = if idx < 0 || idx > count set then raise Out_of_bounds else line_start_rec set idx 0 let line_stop set idx = if idx = count set then length set else line_start set (idx + 1) - 1 let line_length set idx = line_stop set idx - line_start set idx (* +-----------------------------------------------------------------+ | Operations on sets | +-----------------------------------------------------------------+ *) let concat set1 set2 = Concat( set1, set2, length set1 + length set2, count set1 + count set2, 1 + max (depth set1) (depth set2)) let append_line l1 l2= { length= l1.length + l2.length; width= l1.width + l2.width; width_info= Array.append l1.width_info l2.width_info } let append set1 set2 = match set1, set2 with | String {length= 0;_}, _ -> set2 | _, String {length= 0;_} -> set1 | String l1, String l2 -> String (append_line l1 l2) | String l1, Concat(String l2, set, len, count, h) -> Concat(String (append_line l1 l2), set, len + l1.length, count, h) | Concat(set, String l1, len, count, h), String l2 -> Concat(set, String(append_line l1 l2), len + l2.length, count, h) | _ -> let d1 = depth set1 and d2 = depth set2 in if d1 > d2 + 2 then begin match set1 with | String _ | Return -> assert false | Concat(set1_1, set1_2, _, _, _) -> if depth set1_1 >= depth set1_2 then concat set1_1 (concat set1_2 set2) else begin match set1_2 with | String _ | Return -> assert false | Concat(set1_2_1, set1_2_2, _, _, _) -> concat (concat set1_1 set1_2_1) (concat set1_2_2 set2) end end else if d2 > d1 + 2 then begin match set2 with | String _ | Return -> assert false | Concat(set2_1, set2_2, _, _, _) -> if depth set2_2 >= depth set2_1 then concat (concat set1 set2_1) set2_2 else begin match set2_1 with | String _ | Return -> assert false | Concat(set2_1_1, set2_1_2, _, _, _) -> concat (concat set1 set2_1_1) (concat set2_1_2 set2_2) end end else concat set1 set2 let rec unsafe_sub set idx len = match set with | String line -> let length= len in let width_info= Array.sub line.width_info idx length in let width= Array.fold_left (+) 0 width_info in String { length; width; width_info } | Return -> if len = 1 then Return else String (empty_line ()) | Concat(set_l, set_r, len', _, _) -> let len_l = length set_l in if len = len' then set else if idx >= len_l then unsafe_sub set_r (idx - len_l) len else if idx + len <= len_l then unsafe_sub set_l idx len else append (unsafe_sub set_l idx (len_l - idx)) (unsafe_sub set_r 0 (len - len_l + idx)) let sub set idx len = if idx < 0 || len < 0 || idx + len > length set then raise Out_of_bounds else unsafe_sub set idx len let break set ofs = let len = length set in if ofs < 0 || ofs > len then raise Out_of_bounds else (unsafe_sub set 0 ofs, unsafe_sub set ofs (len - ofs)) let insert set ofs set' = let set1, set2 = break set ofs in append set1 (append set' set2) let remove set ofs len = append (sub set 0 ofs) (sub set (ofs + len) (length set - ofs - len)) let replace set ofs len repl = append (sub set 0 ofs) (append repl (sub set (ofs + len) (length set - ofs - len))) (* +-----------------------------------------------------------------+ | Sets from ropes | +-----------------------------------------------------------------+ *) let of_rope rope = let calc_widths widths= let width_info= widths |> List.rev |> Array.of_list in let width= Array.fold_left (+) 0 width_info in (width, width_info) in let rec loop zip (length, widths) acc = if Zed_rope.Zip.at_eos zip then let width, width_info= calc_widths widths in append acc (String { length; width; width_info }) else let ch, zip = Zed_rope.Zip.next zip in if UChar.code (Zed_char.core ch) = 10 then let width, width_info= calc_widths widths in loop0 zip (append (append acc (String { length; width; width_info })) Return) else loop zip (length + 1, Zed_char.width ch::widths) acc and loop0 zip acc = if Zed_rope.Zip.at_eos zip then acc else let ch, zip = Zed_rope.Zip.next zip in if UChar.code (Zed_char.core ch) = 10 then loop0 zip (append acc Return) else loop zip (1, [Zed_char.width ch]) acc in loop0 (Zed_rope.Zip.make_f rope 0) empty (* +-----------------------------------------------------------------+ | Index and width | +-----------------------------------------------------------------+ *) let get_idx_by_width set row column= let start= line_start set row in let stop= line_stop set row in let rec get idx acc_width= if acc_width >= column || idx >= stop then idx else let curr_width= force_width set idx 1 in if acc_width + curr_width > column then idx (* the width of the current char covers the column *) else get (idx+1) (acc_width + curr_width) in get start 0 zed-2.0.5/src/zed_lines.mli000066400000000000000000000044211361427230000155450ustar00rootroot00000000000000(* * zed_lines.mli * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Sets of line positions. *) (** This module implement sets of line positions. They allow to efficiently find the beginning of a line and to convert offset to line and column number. *) open Result exception Out_of_bounds (** Exception raised when trying to access a position outside the bounds of a set. *) type line type t (** Type of sets of line positions. *) val length : t -> int (** Returns the length of the set, i.e. the number of characters in the set. *) val count : t -> int (** Returns the number of newlines in the set. *) val of_rope : Zed_rope.t -> t (** [of_rope rope] returns the set of newline positions in [rope]. *) val empty : t (** The empty set. *) val width : ?tolerant:bool -> t -> int -> int -> (int, int) result (** Returns the width of the given string. *) val force_width : t -> int -> int -> int (** Returns the width of the given string. If error encounted, returns the width of the legit part *) val line_index : t -> int -> int (** [line_index set ofs] returns the line number of the line containing [ofs]. *) val line_start : t -> int -> int (** [line_start set idx] returns the offset of the beginning of the [idx]th line of [set] . *) val line_stop : t -> int -> int (** [line_stop set idx] returns the offset of the end of the [idx]th line of [set] . *) val line_length : t -> int -> int (** [line_length set idx] returns the length of the [idx]th line of [set] . *) val append : t -> t -> t (** [append s1 s2] concatenates two sets of line positions. *) val insert : t -> int -> t -> t (** [insert set offset set'] inserts [set] at given positon in [set'].*) val remove : t -> int -> int -> t (** [remove set offet length] removes [length] characters at [offset] in set. *) val replace : t -> int -> int -> t -> t (** [replace set offset length repl] replaces the subset at offset [offset] and length [length] by [repl] in [set]. *) val get_idx_by_width : t -> int -> int -> int (** [get_idx_by_width set row column_width] return the offset of the char at \[row, column_width\]. *) zed-2.0.5/src/zed_macro.ml000066400000000000000000000031541361427230000153650ustar00rootroot00000000000000(* * zed_macro.ml * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open React type 'a t = { recording : bool signal; set_recording : bool -> unit; mutable tmp_macro : 'a list; mutable macro : 'a list; count : int signal; set_count : int -> unit; counter : int signal; set_counter : int -> unit; } let create macro = let recording, set_recording = S.create false in let count, set_count = S.create 0 in let counter, set_counter = S.create 0 in { recording; set_recording; macro; tmp_macro = []; count; set_count; counter; set_counter; } let recording r = r.recording let get_recording r = S.value r.recording let set_recording r state = match state with | true -> r.tmp_macro <- []; r.set_recording true; r.set_count 0; r.set_counter 0 | false -> if S.value r.recording then begin r.macro <- List.rev r.tmp_macro; r.tmp_macro <- []; r.set_recording false; r.set_count 0 end let cancel r = if S.value r.recording then begin r.tmp_macro <- []; r.set_recording false; r.set_count 0 end let count r = r.count let get_count r = S.value r.count let counter r = r.counter let get_counter r = S.value r.counter let set_counter r v = r.set_counter v let add_counter r v = r.set_counter (S.value r.counter + v) let add r x = if S.value r.recording then begin r.tmp_macro <- x :: r.tmp_macro; r.set_count (S.value r.count + 1) end let contents r = r.macro zed-2.0.5/src/zed_macro.mli000066400000000000000000000027351361427230000155420ustar00rootroot00000000000000(* * zed_macro.mli * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Macro recorder *) type 'a t (** Type of macro recorders. *) val create : 'a list -> 'a t (** [create macro] create a new macro recorder, with initial contents [macro]. *) val recording : 'a t -> bool React.signal (** Whether the recorder is recording a macro. *) val get_recording : 'a t -> bool (** Returns the current state of the recorder. *) val set_recording : 'a t -> bool -> unit (** Starts or stops the macro recorder. *) val cancel : 'a t -> unit (** Cancels the current macro if recording one. *) val count : 'a t -> int React.signal (** The number of actions in the macro recorder. It is [0] if the recorder is not currently recording. *) val get_count : 'a t -> int (** Returns the current number of actions in the macro recorder. *) val add : 'a t -> 'a -> unit (** [add recorder x] adds [x] to the recorder if it is recording a macro. *) val contents : 'a t -> 'a list (** Returns the currently recorded macro. *) val counter : 'a t -> int React.signal (** The contents of the macro counter. *) val get_counter : 'a t -> int (** Gets the contents of the macro counter. *) val set_counter : 'a t -> int -> unit (** Sets the macro counter to the given value. *) val add_counter : 'a t -> int -> unit (** Adds the given value to the macro counter. *) zed-2.0.5/src/zed_re.ml000066400000000000000000000052511361427230000146720ustar00rootroot00000000000000(* * zed_re.ml * --------- * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile module Core = struct module Re = URe.Make(Zed_rope.Text_core) type t = Re.compiled_regexp type match_result = (Re.index * Re.index) option array option let compile = Re.compile let convert_success arr = Array.map (function | Some sub -> let _rope, zip1, zip2 = Re.SubText.context sub in Some(zip1, zip2) | None -> None) arr let convert = function | Some arr -> Some(convert_success arr) | None -> None let regexp_match ?sem regexp rope idx = convert (Re.regexp_match ?sem regexp rope (Zed_rope.Zip.make_f rope idx)) let search_forward ?sem regexp rope idx = convert (try Re.search_forward ?sem regexp rope (Zed_rope.Zip.make_f rope idx) with Not_found -> None) let search_backward ?sem regexp rope idx = let rec loop zip = match Re.regexp_match ?sem regexp rope zip with | Some arr -> Some(convert_success arr) | None -> if Zed_rope.Zip.at_bos zip then None else loop (Zed_rope.Zip.move (-1) zip) in loop (Zed_rope.Zip.make_f rope idx) let subtext_to_uChars= let module CS = Zed_utils.Convert(Re.SubText) in CS.to_uChars end module Raw = struct module Re = URe.Make(Zed_rope.Text_raw) type t = Re.compiled_regexp type match_result = (Re.index * Re.index) option array option let compile = Re.compile let convert_success arr = Array.map (function | Some sub -> let _rope, zip1, zip2 = Re.SubText.context sub in Some(zip1, zip2) | None -> None) arr let convert = function | Some arr -> Some(convert_success arr) | None -> None let regexp_match ?sem regexp rope idx = convert (Re.regexp_match ?sem regexp rope (Zed_rope.Zip_raw.make_f rope idx)) let search_forward ?sem regexp rope idx = convert (try Re.search_forward ?sem regexp rope (Zed_rope.Zip_raw.make_f rope idx) with Not_found -> None) let search_backward ?sem regexp rope idx = let rec loop zip = match Re.regexp_match ?sem regexp rope zip with | Some arr -> Some(convert_success arr) | None -> if Zed_rope.Zip_raw.at_bos zip then None else loop (Zed_rope.Zip_raw.move (-1) zip) in loop (Zed_rope.Zip_raw.make_f rope idx) let subtext_to_uChars= let module CS = Zed_utils.Convert(Re.SubText) in CS.to_uChars end zed-2.0.5/src/zed_re.mli000066400000000000000000000060511361427230000150420ustar00rootroot00000000000000(* * zed_re.mli * ---------- * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Regular expressions on ropes *) open CamomileLibrary module Core : sig module Re : URe.Type with type text = Zed_rope.Text_core.t and type index = Zed_rope.Text_core.index type t (** Type of compiled regular expressions. *) type match_result = (Re.index * Re.index) option array option (** Type of a match result. If the match fail, [None] is returned. Otherwise an array of matched sub-strings is returned, the index [0] corresponding to the full match, and other indexes to matched groups. *) val compile : URe.regexp -> t (** [compile regexp] compiles the given regular expression. *) val regexp_match : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [regexp_match ?sem regexp rope pos] tries to match [regexp] on given rope, starting at [pos]. *) val search_forward : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [search_forward ?sem regexp rope pos] searches the given regular expression in [rope] starting at [pos]. *) val search_backward : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [search_backward ?sem regexp rope pos] searches the given regular expression in [rope] starting at [pos], in reverse order. *) val subtext_to_uChars : Re.SubText.t -> UChar.t list end module Raw : sig module Re : URe.Type with type text = Zed_rope.Text_raw.t and type index = Zed_rope.Text_raw.index type t (** Type of compiled regular expressions. *) type match_result = (Re.index * Re.index) option array option (** Type of a match result. If the match fail, [None] is returned. Otherwise an array of matched sub-strings is returned, the index [0] corresponding to the full match, and other indexes to matched groups. *) val compile : URe.regexp -> t (** [compile regexp] compiles the given regular expression. *) val regexp_match : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [regexp_match ?sem regexp rope pos] tries to match [regexp] on given rope, starting at [pos]. *) val search_forward : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [search_forward ?sem regexp rope pos] searches the given regular expression in [rope] starting at [pos]. *) val search_backward : ?sem:URe.match_semantics -> t -> Zed_rope.t -> int -> (Re.index * Re.index) option array option (** [search_backward ?sem regexp rope pos] searches the given regular expression in [rope] starting at [pos], in reverse order. *) val subtext_to_uChars : Re.SubText.t -> UChar.t list end zed-2.0.5/src/zed_rope.ml000066400000000000000000000744161361427230000152420ustar00rootroot00000000000000(* * zed_rope.ml * ----------- * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (* Maximum length of a leaf *) let max_leaf_size= 256 exception Out_of_bounds (* +-----------------------------------------------------------------+ | Ropes representation | +-----------------------------------------------------------------+ *) type t= (* the size is the number of UChar.t in the rope *) | Leaf of Zed_string.t * (int * int) (* [Leaf(str, (len, size))] *) | Node of int * (int * int) * t * (int * int) * t (* [Node(depth, (length_left, size_left), left, (length_right, size_right), right)] *) type rope= t let empty ()= Leaf (Zed_string.empty (), (0, 0)) (* +-----------------------------------------------------------------+ | Basic operations | +-----------------------------------------------------------------+ *) let length= function | Leaf(_, (len, _)) -> len | Node(_, (len_l,_), _, (len_r,_), _) -> len_l + len_r let size= function | Leaf(_, (_,size)) -> size | Node(_, (_,size_l), _, (_,size_r), _) -> size_l + size_r let depth= function | Leaf _ -> 0 | Node(d, _, _, _, _) -> d let is_empty= function | Leaf(_, (0, 0)) -> true | _ -> false let rec trim_hd t= match t with | Leaf (str, (l, _))-> let hd, _= Zed_string.extract_next str 0 in let hd= hd |> Zed_char.to_utf8 |> Zed_string.unsafe_of_utf8 in let after= Zed_string.after str 1 in let size= Zed_string.size after in (Leaf (after, (l-1, size)), hd) | Node (d, (ll, _sl), l, (lr, sr), r)-> let t, hd= trim_hd l in let size= size t in (Node (d, (ll-1, size), t, (lr, sr), r), hd) let append_cm t cm= let size= Zed_string.size cm in let rec append_cm t= match t with | Leaf (str, (l, s))-> Leaf (Zed_string.append str cm, (l, s + size)) | Node (d, (ll, sl), l, (lr, sr), r)-> Node (d, (ll, sl), l, (lr, sr + size), append_cm r) in append_cm t (* +-----------------------------------------------------------------+ | Balancing | +-----------------------------------------------------------------+ *) let rec make_fibo acc a b= let c= a + b in if c < b then (* overflow *) acc else make_fibo (c :: acc) b c let fibo= let l= make_fibo [1; 1; 0] 1 1 in let n= List.length l in let fibo= Array.make n 0 in let rec loop i= function | [] -> fibo | x :: l -> fibo.(i) <- x; loop (i - 1) l in loop (n - 1) l let max_depth= Array.length fibo let unsafe_concat rope1 rope2= match rope1, rope2 with | Leaf(_, (0,_)), _ -> rope2 | _, Leaf(_, (0,_)) -> rope1 | _ -> Node( 1 + max (depth rope1) (depth rope2), (length rope1, size rope1), rope1, (length rope2, size rope2), rope2) let rec insert_to_forest forest acc idx= let acc= unsafe_concat forest.(idx) acc in if length acc < fibo.(idx + 1) then forest.(idx) <- acc else begin forest.(idx) <- empty (); insert_to_forest forest acc (idx + 1) end let rec concat_forest_until forest acc idx rope= if length rope < fibo.(idx + 1) then insert_to_forest forest (unsafe_concat acc rope) idx else begin let acc= unsafe_concat forest.(idx) acc in forest.(idx) <- empty (); concat_forest_until forest acc (idx + 1) rope end let rec balance_rec forest rope= match rope with | Leaf _ -> concat_forest_until forest (empty ()) 2 rope | Node(_depth, _len_l, rope_l, _len_r, rope_r) -> balance_rec forest rope_l; balance_rec forest rope_r let rec concat_forest forest acc idx= if idx = max_depth then acc else concat_forest forest (unsafe_concat forest.(idx) acc) (idx + 1) let balance rope= match length rope with | 0 | 1 -> rope | len when len >= fibo.(depth rope + 2) -> rope | _len -> let forest= Array.make max_depth (empty ()) in balance_rec forest rope; concat_forest forest (empty ()) 2 (* +-----------------------------------------------------------------+ | Leaf operations | +-----------------------------------------------------------------+ *) let rec unsafe_get idx rope = match rope with | Leaf(text, _) -> Zed_string.get text idx | Node(_, (len_l,_), rope_l, _len_r, rope_r) -> if idx < len_l then unsafe_get idx rope_l else unsafe_get (idx - len_l) rope_r let get rope idx = if idx < 0 || idx >= length rope then raise Out_of_bounds else unsafe_get idx rope let rec unsafe_get_raw idx rope = match rope with | Leaf(text, _) -> Zed_string.get_raw text idx | Node(_, (_,size_l), rope_l, _len_r, rope_r) -> if idx < size_l then unsafe_get_raw idx rope_l else unsafe_get_raw (idx - size_l) rope_r let get_raw rope idx = if idx < 0 || idx >= size rope then raise Out_of_bounds else unsafe_get_raw idx rope let append rope1 rope2 = let len_12_comb= if length rope1 > 0 && length rope2 > 0 then Zed_char.is_combining_mark (Zed_char.core (get rope2 0)) else false in let len12 l1 l2= if len_12_comb then l1 + l2 - 1 else l1 + l2 in match rope1, rope2 with | Leaf(_, (0,_)), _ -> rope2 | _, Leaf(_, (0,_)) -> rope1 | Leaf(text1, (len1, size1)), Leaf(text2, (len2, size2)) when len12 len1 len2 <= max_leaf_size -> Leaf(Zed_string.append text1 text2, (len12 len1 len2, size1+size2)) | Node(d, len_l, rope_l, _, Leaf(text1, (len1,size1))), Leaf(text2, (len2,size2)) when len12 len1 len2 <= max_leaf_size -> let ls= len12 len1 len2, size1+size2 in Node( d, len_l, rope_l, ls, Leaf(Zed_string.append text1 text2, ls)) | Leaf(text1, (len1,size1)), Node(d, _, Leaf(text2, (len2,size2)), len_r, rope_r) when len12 len1 len2 <= max_leaf_size -> let ls= len12 len1 len2, size1+size2 in Node( d, ls, Leaf(Zed_string.append text1 text2, ls), len_r, rope_r) | _ -> let rope1, rope2= if length rope1 > 0 && length rope2 > 0 then if Zed_char.is_combining_mark (Zed_char.core (get rope2 0)) then let r2, hd= trim_hd rope2 in let r1= append_cm rope1 hd in r1, r2 else rope1, rope2 else rope1, rope2 in balance (Node( 1 + max (depth rope1) (depth rope2), (length rope1, size rope1), rope1, (length rope2, size rope2), rope2)) let concat sep l = let rec loop acc = function | [] -> acc | x :: l -> loop (append (append acc sep) x) l in match l with | [] -> empty () | x :: l -> loop x l let rec unsafe_sub rope idx len = match rope with | Leaf(text, _) -> let str= Zed_string.sub ~pos:idx ~len text in let size= Zed_string.size str in Leaf(str, (len,size)) | Node(_, (len_l,_), rope_l, (len_r,_), rope_r) -> if len = len_l + len_r then rope else if idx >= len_l then unsafe_sub rope_r (idx - len_l) len else if idx + len <= len_l then unsafe_sub rope_l idx len else append (unsafe_sub rope_l idx (len_l - idx)) (unsafe_sub rope_r 0 (len - len_l + idx)) let sub rope idx len = if idx < 0 || len < 0 || idx + len > length rope then raise Out_of_bounds else unsafe_sub rope idx len let make length char = if length < max_leaf_size then Leaf(Zed_string.make length char, (length, length)) else begin let text = Zed_string.make max_leaf_size char in let chunk = Leaf(text, (max_leaf_size, max_leaf_size)) in let rec loop acc n = if n = 0 then acc else if n < max_leaf_size then let str= Zed_string.sub ~pos:0 ~len:n text in let size= Zed_string.size str in append acc (Leaf(str, (n, size))) else loop (append acc chunk) (n - max_leaf_size) in loop (empty ()) length end let singleton ch = Leaf(Zed_string.make 1 ch, (1, 1)) let break rope pos = let len = length rope in if pos < 0 || pos > len then raise Out_of_bounds; (unsafe_sub rope 0 pos, unsafe_sub rope pos (len - pos)) let before rope pos = sub rope 0 pos let after rope pos = sub rope pos (length rope - pos) let insert rope pos sub = let before, after = break rope pos in append before (append sub after) let remove rope pos len = append (sub rope 0 pos) (sub rope (pos + len) (length rope - pos - len)) let replace rope pos len repl = append (sub rope 0 pos) (append repl (sub rope (pos + len) (length rope - pos - len))) let insert_uChar rope pos ch = let open CamomileLibraryDefault.Camomile in if UChar.code ch = 0 then rope else if Zed_char.is_combining_mark ch then if length rope = 0 then failwith "inserting an individual combining mark" else if pos = 0 then failwith "inserting an individual combining mark" else let pos= if pos > 0 then pos - 1 else pos in let glyph= get rope pos in if Zed_char.is_printable_core (Zed_char.core glyph) then let glyph= Zed_char.append glyph ch in replace rope pos 1 (Leaf (Zed_string.implode [glyph], (1, 1))) else failwith "inserting an individual combining mark" else let sub= Leaf (Zed_string.implode [Zed_char.unsafe_of_uChar ch], (1, 1)) in insert rope pos sub let lchop = function | Leaf(_, (0,_)) -> empty () | rope -> sub rope 1 (length rope - 1) let rchop = function | Leaf(_, (0,_)) -> empty () | rope -> sub rope 0 (length rope - 1) (* +-----------------------------------------------------------------+ | Iterating, folding and mapping | +-----------------------------------------------------------------+ *) let rec iter f = function | Leaf(text, _) -> Zed_string.iter f text | Node(_, _, rope_l, _, rope_r) -> iter f rope_l; iter f rope_r let rec rev_iter f = function | Leaf(text, _) -> Zed_string.rev_iter f text | Node(_, _, rope_l, _, rope_r) -> rev_iter f rope_r; rev_iter f rope_l let rec fold f rope acc = match rope with | Leaf(text, _) -> Zed_string.fold f text acc | Node(_, _, rope_l, _, rope_r) -> fold f rope_r (fold f rope_l acc) let rec rev_fold f rope acc = match rope with | Leaf(text, _) -> Zed_string.rev_fold f text acc | Node(_, _, rope_l, _, rope_r) -> rev_fold f rope_l (rev_fold f rope_r acc) let rec map f = function | Leaf(txt, len) -> Leaf(Zed_string.map f txt, len) | Node(depth, length_l, rope_l, length_r, rope_r) -> let rope_l' = map f rope_l in let rope_r' = map f rope_r in Node(depth, length_l, rope_l', length_r, rope_r') let rec rev_map f = function | Leaf(txt, len) -> Leaf(Zed_string.rev_map f txt, len) | Node(depth, length_l, rope_l, length_r, rope_r) -> let rope_l' = rev_map f rope_l in let rope_r' = rev_map f rope_r in Node(depth, length_r, rope_r', length_l, rope_l') let rec iter_leaf f = function | Leaf(text, _) -> f text | Node(_, _, rope_l, _, rope_r) -> iter_leaf f rope_l; iter_leaf f rope_r let rec rev_iter_leaf f = function | Leaf(text, _) -> f text | Node(_, _, rope_l, _, rope_r) -> rev_iter_leaf f rope_r; rev_iter_leaf f rope_l let rec fold_leaf f rope acc = match rope with | Leaf(text, _) -> f text acc | Node(_, _, rope_l, _, rope_r) -> fold_leaf f rope_r (fold_leaf f rope_l acc) let rec rev_fold_leaf f rope acc = match rope with | Leaf(text, _) -> f text acc | Node(_, _, rope_l, _, rope_r) -> rev_fold_leaf f rope_l (rev_fold_leaf f rope_r acc) (* +-----------------------------------------------------------------+ | Comparison | +-----------------------------------------------------------------+ *) let rec cmp_loop str1 ofs1 str2 ofs2 rest1 rest2 = if ofs1 = Zed_string.bytes str1 then match rest1 with | [] -> if ofs2 = Zed_string.length str2 && rest2 = [] then 0 else -1 | rope1 :: rest1 -> cmp_search1 rope1 str2 ofs2 rest1 rest2 else if ofs2 = Zed_string.bytes str2 then match rest2 with | [] -> 1 | rope2 :: rest2 -> cmp_search2 rope2 str1 ofs1 rest1 rest2 else let chr1, ofs1 = Zed_string.extract_next str1 ofs1 and chr2, ofs2 = Zed_string.extract_next str2 ofs2 in let d = Zed_char.compare_raw chr1 chr2 in if d = 0 then cmp_loop str1 ofs1 str2 ofs2 rest1 rest2 else d and cmp_search1 rope1 str2 ofs2 rest1 rest2 = match rope1 with | Leaf(str1, _) -> cmp_loop str1 0 str2 ofs2 rest1 rest2 | Node(_, _, rope1_l, _, rope1_r) -> cmp_search1 rope1_l str2 ofs2 (rope1_r :: rest1) rest2 and cmp_search2 rope2 str1 ofs1 rest1 rest2 = match rope2 with | Leaf(str2, _) -> cmp_loop str1 ofs1 str2 0 rest1 rest2 | Node(_, _, rope2_l, _, rope2_r) -> cmp_search2 rope2_l str1 ofs1 rest1 (rope2_r :: rest2) let rec cmp_init rope1 rope2 rest1 = match rope1 with | Leaf(str1, _) -> cmp_search2 rope2 str1 0 rest1 [] | Node(_, _, rope1_l, _, rope1_r) -> cmp_init rope1_l rope2 (rope1_r :: rest1) let compare r1 r2 = cmp_init r1 r2 [] let equal r1 r2 = length r1 = length r2 && compare r1 r2 = 0 (* +-----------------------------------------------------------------+ | Zippers | +-----------------------------------------------------------------+ *) module Zip = struct type rope_zipper = { str : Zed_string.t; (* The string of the current leaf. *) ofs : int; (* The offset of the current leaf in the whole rope. *) leaf : t; (* The current leaf. *) rest_b : t list; rest_f : t list; } type t = { idx : int; (* The index in byte of the zipper in the current leaf. *) pos : int; (* The index in character of the zipper in the current leaf. *) zip : rope_zipper; } let rec make_rec ofs rope pos rest_b rest_f = match rope with | Leaf(str, _) -> { idx= Zed_string.move str 0 pos; pos = pos; zip = { str; ofs = ofs - pos; leaf = rope; rest_b; rest_f } } | Node(_, _, r1, _, r2) -> let len1 = length r1 in if pos < len1 then make_rec ofs r1 pos rest_b (r2 :: rest_f) else make_rec ofs r2 (pos - len1) (r1 :: rest_b) rest_f let make_f rope pos = if pos < 0 || pos > length rope then raise Out_of_bounds; make_rec pos rope pos [] [] let make_b rope pos = let len = length rope in if pos < 0 || pos > len then raise Out_of_bounds; let pos = len - pos in make_rec pos rope pos [] [] let offset zip = zip.zip.ofs + zip.pos let rec next_leaf ofs rope rest_b rest_f = match rope with | Leaf(str, _) -> let chr, idx= Zed_string.extract_next str 0 in (chr, { idx; pos = 1; zip = { str; ofs; leaf = rope; rest_b; rest_f } }) | Node(_, _, r1, _, r2) -> next_leaf ofs r1 rest_b (r2 :: rest_f) let next zip = if zip.idx = Zed_string.bytes zip.zip.str then match zip.zip.rest_f with | [] -> raise Out_of_bounds | rope :: rest -> next_leaf (zip.zip.ofs + length zip.zip.leaf) rope (zip.zip.leaf :: zip.zip.rest_b) rest else let chr, idx= Zed_string.extract_next zip.zip.str zip.idx in (chr, { zip with idx; pos = zip.pos + 1 }) let rec prev_leaf ofs rope rest_b rest_f = match rope with | Leaf(str, (len,_size)) -> let chr, idx= Zed_string.extract_prev str (Zed_string.bytes str) in (chr, { idx; pos = len - 1; zip = { str; ofs = ofs - len; leaf = rope; rest_b; rest_f } }) | Node(_, _, r1, _, r2) -> prev_leaf ofs r2 (r1 :: rest_b) rest_f let prev zip = if zip.pos = 0 then match zip.zip.rest_b with | [] -> raise Out_of_bounds | rope :: rest -> prev_leaf zip.zip.ofs rope rest (zip.zip.leaf :: zip.zip.rest_f) else let chr, idx= Zed_string.extract_prev zip.zip.str zip.idx in (chr, { zip with idx; pos = zip.pos - 1 }) let rec move_f n ofs rope rest_b rest_f = match rope with | Leaf(str, (len,_size)) -> if n <= len then { idx= Zed_string.move str 0 n; pos = n; zip = { str; ofs; leaf = rope; rest_b; rest_f } } else begin match rest_f with | [] -> raise Out_of_bounds | rope' :: rest_f -> move_f (n - len) (ofs + len) rope' (rope :: rest_b) rest_f end | Node(_, _, r1, _, r2) -> move_f n ofs r1 rest_b (r2 :: rest_f) let rec move_b n ofs rope rest_b rest_f = match rope with | Leaf(str, (len,_size)) -> if n <= len then { idx= Zed_string.move str (Zed_string.bytes str) (-n); pos = len - n; zip = { str; ofs; leaf = rope; rest_b; rest_f } } else begin match rest_b with | [] -> raise Out_of_bounds | rope' :: rest_b -> move_b (n - len) (ofs - len) rope' rest_b (rope :: rest_f) end | Node(_, _, r1, _, r2) -> move_b n ofs r2 (r1 :: rest_b) rest_f let move n zip = if n > 0 then let len = length zip.zip.leaf in if zip.pos + n <= len then { zip with idx= Zed_string.move zip.zip.str zip.idx n; pos = zip.pos + n } else match zip.zip.rest_f with | [] -> raise Out_of_bounds | rope :: rest_f -> move_f (n - (len - zip.pos)) (zip.zip.ofs + len) rope (zip.zip.leaf :: zip.zip.rest_b) rest_f else if zip.pos + n >= 0 then { zip with idx= Zed_string.move zip.zip.str zip.idx n; pos = zip.pos + n } else match zip.zip.rest_b with | [] -> raise Out_of_bounds | rope :: rest_b -> move_b (n - zip.pos) zip.zip.ofs rope rest_b (zip.zip.leaf :: zip.zip.rest_f) let at_bos zip= zip.zip.rest_b = [] && zip.idx = 0 let at_eos zip= zip.zip.rest_f = [] && zip.idx = Zed_string.bytes zip.zip.str let rec sub_rec acc ropes len = match ropes with | [] -> if len > 0 then raise Out_of_bounds else acc | rope :: rest -> let len' = length rope in if len <= len' then append acc (sub rope 0 len) else sub_rec (append acc rope) rest (len - len') let sub zip len = if len < 0 then raise Out_of_bounds else let len' = length zip.zip.leaf - zip.pos in if len <= len' then let str= Zed_string.sub ~pos:zip.pos ~len zip.zip.str in let size= Zed_string.size str in Leaf(str, (len,size)) else let str= Zed_string.sub ~pos:zip.pos ~len:(Zed_string.length zip.zip.str - zip.pos) zip.zip.str in let size= Zed_string.size str in sub_rec (Leaf(str, (len',size))) zip.zip.rest_f (len - len') let slice zip1 zip2 = let ofs1 = offset zip1 and ofs2 = offset zip2 in if ofs1 <= ofs2 then sub zip1 (ofs2 - ofs1) else sub zip2 (ofs1 - ofs2) let rec find_f f zip = if at_eos zip then zip else let ch, zip' = next zip in if f ch then zip else find_f f zip' let rec find_b f zip = if at_bos zip then zip else let ch, zip' = prev zip in if f ch then zip else find_b f zip' end module Zip_raw = struct type rope_zipper = { str : Zed_string.t; (* The string of the current leaf. *) ofs : int; (* The offset of the current leaf in the whole rope. *) leaf : t; (* The current leaf. *) rest_b : t list; rest_f : t list; } type t = { idx : int; (* The index in byte of the zipper in the current leaf. *) pos : int; (* The index in character of the zipper in the current leaf. *) zip : rope_zipper; } let rec make_f_rec ofs rope pos rest_b rest_f = match rope with | Leaf(str, _) -> { idx= Zed_string.move_raw str 0 pos; pos = pos; zip = { str; ofs = ofs - pos; leaf = rope; rest_b; rest_f } } | Node(_, _, r1, _, r2) -> let size1= size r1 in if pos < size1 then make_f_rec ofs r1 pos rest_b (r2 :: rest_f) else make_f_rec ofs r2 (pos - size1) (r1 :: rest_b) rest_f let make_f rope pos = if pos < 0 || pos > size rope then raise Out_of_bounds; make_f_rec pos rope pos [] [] let rec make_b_rec ofs rope pos rest_b rest_f = match rope with | Leaf(str, (len,_)) -> { idx= Zed_string.move_raw str (Zed_string.bytes str) (- (len - pos)); pos = pos; zip = { str; ofs = ofs - pos; leaf = rope; rest_b; rest_f } } | Node(_, _, r1, _, r2) -> let len1 = length r1 in if pos < len1 then make_b_rec ofs r1 pos rest_b (r2 :: rest_f) else make_b_rec ofs r2 (pos - len1) (r1 :: rest_b) rest_f let make_b rope pos = let size = size rope in if pos < 0 || pos > size then raise Out_of_bounds; let pos = size - pos in make_b_rec pos rope pos [] [] let offset zip = zip.zip.ofs + zip.pos let rec next_leaf ofs rope rest_b rest_f = match rope with | Leaf(str, _) -> let chr, idx= Zed_utf8.unsafe_extract_next (Zed_string.to_utf8 str) 0 in (chr, { idx; pos = 1; zip = { str; ofs; leaf = rope; rest_b; rest_f } }) | Node(_, _, r1, _, r2) -> next_leaf ofs r1 rest_b (r2 :: rest_f) let next zip = if zip.pos = Zed_string.size zip.zip.str then match zip.zip.rest_f with | [] -> raise Out_of_bounds | rope :: rest -> next_leaf (zip.zip.ofs + size zip.zip.leaf) rope (zip.zip.leaf :: zip.zip.rest_b) rest else let chr, idx= Zed_utf8.unsafe_extract_next (Zed_string.to_utf8 zip.zip.str) zip.idx in (chr, { zip with idx; pos = zip.pos + 1 }) let rec prev_leaf ofs rope rest_b rest_f = match rope with | Leaf(str, (_len, size)) -> let chr, idx = let str= Zed_string.to_utf8 str in Zed_utf8.unsafe_extract_prev str (String.length str) in (chr, { idx; pos = size - 1; zip = { str; ofs = ofs - size; leaf = rope; rest_b; rest_f } }) | Node(_, _, r1, _, r2) -> prev_leaf ofs r2 (r1 :: rest_b) rest_f let prev zip = if zip.pos = 0 then match zip.zip.rest_b with | [] -> raise Out_of_bounds | rope :: rest -> prev_leaf zip.zip.ofs rope rest (zip.zip.leaf :: zip.zip.rest_f) else let chr, idx= Zed_utf8.unsafe_extract_prev (Zed_string.to_utf8 zip.zip.str) zip.idx in (chr, { zip with idx; pos = zip.pos - 1 }) let rec move_f n ofs rope rest_b rest_f = match rope with | Leaf(str, (_,size)) -> if n <= size then { idx= Zed_string.move_raw str 0 n; pos = n; zip = { str; ofs; leaf = rope; rest_b; rest_f } } else begin match rest_f with | [] -> raise Out_of_bounds | rope' :: rest_f -> move_f (n - size) (ofs + size) rope' (rope :: rest_b) rest_f end | Node(_, _, r1, _, r2) -> move_f n ofs r1 rest_b (r2 :: rest_f) let rec move_b n ofs rope rest_b rest_f = match rope with | Leaf(str, (_,size)) -> if n <= size then { idx= Zed_string.move_raw str (Zed_string.bytes str) (-n); pos = size - n; zip = { str; ofs; leaf = rope; rest_b; rest_f } } else begin match rest_b with | [] -> raise Out_of_bounds | rope' :: rest_b -> move_b (n - size) (ofs - size) rope' rest_b (rope :: rest_f) end | Node(_, _, r1, _, r2) -> move_b n ofs r2 (r1 :: rest_b) rest_f let move n zip = if n > 0 then let size = size zip.zip.leaf in if zip.pos + n <= size then { zip with idx= Zed_string.move_raw zip.zip.str zip.idx n; pos = zip.pos + n } else match zip.zip.rest_f with | [] -> raise Out_of_bounds | rope :: rest_f -> move_f (n - (size - zip.pos)) (zip.zip.ofs + size) rope (zip.zip.leaf :: zip.zip.rest_b) rest_f else if zip.pos + n >= 0 then { zip with idx = Zed_string.move_raw zip.zip.str zip.idx (-n); pos = zip.pos + n } else match zip.zip.rest_b with | [] -> raise Out_of_bounds | rope :: rest_b -> move_b (n - zip.pos) zip.zip.ofs rope rest_b (zip.zip.leaf :: zip.zip.rest_f) let at_bos zip= zip.zip.rest_b = [] && zip.idx = 0 let at_eos zip= zip.zip.rest_f = [] && zip.idx = Zed_string.bytes zip.zip.str let rec find_f f zip = if at_eos zip then zip else let ch, zip' = next zip in if f ch then zip else find_f f zip' let rec find_b f zip = if at_bos zip then zip else let ch, zip' = prev zip in if f ch then zip else find_b f zip' end (* +-----------------------------------------------------------------+ | Buffers | +-----------------------------------------------------------------+ *) module String_buffer = Buffer module Buffer = struct type t = { mutable acc : rope; mutable buf : Zed_string.Buf.buf; mutable idx : int; } let create () = { acc = empty (); buf = Zed_string.Buf.create 1024; idx = 0; } let add buffer x = if buffer.idx = max_leaf_size then begin let str= Zed_string.Buf.contents buffer.buf in let size= Zed_string.size str in buffer.acc <- append buffer.acc (Leaf(str, (max_leaf_size,size))); Zed_string.Buf.reset buffer.buf; Zed_string.Buf.add_zChar buffer.buf x; buffer.idx <- Zed_string.Buf.length buffer.buf end else begin Zed_string.Buf.add_zChar buffer.buf x; buffer.idx <- Zed_string.Buf.length buffer.buf end let add_uChar buffer x = if buffer.idx = max_leaf_size then begin let str= Zed_string.Buf.contents buffer.buf in let size= Zed_string.size str in buffer.acc <- append buffer.acc (Leaf(str, (max_leaf_size,size))); Zed_string.Buf.reset buffer.buf; Zed_string.Buf.add_uChar buffer.buf x; buffer.idx <- Zed_string.Buf.length buffer.buf end else begin Zed_string.Buf.add_uChar buffer.buf x; buffer.idx <- Zed_string.Buf.length buffer.buf end let add_rope buf rope= iter (add buf) rope let add_string buf str= Zed_string.iter (add buf) str let contents buffer = if buffer.idx = 0 then buffer.acc else let str= Zed_string.Buf.contents buffer.buf in let size= Zed_string.size str in append buffer.acc (Leaf (str, (buffer.idx, size))) let reset buffer = Zed_string.Buf.reset buffer.buf; buffer.acc <- empty (); buffer.idx <- 0 end (* +-----------------------------------------------------------------+ | Init | +-----------------------------------------------------------------+ *) let init n f = let buf = Buffer.create () in for i = 0 to n - 1 do Buffer.add buf (f i) done; Buffer.contents buf let init_from_uChars len f= match len with | 0-> empty () | len when len > 0 -> let rec create n= if n > 0 then f (len - n) :: create (n-1) else [] in let uChars= create len in let zChars, _= Zed_char.zChars_of_uChars uChars in let buf = Buffer.create () in List.iter (Buffer.add buf) zChars; Buffer.contents buf | _-> raise (Invalid_argument "Zed_rope.init_from_uChars") let of_string s= let buf= Buffer.create () in Buffer.add_string buf s; Buffer.contents buf let rec to_string t= match t with | Leaf (s,_)-> s | Node (_,_,l,_,r)-> Zed_string.append (to_string l) (to_string r) module Text = struct type t = rope let get = get let init = init let length = length type index = Zip.t let look _ zip = fst (Zip.next zip) let nth rope idx = Zip.make_f rope idx let next _ zip = Zip.move 1 zip let prev _ zip = Zip.move (-1) zip let out_of_range _ zip = Zip.at_eos zip let iter = iter let compare = compare let first rope = Zip.make_f rope 0 let last rope = Zip.make_b rope 1 let move _ zip delta = Zip.move delta zip let compare_index _ zip1 zip2 = Zip.offset zip1 - Zip.offset zip2 module Buf = struct type buf = Buffer.t let create _ = Buffer.create () let contents = Buffer.contents let clear = Buffer.reset let reset = Buffer.reset let add_char = Buffer.add_uChar let add_string= Buffer.add_rope let add_buffer buf buf' = add_string buf (Buffer.contents buf') end end module Text_core = struct include Text let get t i= Zed_char.core (get t i) let init = init_from_uChars let look _ zip = Zed_char.core (fst (Zip.next zip)) let iter f= iter (fun c-> f (Zed_char.core c)) end module Text_raw = struct type t = rope type index = Zip_raw.t let get= get_raw let init = init_from_uChars let length = length let look _ zip = fst (Zip_raw.next zip) let iter f= iter (fun c-> f (Zed_char.core c)) let nth rope idx = Zip_raw.make_f rope idx let next _ zip = Zip_raw.move 1 zip let prev _ zip = Zip_raw.move (-1) zip let out_of_range _ zip = Zip_raw.at_eos zip let iter = iter let compare = compare let first rope = Zip_raw.make_f rope 0 let last rope = Zip_raw.make_b rope 1 let move _ zip delta = Zip_raw.move delta zip let compare_index _ zip1 zip2 = Zip_raw.offset zip1 - Zip_raw.offset zip2 module Buf = struct type buf = Buffer.t let create _ = Buffer.create () let contents = Buffer.contents let clear = Buffer.reset let reset = Buffer.reset let add_char = Buffer.add_uChar let add_string= Buffer.add_rope let add_buffer buf buf' = add_string buf (Buffer.contents buf') end end zed-2.0.5/src/zed_rope.mli000066400000000000000000000321101361427230000153740ustar00rootroot00000000000000(* * zed_rope.mli * ------------ * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** Unicode ropes *) open CamomileLibrary type t (** Type of unicode ropes. *) type rope = t (** Alias. *) exception Out_of_bounds (** Exception raised when trying to access a character which is outside the bounds of a rope. *) (** {5 Construction} *) val empty : unit -> rope (** The empty rope. *) val make : int -> Zed_char.t -> rope (** [make length char] creates a rope of length [length] containing only [char]. *) val singleton : Zed_char.t -> rope (** [singleton ch] creates a rope of length 1 containing only [ch]. *) (** {5 Informations} *) val length : rope -> int (** Returns the length of the given rope. *) val size : rope -> int (** Returns the size of the given rope. *) val is_empty : rope -> bool (** [is_empty rope] returns whether [str] is the empty rope or not. *) (** {5 Random access} *) val get : rope -> int -> Zed_char.t (** [get rope idx] returns the glyph at index [idx] in [rope]. *) val get_raw : rope -> int -> UChar.t (** [get_raw rope idx] returns the character at raw index [idx] in [rope]. *) (** {5 Rope manipulation} *) val append : rope -> rope -> rope (** Concatenates the two given ropes. *) val concat : rope -> rope list -> rope (** [concat sep l] concatenates all strings of [l] separating them by [sep]. *) val sub : rope -> int -> int -> rope (** [sub rope ofs len] Returns the sub-rope of [rope] starting at [ofs] and of length [len]. *) val break : rope -> int -> rope * rope (** [break rope pos] returns the sub-ropes before and after [pos] in [rope]. It is more efficient than creating two sub-ropes with {!sub}. *) val before : rope -> int -> rope (** [before rope pos] returns the sub-rope before [pos] in [rope]. *) val after : rope -> int -> rope (** [after rope pos] returns the sub-string after [pos] in [rope]. *) val insert : rope -> int -> rope -> rope (** [insert rope pos sub] inserts [sub] in [rope] at position [pos]. *) val insert_uChar : rope -> int -> UChar.t -> rope (** [insert rope pos char] inserts [char] in [rope] at position [pos]. If [char] is a combing mark, it's merged to the character at position [pos-1] *) val remove : rope -> int -> int -> rope (** [remove rope pos len] removes the [len] characters at position [pos] in [rope] *) val replace : rope -> int -> int -> rope -> rope (** [replace rope pos len repl] replaces the [len] characters at position [pos] in [rope] by [repl]. *) val lchop : rope -> rope (** [lchop rope] returns [rope] without is first character. Returns {!empty} if [rope] is empty. *) val rchop : rope -> rope (** [rchop rope] returns [rope] without is last character. Returns {!empty} if [rope] is empty. *) (** {5 Iteration, folding and mapping} *) val iter : (Zed_char.t -> unit) -> rope -> unit (** [iter f rope] applies [f] on all characters of [rope] starting from the left. *) val rev_iter : (Zed_char.t -> unit) -> rope -> unit (** [rev_iter f rope] applies [f] an all characters of [rope] starting from the right. *) val fold : (Zed_char.t -> 'a -> 'a) -> rope -> 'a -> 'a (** [fold f rope acc] applies [f] on all characters of [rope] starting from the left, accumulating a value. *) val rev_fold : (Zed_char.t -> 'a -> 'a) -> rope -> 'a -> 'a (** [rev_fold f rope acc] applies [f] on all characters of [rope] starting from the right, accumulating a value. *) val map : (Zed_char.t -> Zed_char.t) -> rope -> rope (** [map f rope] maps all characters of [rope] with [f]. *) val rev_map : (Zed_char.t -> Zed_char.t) -> rope -> rope (** [rev_map f str] maps all characters of [rope] with [f] in reverse order. *) (** {5 Iteration and folding on leafs} *) (** Note: for all of the following functions, the leaves must absolutely not be modified. *) val iter_leaf : (Zed_string.t -> unit) -> rope -> unit (** [iter_leaf f rope] applies [f] on all leaves of [rope] starting from the left. *) val rev_iter_leaf : (Zed_string.t -> unit) -> rope -> unit (** [iter_leaf f rope] applies [f] on all leaves of [rope] starting from the right. *) val fold_leaf : (Zed_string.t -> 'a -> 'a) -> rope -> 'a -> 'a (** [fold f rope acc] applies [f] on all leaves of [rope] starting from the left, accumulating a value. *) val rev_fold_leaf : (Zed_string.t -> 'a -> 'a) -> rope -> 'a -> 'a (** [rev_fold f rope acc] applies [f] on all leaves of [rope] starting from the right, accumulating a value. *) val compare : rope -> rope -> int (** Compares two ropes (in code point order). *) val equal : rope -> rope -> bool (** [equal r1 r2] retuns [true] if [r1] is equal to [r2]. *) (** {5 Zippers} *) module Zip : sig type t (** Type of zippers. A zipper allow to naviguate in a rope in a convenient and efficient manner. Note that a zipper points to a position between two glyphs, not to a glyph, so in a rope of length [len] there is [len + 1] positions. *) val make_f : rope -> int -> t (** [make_f rope pos] creates a new zipper pointing to positon [pos] of [rope]. *) val make_b : rope -> int -> t (** [make_f rope pos] creates a new zipper pointing to positon [length rope - pos] of [rope]. *) val offset : t -> int (** Returns the position of the zipper in the rope. *) val next : t -> Zed_char.t * t (** [next zipper] returns the glyph at the right of the zipper and a zipper to the next position. It raises [Out_of_bounds] if the zipper points to the end of the rope. *) val prev : t -> Zed_char.t * t (** [prev zipper] returns the glyph at the left of the zipper and a zipper to the previous position. It raises [Out_of_bounds] if the zipper points to the beginning of the rope. *) val move : int -> t -> t (** [move n zip] moves the zipper by [n] glyphs. If [n] is negative it is moved to the left and if it is positive it is moved to the right. It raises [Out_of_bounds] if the result is outside the bounds of the rope. *) val at_bos : t -> bool (** [at_bos zipper] returns [true] if [zipper] points to the beginning of the rope. *) val at_eos : t -> bool (** [at_eos zipper] returns [true] if [zipper] points to the end of the rope. *) val find_f : (Zed_char.t -> bool) -> t -> t (** [find_f f zip] search forward for a glyph to satisfy [f]. It returns a zipper pointing to the left of the first glyph to satisfy [f], or a zipper pointing to the end of the rope if no such glyph exists. *) val find_b : (Zed_char.t -> bool) -> t -> t (** [find_b f zip] search backward for a glyph to satisfy [f]. It returns a zipper pointing to the right of the first glyph to satisfy [f], or a zipper pointing to the beginning of the rope if no such glyph exists. *) val sub : t -> int -> rope (** [sub zipper len] returns the sub-rope of length [len] pointed by [zipper]. *) val slice : t -> t -> rope (** [slice zipper1 zipper2] returns the rope between [zipper1] and [zipper2]. If [zipper1 > zipper2] then this is the same as [slice zipper2 zipper1]. The result is unspecified if the two zippers do not points to the same rope. *) end module Zip_raw : sig type t (** Type of zippers. A zipper allow to naviguate in a rope in a convenient and efficient manner. Note that a zipper points to a position between two characters, not to a character, so in a rope of length [len] there is [len + 1] positions. *) val make_f : rope -> int -> t (** [make_f rope pos] creates a new zipper pointing to raw positon [pos] of [rope]. *) val make_b : rope -> int -> t (** [make_f rope pos] creates a new zipper pointing to raw positon [length rope - pos] of [rope]. *) val offset : t -> int (** Returns the raw position of the zipper in the rope. *) val next : t -> UChar.t * t (** [next zipper] returns the code point at the right of the zipper and a zipper to the next raw position. It raises [Out_of_bounds] if the zipper points to the end of the rope. *) val prev : t -> UChar.t * t (** [prev zipper] returns the code point at the left of the zipper and a zipper to the previous raw position. It raises [Out_of_bounds] if the zipper points to the beginning of the rope. *) val move : int -> t -> t (** [move n zip] moves the zipper by [n] characters. If [n] is negative it is moved to the left and if it is positive it is moved to the right. It raises [Out_of_bounds] if the result is outside the bounds of the rope. *) val at_bos : t -> bool (** [at_bos zipper] returns [true] if [zipper] points to the beginning of the rope. *) val at_eos : t -> bool (** [at_eos zipper] returns [true] if [zipper] points to the end of the rope. *) val find_f : (UChar.t -> bool) -> t -> t (** [find_f f zip] search forward for a character to satisfy [f]. It returns a zipper pointing to the left of the first character to satisfy [f], or a zipper pointing to the end of the rope if no such character exists. *) val find_b : (UChar.t -> bool) -> t -> t (** [find_b f zip] search backward for a character to satisfy [f]. It returns a zipper pointing to the right of the first character to satisfy [f], or a zipper pointing to the beginning of the rope if no such character exists. *) end (** {5 Buffers} *) module String_buffer = Buffer module Buffer : sig type t (** Type of rope buffers. *) val create : unit -> t (** Create a new empty buffer. *) val add : t -> Zed_char.t -> unit (** [add buffer zChar] add [zChar] at the end of [buffer]. *) val add_uChar : t -> UChar.t -> unit (** [add buffer uChar] add [uChar] at the end of [buffer]. *) val add_rope : t -> rope -> unit (** [add buffer rope] add [rope] at the end of [buffer]. *) val add_string : t -> Zed_string.t -> unit (** [add buffer str] add [str] at the end of [buffer]. *) val contents : t -> rope (** [contents buffer] returns the contents of [buffer] as a rope. *) val reset : t -> unit (** [reset buffer] resets [buffer] to its initial state. *) end val init : int -> (int -> Zed_char.t) -> rope val init_from_uChars : int -> (int -> UChar.t) -> rope val of_string : Zed_string.t -> rope val to_string : rope -> Zed_string.t (** {5 Camomile compatible interface} *) module Text : sig type t = rope val get : t -> int -> Zed_char.t val init : int -> (int -> Zed_char.t) -> t val length : t -> int type index = Zip.t val look : 'a -> index -> Zed_char.t val nth : t -> int -> index val next : 'a -> index -> index val prev : 'a -> index -> index val out_of_range : 'a -> index -> bool val iter : (Zed_char.t -> unit) -> t -> unit val compare : t -> t -> int val first : t -> index val last : t -> index val move : 'a -> index -> int -> index val compare_index : 'a -> index -> index -> int module Buf : sig type buf = Buffer.t val create : 'a -> buf val contents : buf -> t val clear : buf -> unit val reset : buf -> unit val add_char : buf -> UChar.t -> unit val add_string : buf -> t -> unit val add_buffer : buf -> buf -> unit end end module Text_core : sig type t = rope val length : t -> int type index = Zip.t val nth : t -> int -> index val next : 'a -> index -> index val prev : 'a -> index -> index val out_of_range : 'a -> index -> bool val compare : t -> t -> int val first : t -> index val last : t -> index val move : 'a -> index -> int -> index val compare_index : 'a -> index -> index -> int module Buf = Text.Buf val get : t -> int -> UChar.t val init : int -> (int -> UChar.t) -> t val look : 'a -> index -> UChar.t val iter : (UChar.t -> unit) -> t -> unit end module Text_raw : sig type t = rope type index = Zip_raw.t val get : t -> int -> UChar.t val init : int -> (int -> UChar.t) -> t val length : t -> int val look : 'a -> index -> UChar.t val nth : t -> int -> index val next : 'a -> index -> index val prev : 'a -> index -> index val out_of_range : 'a -> index -> bool val iter : (UChar.t -> unit) -> t -> unit val compare : t -> t -> int val first : t -> index val last : t -> index val move : 'a -> index -> int -> index val compare_index : 'a -> index -> index -> int module Buf : sig type buf = Buffer.t val create : 'a -> buf val contents : buf -> t val clear : buf -> unit val reset : buf -> unit val add_char : buf -> UChar.t -> unit val add_string : buf -> t -> unit val add_buffer : buf -> buf -> unit end end zed-2.0.5/src/zed_string.ml000066400000000000000000000347331361427230000156010ustar00rootroot00000000000000(* * zed_string.ml * ----------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile open Result exception Invalid of string * string exception Out_of_bounds (** Exception raised when trying to access a character which is outside the bounds of a string. *) let pervasives_compare= compare let fail str pos msg = raise (Invalid(Printf.sprintf "at position %d: %s" pos msg, str)) module Zed_string0 = struct type seg_width= { start: int; len: int; width: int; } type all_width= { len: int; width: int; } type width= (all_width, seg_width) result type t= Zed_utf8.t let aval_width= function | Ok {len=_;width}-> width | Error {start=_;len=_;width}-> width let bytes str= String.length str let size str= Zed_utf8.length str let copy t= t let unsafe_next str ofs= let str_len= String.length str in let rec skip str ofs= if ofs >= str_len then str_len else let chr, next= Zed_utf8.unsafe_extract_next str ofs in if Zed_char.is_combining_mark chr then skip str next else ofs in if ofs < 0 || ofs >= String.length str then raise Out_of_bounds else let chr, next= Zed_utf8.unsafe_extract_next str ofs in if Zed_char.is_printable chr then skip str next else next let next_ofs str ofs= let str_len= String.length str in let rec skip str ofs= if ofs >= str_len then str_len else let chr, next= Zed_utf8.unsafe_extract_next str ofs in if Zed_char.is_combining_mark chr then skip str next else ofs in if ofs < 0 || ofs >= String.length str then raise Out_of_bounds else let chr, next= Zed_utf8.unsafe_extract_next str ofs in if Zed_char.is_printable_core chr then skip str next else if Zed_char.is_combining_mark chr then fail str ofs "individual combining marks encountered" else next let length str= let eos= String.length str in let rec length len ofs= if ofs < eos then length (len + 1) (unsafe_next str ofs) else len in length 0 0 let unsafe_prev str ofs= let rec skip str ofs= if ofs = 0 then ofs else let chr, prev= Zed_utf8.unsafe_extract_prev str ofs in if Zed_char.is_combining_mark chr then skip str prev else prev in if ofs <= 0 || ofs > String.length str then raise Out_of_bounds else let chr, prev= Zed_utf8.extract_prev str ofs in if Zed_char.is_combining_mark chr then skip str prev else prev let prev_ofs str ofs= let rec skip str ofs= if ofs = 0 then ofs else let chr, prev= Zed_utf8.unsafe_extract_prev str ofs in if Zed_char.is_combining_mark chr then skip str prev else prev in if ofs <= 0 || ofs > String.length str then raise Out_of_bounds else let chr, prev= Zed_utf8.extract_prev str ofs in if Zed_char.is_combining_mark chr then let prev= skip str prev in if prev = 0 then if Zed_char.is_printable_core (Zed_utf8.unsafe_extract str 0) then prev else fail str 0 "individual combining marks encountered" else let chr, next= Zed_utf8.unsafe_extract_next str prev in match Zed_char.prop_uChar chr with | Printable 0 | Other | Null -> fail str next "individual combining marks encountered" | _-> prev else prev let rec move_l str ofs len= if len = 0 then ofs else if ofs >= String.length str then raise Out_of_bounds else move_l str (unsafe_next str ofs) (len - 1) let move_b str ofs len= let rec move str ofs len= if len = 0 then ofs else if ofs < 0 then raise Out_of_bounds else move str (unsafe_prev str ofs) (len - 1) in if ofs < 0 || ofs > String.length str then raise Out_of_bounds else move str ofs len let rec move_l_raw str ofs len= if len = 0 then ofs else if ofs >= String.length str then raise Out_of_bounds else move_l_raw str (Zed_utf8.unsafe_next str ofs) (len - 1) let move_b_raw str ofs len= let rec move str ofs len= if len = 0 then ofs else if ofs < 0 then raise Out_of_bounds else move str (Zed_utf8.unsafe_prev str ofs) (len - 1) in if ofs < 0 || ofs > String.length str then raise Out_of_bounds else move str ofs len let extract str ofs= let next= next_ofs str ofs in Zed_char.unsafe_of_utf8 (String.sub str ofs (next - ofs)) let extract_next str ofs= let next= next_ofs str ofs in (Zed_char.unsafe_of_utf8 (String.sub str ofs (next - ofs)), next) let extract_prev str ofs= let prev= prev_ofs str ofs in (Zed_char.unsafe_of_utf8 (String.sub str prev (ofs - prev)), prev) let to_raw_list str= Zed_utf8.explode str let to_raw_array str= Array.of_list (to_raw_list str) type index= int let get str idx = if idx < 0 then raise Out_of_bounds else extract str (move_l str 0 idx) let get_raw= Zed_utf8.get let empty ()= "" let width_ofs ?(start=0) ?num str= let str_len= String.length str in let rec calc w idx ofs= if ofs < str_len then let chr, next= extract_next str ofs in let chr_width= Zed_char.width chr in if chr_width > 0 then calc (w + chr_width) (idx+1) next else Error { start; len= idx - start; width= w } else Ok {len= idx - start; width= w } in let calc_num num w idx ofs= let rec calc n w idx ofs= if ofs < str_len && n > 0 then let chr, next= extract_next str ofs in let chr_width= Zed_char.width chr in if chr_width > 0 then calc (n-1) (w + chr_width) (idx+1) next else Error { start; len= idx - start; width= w } else Ok {len= idx - start; width= w } in calc num w idx ofs in match num with | Some num-> calc_num num 0 start start | None-> calc 0 start start let width ?(start=0) ?num str= let ofs= move_l str 0 start in width_ofs ~start:ofs ?num str let explode str= let str_len= String.length str in let rec aux acc str ofs= if ofs > 0 then let chr, prev= extract_prev str ofs in aux (chr::acc) str prev else acc in if str_len > 0 then aux [] str str_len else [] let rev_explode str= let str_len= String.length str in let rec aux acc ofs= if ofs < str_len then let chr, next= extract_next str ofs in aux (chr::acc) next else [] in if str_len > 0 then aux [] 0 else [] let unsafe_explode str= let str_len= String.length str in let rec aux acc str ofs= if ofs > 0 then let chr, prev= extract_prev str ofs in aux (chr::acc) str prev else acc in if str_len > 0 then aux [] str str_len else [] let unsafe_rev_explode str= let str_len= String.length str in let rec aux acc ofs= if ofs < str_len then let chr, next= extract_next str ofs in aux (chr::acc) next else [] in if str_len > 0 then aux [] 0 else [] let implode chars= String.concat "" (List.map Zed_char.to_utf8 chars) let init len (f: int -> Zed_char.t)= let rec create acc n= if n > 0 then create ((f (n-1))::acc) (n-1) else acc in implode (create [] len) let init_from_uChars len f= match len with | 0-> empty () | len when len > 0 -> let rec create acc n= if n > 0 then create ((f (n-1))::acc) (n-1) else acc in let uChars= create [] len in let zChars, _= Zed_char.zChars_of_uChars uChars in implode zChars | _-> raise (Invalid_argument "Zed_string0.init_from_uChars") let unsafe_of_uChars uChars= match uChars with | []-> "" | _-> String.concat "" (List.map Zed_utf8.singleton uChars) let of_uChars uChars= match uChars with | []-> "", [] | fst::_-> if Zed_char.is_combining_mark fst then ("", uChars) else (uChars |> List.map Zed_utf8.singleton |> String.concat "", []) let unsafe_append s1 s2= s1 ^ s2 let append s1 s2= let validate_s2 ()= let s2_first= Zed_utf8.unsafe_extract s2 0 in if Zed_char.is_combining_mark s2_first then fail s2 0 "individual combining marks encountered" else s2 in if s1 = "" then validate_s2 () else if s2 = "" then s1 else let (s1_last, _)= extract_prev s1 (bytes s1) in if Zed_char.(is_printable_core (core s1_last)) then unsafe_append s1 s2 else unsafe_append s1 (validate_s2 ()) external id : 'a -> 'a = "%identity" let unsafe_of_utf8 : string -> t= id let of_utf8 : string -> t= fun str-> if String.length str = 0 then "" else if Zed_char.is_combining_mark (Zed_utf8.extract str 0) then fail str 0 "individual combining marks encountered" else unsafe_of_utf8 str let to_utf8 : t -> string= id let for_all p str= List.for_all p (explode str) let check_range t n= n >= 0 && n <= length t let look str ofs= Zed_utf8.extract str ofs let nth t n= if check_range t n then n else raise (Invalid_argument "Zed_string.nth") let next t n= let n= n + 1 in if check_range t n then n else raise (Invalid_argument "Zed_string.next") let prev t n= let n= n - 1 in if check_range t n then n else raise (Invalid_argument "Zed_string.prev") let out_of_range t n= n < 0 || n >= length t let iter f str= List.iter f (explode str) let rev_iter f str= List.iter f (rev_explode str) let fold f str acc= let rec aux f chars acc= match chars with | []-> acc | chr::tl-> aux f tl (f chr acc) in aux f (explode str) acc let rev_fold f str acc= let rec aux f chars acc= match chars with | []-> acc | chr::tl-> aux f tl (f chr acc) in aux f (rev_explode str) acc let map f str= implode (List.map f (explode str)) let rev_map f str= implode (List.map f (rev_explode str)) let compare str1 str2= Zed_utils.list_compare ~compare:Zed_char.compare_raw (explode str1) (explode str2) let first (_:t)= 0 let last t= max (length t - 1) 0 let move t i n= if n >= 0 then move_l t i n else move_b t i n let move_raw t i n= if n >= 0 then move_l_raw t i n else move_b_raw t i n let compare_index (_:t) i j= pervasives_compare i j let sub_ofs ~ofs ~len s= if ofs < 0 || len < 0 || ofs > bytes s - len then invalid_arg "Zed_string.sub" else String.sub s ofs len let sub ~pos ~len s= if pos < 0 || len < 0 || pos > length s - len then invalid_arg "Zed_string.sub" else let ofs_start= move_l s 0 pos in let ofs_end= move_l s ofs_start len in String.sub s ofs_start (ofs_end - ofs_start) let after s i= let len= length s in if i < len then sub ~pos:i ~len:(len-i) s else empty () let rec unsafe_sub_equal str ofs sub ofs_sub= if ofs_sub = String.length sub then true else (String.unsafe_get str ofs = String.unsafe_get sub ofs_sub) && unsafe_sub_equal str (ofs + 1) sub (ofs_sub + 1) let starts_with ~prefix str= if String.length prefix > String.length str then false else unsafe_sub_equal str 0 prefix 0 let make len c= implode (Array.to_list (Array.make len c)) let ends_with ~suffix str= Zed_utf8.ends_with str suffix module Buf0 = struct type buf= Buffer.t let create n= Buffer.create n let contents b= Buffer.contents b let clear b= Buffer.clear b let reset b= Buffer.reset b let length b= length (contents b) let add_zChar b zChar= Buffer.add_string b (Zed_char.to_utf8 zChar) let add_uChar b uChar= Buffer.add_string b (Zed_utf8.singleton uChar) let add_string b s= Buffer.add_string b s let add_buffer b1 b2= Buffer.add_buffer b1 b2 end module US0(US:UnicodeString.Type) = struct module Convert = Zed_utils.Convert(US) let of_t t= Zed_utf8.explode t|> Convert.of_list let to_t us= let first= US.first us and last= US.last us in let length= US.length us in let rec create acc i= if US.compare_index us i first >= 0 then create (US.look us i :: acc) (US.prev us i) else acc in let uChars= if length > 0 then create [] last else [] in of_uChars uChars let to_t_exn us= let t,_= to_t us in t end end module US_Core = struct include Zed_string0 let get str i= Zed_char.core (get str i) let init= init_from_uChars let iter f str= iter (fun zChar-> f (Zed_char.core zChar)) str let compare str1 str2= Zed_utils.list_compare ~compare:Zed_char.compare_core (explode str1) (explode str2) let to_list str= explode str |> List.map Zed_char.core let to_array str= to_list str |> Array.of_list module US(US:UnicodeString.Type) = struct module Convert = Zed_utils.Convert(US) let of_t t= (explode t) |> List.map Zed_char.core |> Convert.of_list end module Buf = struct include Buf0 let add_char= add_uChar end end module US_Raw = struct type t= Zed_string0.t let get= Zed_string0.get_raw let init= Zed_string0.init_from_uChars let length= Zed_utf8.length type index= int let check_range t n= n >= 0 && n < Zed_string0.size t let out_of_range str ofs= ofs < 0 || ofs >= String.length str let look str ofs= Zed_utf8.extract str ofs let nth str idx= Zed_string0.move_l str 0 idx let next= Zed_utf8.next let prev= Zed_utf8.prev let first _= 0 let last str= Zed_utf8.prev str (String.length str) let move= Zed_string0.move_raw let compare_index _str= compare let iter f str= List.iter f (Zed_utf8.explode str) let compare str1 str2= Zed_utils.list_compare ~compare:UChar.compare (Zed_utf8.explode str1) (Zed_utf8.explode str2) module US = Zed_string0.US0 module Buf = struct include Zed_string0.Buf0 let add_char= add_uChar end end include Zed_string0 module US = US0 module Buf = Buf0 zed-2.0.5/src/zed_string.mli000066400000000000000000000277161361427230000157550ustar00rootroot00000000000000(* * zed_string.mli * ----------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibrary open Result exception Invalid of string * string (** [Invalid (error, text)] Exception raised when an invalid Zed_char sequence is encountered. [text] is the faulty text and [error] is a description of the first error in [text]. *) exception Out_of_bounds (** Exception raised when trying to access a character which is outside the bounds of a string. *) type seg_width = { start : int; len : int; width : int; } (** Type of the width of a segment of a Zed_string.t *) type all_width = { len : int; width : int; } (** Type of the width of a whole Zed_string.t *) type width = (all_width, seg_width) result (** Type of the width of a Zed_string.t *) type t (** Type of Zed_string.t *) val unsafe_of_utf8 : string -> t (** Create a Zed_string.t from a utf8 encoded string. *) val of_utf8 : string -> t (** Create a Zed_string.t from a utf8 encoded string and check whether it's well formed. @raise Invalid @raise Zed_utf8.Invalid *) val to_utf8 : t -> string (** Create a utf8 encoded string from a Zed_string.t. *) val explode : t -> Zed_char.t list (** [explode str] returns the list of all Zed_char.t of [str]. *) val rev_explode : t -> Zed_char.t list (** [explode str] returns the list of all Zed_char.t of [str] in reverse order. *) val unsafe_explode : t -> Zed_char.t list (** [explode str] returns the list of all Zed_char.t of [str] even if [str] is malformed. *) val unsafe_rev_explode : t -> Zed_char.t list (** [explode str] returns the list of all Zed_char.t of [str] in reverse order even if [str] is malformed. *) val implode : Zed_char.t list -> t (** [implode l] returns the concatenation of all Zed_char.t of [l]. *) val aval_width : width -> int (** Returns the widest available width *) val init : int -> (int -> Zed_char.t) -> t (** [init n f] returns the contenation of [implode [(f 0)]], [implode [(f 1)]], ..., [implode [(f (n - 1))]]. *) val init_from_uChars : int -> (int -> UChar.t) -> t (** [init n f] creates a sequence of UChar.t of [f 0], [f 1], ..., [f (n-1)] and implode the contenation of it. *) val make : int -> Zed_char.t -> t (** [make n ch] creates a Zed_string.t of length [n] filled with [ch]. *) val copy : t -> t (** [copy s] returns a copy of [s], that is, a fresh Zed_string.t containing the same elements as [s]. *) val to_raw_list : t -> UChar.t list (** Same as explode, but the elements in the list is [UChar.t]. *) val to_raw_array : t -> UChar.t array (** Same as explode, but the elements in the array is [UChar.t]. *) type index = int val get : t -> int -> Zed_char.t (** [get str idx] returns the Zed_char.t at index [idx] in [str]. *) val get_raw : t -> int -> UChar.t (** [get_raw str idx] returns the UChar.t at UChar.t based index [idx] in [str]. *) val empty : unit -> t (** [empty ()] creates an empty Zed_string.t. *) val width_ofs : ?start:index -> ?num:int -> t -> width (** [width_ofs ?start ?num str] returns the [width] of a Zed_string.t that starts at offset [start] and has length less than [num]. *) val width : ?start:int -> ?num:int -> t -> width (** [width ?start ?num str] returns the [width] of a Zed_string.t that starts at positon [start] and has length less than [num]. *) val bytes : t -> index (** [bytes str] returns the number of bytes in [str]. It's also the index point to the end of [str]. *) val size : t -> int (** [size str] returns the number of UChar.t in [str]. *) val length : t -> int (** [length str] returns the number of Zed_char.t in [str] *) val next_ofs : t -> int -> int (** [next_ofs str ofs] returns the offset of the next zed_char in [str]. *) val prev_ofs : t -> int -> int (** [prev_ofs str ofs] returns the offset of the previous zed_char in [str]. *) val extract : t -> index -> Zed_char.t (** [extract str ofs] returns the Zed_char.t at offset [ofs] in [str]. *) val extract_next : t -> index -> (Zed_char.t * index) (** [extract_next str ofs] returns the Zed_char.t at offset [ofs] in [str] and the offset of the next Zed_char.t *) val extract_prev : t -> index -> (Zed_char.t * index) (** [extract_prev str ofs] returns the Zed_char.t at the previous offset [ofs] in [str] and this offset. *) val unsafe_of_uChars : UChar.t list -> t (** [unsafe_of_uChars l] returns the concatenation of all UChar.t of [l]. *) val of_uChars : UChar.t list -> t * UChar.t list (** [of_uChars l] returns a tuple of which the first element is a well formed Zed_string.t concatenating of all UChar.t of [l] and the second element is a list of the remaining UChar.t. *) val for_all : (Zed_char.t -> bool) -> t -> bool (** [for_all p zStr] checks if all Zed_char.t in [zStr] satisfy the predicate [p]. *) val iter : (Zed_char.t -> unit) -> t -> unit (** [iter f str] applies [f] an all characters of [str] starting from the left. *) val rev_iter : (Zed_char.t -> unit) -> t -> unit (** [iter f str] applies [f] an all characters of [str] starting from the right. *) val fold : (Zed_char.t -> 'a -> 'a) -> t -> 'a -> 'a (** [fold f str acc] applies [f] on all characters of [str] starting from the left, accumulating a value. *) val rev_fold : (Zed_char.t -> 'a -> 'a) -> t -> 'a -> 'a (** [fold f str acc] applies [f] on all characters of [str] starting from the right, accumulating a value. *) val map : (Zed_char.t -> Zed_char.t) -> t -> t (** [map f str] maps all characters of [str] with [f]. *) val rev_map : (Zed_char.t -> Zed_char.t) -> t -> t (** [map f str] maps all characters of [str] with [f] in reverse order. *) val check_range : t -> int -> bool val look : t -> index -> UChar.t (** [look str idx] returns the character in the location [idx] of [str]. *) val nth : t -> int -> index (** [nth str n] returns the location of the [n]-th character in [str]. *) (** [next str i], [prev str i] The operation is valid if [i] points the valid element, i.e. the returned value may point the location beyond valid elements by one. If i does not point a valid element, the results are unspecified. *) val next : t -> index -> index (** [next str idx] returns the index of the next zed_char in [str]. *) val prev : t -> index -> index (** [prev str idx] returns the index of the previous zed_char in [str]. *) val out_of_range : t -> index -> bool val compare : t -> t -> int (** Compares two strings by [Zed_char.compare]. *) val first : t -> index (** [first str] returns the location of the first character in [str]. *) val last : t -> index (** [last str] returns the location of the last character in [str]. *) val move : t -> index -> int -> index (** [move str i n] if n >= 0, then returns [n]-th character after [i] and otherwise returns -[n]-th character before [i.] If there is no such character, or [i] does not point a valid character, the result is unspecified. *) val move_raw : t -> index -> int -> index (** [move_raw str i n] if n >= 0, then returns [n]-th UChar.t after [i] and otherwise returns -[n]-th UChar.t before [i.] If there is no such UChar.t, or [i] does not point a valid UChar.t, the result is unspecified. *) val compare_index : t -> index -> index -> int (** [compare_index str i j] returns a positive integer if [i] is the location placed after [j] in [str], 0 if [i] and [j] point the same location, and a negative integer if [i] is the location placed before [j] in [str]. *) val sub_ofs : ofs:index -> len:int -> t -> t (** [sub_ofs ofs len str] returns the sub-string of [str] starting at byte-offset [ofs] and of byte-length [len]. *) val sub : pos:int -> len:int -> t -> t (** [sub ~pos ~len str] returns the sub-string of [str] starting at position [pos] and of length [len]. *) val after : t -> int -> t (** [after str pos] returns the sub-string after [pos] in [str] *) val unsafe_sub_equal : t -> int -> t -> int -> bool val starts_with : prefix:t -> t -> bool (** [starts_with ~prefix str] returns [true] if [str] starts with [prefix]. *) val ends_with : suffix:t -> t -> bool (** [ends_with ~suffix str] returns [true] if [str] ends with [suffix]. *) val unsafe_append : t -> t -> t (** [unsafe_append str1 str2] returns the concatenation of [str1] and [str2] without sequence validation. *) val append : t -> t -> t (** [append str1 str2] returns the concatenation of [str1] and [str2]. @raise Invalid @raise Zed_utf8.Invalid *) module US : functor (US : UnicodeString.Type) -> sig module Convert : sig val of_list : UChar.t list -> US.t val of_array : UChar.t array -> US.t val to_uChars : US.t -> UChar.t list end val of_t : t -> US.t val to_t : US.t -> t * UChar.t list val to_t_exn : US.t -> t end module Buf : sig type buf (** Type of Zed_string buffers. *) val create : int -> buf (** Create a new empty buffer. *) val contents : buf -> t (** [contents buffer] returns the contents of [buffer] as a Zed_string.t. *) val clear : buf -> unit (** [clear buffer] clear the contents of [buffer]. *) val reset : buf -> unit (** [reset buffer] resets [buffer] to its initial state. *) val length : buf -> int (** [length buffer] returns the length of the contents in [buffer] *) val add_zChar : buf -> Zed_char.t -> unit (** [add buffer zChar] add [zChar] at the end of [buffer]. *) val add_uChar : buf -> UChar.t -> unit (** [add buffer uChar] add [uChar] at the end of [buffer]. *) val add_string : buf -> t -> unit (** [add buffer str] add [str] at the end of [buffer]. *) val add_buffer : buf -> buf -> unit (** [add buffer buf] add [buf] at the end of [buffer]. *) end module US_Core : sig type t type index = int val length : t -> int val size : t -> int val look : t -> index -> UChar.t val nth : t -> int -> index val next : t -> index -> index val prev : t -> index -> index val out_of_range : t -> index -> bool val first : t -> index val last : t -> index val move : t -> index -> int -> index val compare_index : t -> index -> index -> int val get : t -> int -> UChar.t val init : int -> (int -> UChar.t) -> t val iter : (UChar.t -> unit) -> t -> unit val compare : t -> t -> int val to_list : t -> UChar.t list val to_array : t -> UChar.t array module US : functor (US : UnicodeString.Type) -> sig module Convert : sig val of_list : UChar.t list -> US.t val of_array : UChar.t array -> US.t val to_uChars : US.t -> UChar.t list end val of_t : t -> US.t end module Buf : sig type buf = Buf.buf val create : int -> buf val contents : buf -> t val clear : buf -> unit val reset : buf -> unit val add_zChar : buf -> Zed_char.t -> unit val add_uChar : buf -> UChar.t -> unit val add_string : buf -> t -> unit val add_buffer : buf -> buf -> unit val add_char : buf -> UChar.t -> unit end end module US_Raw : sig type t val get : t -> int -> UChar.t val init : int -> (int -> UChar.t) -> t val length : t -> int type index= int val check_range : t -> int -> bool val look : t -> index -> UChar.t val nth : t -> int -> index val next : t -> index -> index val prev : t -> index -> index val out_of_range : t -> index -> bool val first : t -> index val last : t -> index val move : t -> index -> int -> index val compare_index : t -> index -> index -> int val iter : (UChar.t -> unit) -> t -> unit val compare : t -> t -> int module US = US module Buf : sig type buf = Buf.buf val create : int -> buf val contents : buf -> t val clear : buf -> unit val reset : buf -> unit val add_zChar : buf -> Zed_char.t -> unit val add_uChar : buf -> UChar.t -> unit val add_string : buf -> t -> unit val add_buffer : buf -> buf -> unit val add_char : buf -> UChar.t -> unit end end zed-2.0.5/src/zed_utf8.ml000066400000000000000000000743051361427230000151600ustar00rootroot00000000000000(* * zed_utf8.ml * ----------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile type t = string exception Invalid of string * string exception Out_of_bounds let fail str pos msg = raise (Invalid(Printf.sprintf "at position %d: %s" pos msg, str)) let byte str i = Char.code (String.unsafe_get str i) let set_byte str i n = Bytes.unsafe_set str i (Char.unsafe_chr n) (* +-----------------------------------------------------------------+ | Validation | +-----------------------------------------------------------------+ *) type check_result = | Correct of int | Message of string let next_error s i = let len = String.length s in let rec main i ulen = if i = len then (i, ulen, "") else let ch = String.unsafe_get s i in match ch with | '\x00' .. '\x7f' -> main (i + 1) (ulen + 1) | '\xc0' .. '\xdf' -> if i + 1 >= len then (i, ulen, "premature end of UTF8 sequence") else begin let byte1 = Char.code (String.unsafe_get s (i + 1)) in if byte1 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if ((Char.code ch land 0x1f) lsl 6) lor (byte1 land 0x3f) < 0x80 then (i, ulen, "overlong UTF8 sequence") else main (i + 2) (ulen + 1) end | '\xe0' .. '\xef' -> if i + 2 >= len then (i, ulen, "premature end of UTF8 sequence") else begin let byte1 = Char.code (String.unsafe_get s (i + 1)) and byte2 = Char.code (String.unsafe_get s (i + 2)) in if byte1 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if byte2 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if ((Char.code ch land 0x0f) lsl 12) lor ((byte1 land 0x3f) lsl 6) lor (byte2 land 0x3f) < 0x800 then (i, ulen, "overlong UTF8 sequence") else main (i + 3) (ulen + 1) end | '\xf0' .. '\xf7' -> if i + 3 >= len then (i, ulen, "premature end of UTF8 sequence") else begin let byte1 = Char.code (String.unsafe_get s (i + 1)) and byte2 = Char.code (String.unsafe_get s (i + 2)) and byte3 = Char.code (String.unsafe_get s (i + 3)) in if byte1 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if byte2 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if byte3 land 0xc0 != 0x80 then (i, ulen, "malformed UTF8 sequence") else if ((Char.code ch land 0x07) lsl 18) lor ((byte1 land 0x3f) lsl 12) lor ((byte2 land 0x3f) lsl 6) lor (byte3 land 0x3f) < 0x10000 then (i, ulen, "overlong UTF8 sequence") else main (i + 4) (ulen + 1) end | _ -> (i, ulen, "invalid start of UTF8 sequence") in main i 0 let check str = let ofs, len, msg = next_error str 0 in if ofs = String.length str then Correct len else Message (Printf.sprintf "at position %d: %s" ofs msg) let validate str = let ofs, len, msg = next_error str 0 in if ofs = String.length str then len else fail str ofs msg (* +-----------------------------------------------------------------+ | Unsafe UTF-8 manipulation | +-----------------------------------------------------------------+ *) let unsafe_next str ofs = match String.unsafe_get str ofs with | '\x00' .. '\x7f' -> ofs + 1 | '\xc0' .. '\xdf' -> if ofs + 2 > String.length str then fail str ofs "unterminated UTF-8 sequence" else ofs + 2 | '\xe0' .. '\xef' -> if ofs + 3 > String.length str then fail str ofs "unterminated UTF-8 sequence" else ofs + 3 | '\xf0' .. '\xf7' -> if ofs + 4 > String.length str then fail str ofs "unterminated UTF-8 sequence" else ofs + 4 | _ -> fail str ofs "invalid start of UTF-8 sequence" let unsafe_prev str ofs = match String.unsafe_get str (ofs - 1) with | '\x00' .. '\x7f' -> ofs - 1 | '\x80' .. '\xbf' -> if ofs >= 2 then match String.unsafe_get str (ofs - 2) with | '\xc0' .. '\xdf' -> ofs - 2 | '\x80' .. '\xbf' -> if ofs >= 3 then match String.unsafe_get str (ofs - 3) with | '\xe0' .. '\xef' -> ofs - 3 | '\x80' .. '\xbf' -> if ofs >= 4 then match String.unsafe_get str (ofs - 4) with | '\xf0' .. '\xf7' -> ofs - 4 | _ -> fail str (ofs - 4) "invalid start of UTF-8 sequence" else fail str (ofs - 3) "invalid start of UTF-8 string" | _ -> fail str (ofs - 3) "invalid middle of UTF-8 sequence" else fail str (ofs - 2) "invaild start of UTF-8 string" | _ -> fail str (ofs - 2) "invalid middle of UTF-8 sequence" else fail str (ofs - 1) "invalid start of UTF-8 string" | _ -> fail str (ofs - 1) "invalid end of UTF-8 sequence" let unsafe_extract str ofs = let ch = String.unsafe_get str ofs in match ch with | '\x00' .. '\x7f' -> UChar.of_char ch | '\xc0' .. '\xdf' -> if ofs + 2 > String.length str then fail str ofs "unterminated UTF-8 sequence" else UChar.of_int (((Char.code ch land 0x1f) lsl 6) lor (byte str (ofs + 1) land 0x3f)) | '\xe0' .. '\xef' -> if ofs + 3 > String.length str then fail str ofs "unterminated UTF-8 sequence" else UChar.of_int (((Char.code ch land 0x0f) lsl 12) lor ((byte str (ofs + 1) land 0x3f) lsl 6) lor (byte str (ofs + 2) land 0x3f)) | '\xf0' .. '\xf7' -> if ofs + 4 > String.length str then fail str ofs "unterminated UTF-8 sequence" else UChar.of_int (((Char.code ch land 0x07) lsl 18) lor ((byte str (ofs + 1) land 0x3f) lsl 12) lor ((byte str (ofs + 2) land 0x3f) lsl 6) lor (byte str (ofs + 3) land 0x3f)) | _ -> fail str ofs "invalid start of UTF-8 sequence" let unsafe_extract_next str ofs = let ch = String.unsafe_get str ofs in match ch with | '\x00' .. '\x7f' -> (UChar.of_char ch, ofs + 1) | '\xc0' .. '\xdf' -> if ofs + 2 > String.length str then fail str ofs "unterminated UTF-8 sequence" else (UChar.of_int (((Char.code ch land 0x1f) lsl 6) lor (byte str (ofs + 1) land 0x3f)), ofs + 2) | '\xe0' .. '\xef' -> if ofs + 3 > String.length str then fail str ofs "unterminated UTF-8 sequence" else (UChar.of_int (((Char.code ch land 0x0f) lsl 12) lor ((byte str (ofs + 1) land 0x3f) lsl 6) lor (byte str (ofs + 2) land 0x3f)), ofs + 3) | '\xf0' .. '\xf7' -> if ofs + 4 > String.length str then fail str ofs "unterminated UTF-8 sequence" else (UChar.of_int (((Char.code ch land 0x07) lsl 18) lor ((byte str (ofs + 1) land 0x3f) lsl 12) lor ((byte str (ofs + 2) land 0x3f) lsl 6) lor (byte str (ofs + 3) land 0x3f)), ofs + 4) | _ -> fail str ofs "invalid start of UTF-8 sequence" let unsafe_extract_prev str ofs = let ch1 = String.unsafe_get str (ofs - 1) in match ch1 with | '\x00' .. '\x7f' -> (UChar.of_char ch1, ofs - 1) | '\x80' .. '\xbf' -> if ofs >= 2 then let ch2 = String.unsafe_get str (ofs - 2) in match ch2 with | '\xc0' .. '\xdf' -> (UChar.of_int (((Char.code ch2 land 0x1f) lsl 6) lor (Char.code ch1 land 0x3f)), ofs - 2) | '\x80' .. '\xbf' -> if ofs >= 3 then let ch3 = String.unsafe_get str (ofs - 3) in match ch3 with | '\xe0' .. '\xef' -> (UChar.of_int (((Char.code ch3 land 0x0f) lsl 12) lor ((Char.code ch2 land 0x3f) lsl 6) lor (Char.code ch1 land 0x3f)), ofs - 3) | '\x80' .. '\xbf' -> if ofs >= 4 then let ch4 = String.unsafe_get str (ofs - 4) in match ch4 with | '\xf0' .. '\xf7' -> (UChar.of_int (((Char.code ch4 land 0x07) lsl 18) lor ((Char.code ch3 land 0x3f) lsl 12) lor ((Char.code ch2 land 0x3f) lsl 6) lor (Char.code ch1 land 0x3f)), ofs - 4) | _ -> fail str (ofs - 4) "invalid start of UTF-8 sequence" else fail str (ofs - 3) "invalid start of UTF-8 string" | _ -> fail str (ofs - 3) "invalid middle of UTF-8 sequence" else fail str (ofs - 2) "invaild start of UTF-8 string" | _ -> fail str (ofs - 2) "invalid middle of UTF-8 sequence" else fail str (ofs - 1) "invalid start of UTF-8 string" | _ -> fail str (ofs - 1) "invalid end of UTF-8 sequence" let rec move_l str ofs len = if len = 0 then ofs else if ofs = String.length str then raise Out_of_bounds else move_l str (unsafe_next str ofs) (len - 1) let unsafe_sub str ofs len = let res = Bytes.create len in String.unsafe_blit str ofs res 0 len; Bytes.unsafe_to_string res (* +-----------------------------------------------------------------+ | Construction | +-----------------------------------------------------------------+ *) let singleton char = let code = UChar.code char in Bytes.unsafe_to_string @@ if code < 0x80 then begin let s = Bytes.create 1 in set_byte s 0 code; s end else if code <= 0x800 then begin let s = Bytes.create 2 in set_byte s 0 ((code lsr 6) lor 0xc0); set_byte s 1 ((code land 0x3f) lor 0x80); s end else if code <= 0x10000 then begin let s = Bytes.create 3 in set_byte s 0 ((code lsr 12) lor 0xe0); set_byte s 1 (((code lsr 6) land 0x3f) lor 0x80); set_byte s 2 ((code land 0x3f) lor 0x80); s end else if code <= 0x10ffff then begin let s = Bytes.create 4 in set_byte s 0 ((code lsr 18) lor 0xf0); set_byte s 1 (((code lsr 12) land 0x3f) lor 0x80); set_byte s 2 (((code lsr 6) land 0x3f) lor 0x80); set_byte s 3 ((code land 0x3f) lor 0x80); s end else (* Camomile allow characters with code-point greater than 0x10ffff *) invalid_arg "Zed_utf8.singleton" let make n code = let str = singleton code in let len = String.length str in let res = Bytes.create (n * len) in let ofs = ref 0 in for _ = 1 to n do String.unsafe_blit str 0 res !ofs len; ofs := !ofs + len done; Bytes.unsafe_to_string res let init n f = let buf = Buffer.create n in for i = 0 to n - 1 do Buffer.add_string buf (singleton (f i)) done; Buffer.contents buf let rev_init n f = let buf = Buffer.create n in for i = n - 1 downto 0 do Buffer.add_string buf (singleton (f i)) done; Buffer.contents buf (* +-----------------------------------------------------------------+ | Informations | +-----------------------------------------------------------------+ *) let rec length_rec str ofs len = if ofs = String.length str then len else length_rec str (unsafe_next str ofs) (len + 1) let length str = length_rec str 0 0 (* +-----------------------------------------------------------------+ | Comparison | +-----------------------------------------------------------------+ *) let rec compare_rec str1 ofs1 str2 ofs2 = if ofs1 = String.length str1 then if ofs2 = String.length str2 then 0 else -1 else if ofs2 = String.length str2 then 1 else let code1, ofs1 = unsafe_extract_next str1 ofs1 and code2, ofs2 = unsafe_extract_next str2 ofs2 in let d = UChar.code code1 - UChar.code code2 in if d <> 0 then d else compare_rec str1 ofs1 str2 ofs2 let compare str1 str2 = compare_rec str1 0 str2 0 (* +-----------------------------------------------------------------+ | Random access | +-----------------------------------------------------------------+ *) let get str idx = if idx < 0 then raise Out_of_bounds else unsafe_extract str (move_l str 0 idx) (* +-----------------------------------------------------------------+ | Manipulation | +-----------------------------------------------------------------+ *) let sub str idx len = if idx < 0 || len < 0 then raise Out_of_bounds else let ofs1 = move_l str 0 idx in let ofs2 = move_l str ofs1 len in unsafe_sub str ofs1 (ofs2 - ofs1) let break str idx = if idx < 0 then raise Out_of_bounds else let ofs = move_l str 0 idx in (unsafe_sub str 0 ofs, unsafe_sub str ofs (String.length str - ofs)) let before str idx = if idx < 0 then raise Out_of_bounds else let ofs = move_l str 0 idx in unsafe_sub str 0 ofs let after str idx = if idx < 0 then raise Out_of_bounds else let ofs = move_l str 0 idx in unsafe_sub str ofs (String.length str - ofs) let concat3 a b c = let lena = String.length a and lenb = String.length b and lenc = String.length c in let res = Bytes.create (lena + lenb + lenc) in String.unsafe_blit a 0 res 0 lena; String.unsafe_blit b 0 res lena lenb; String.unsafe_blit c 0 res (lena + lenb) lenc; Bytes.unsafe_to_string res let insert str idx sub = let a, b = break str idx in concat3 a sub b let remove str idx len = if idx < 0 || len < 0 then raise Out_of_bounds else let ofs1 = move_l str 0 idx in let ofs2 = move_l str ofs1 len in unsafe_sub str 0 ofs1 ^ unsafe_sub str ofs2 (String.length str - ofs2) let replace str idx len repl = if idx < 0 || len < 0 then raise Out_of_bounds else let ofs1 = move_l str 0 idx in let ofs2 = move_l str ofs1 len in concat3 (unsafe_sub str 0 ofs1) repl (unsafe_sub str ofs2 (String.length str - ofs2)) (* +-----------------------------------------------------------------+ | Exploding and imploding | +-----------------------------------------------------------------+ *) let rec rev_rec (res : Bytes.t) str ofs_src ofs_dst = if ofs_src = String.length str then Bytes.unsafe_to_string res else begin let ofs_src' = unsafe_next str ofs_src in let len = ofs_src' - ofs_src in let ofs_dst = ofs_dst - len in String.unsafe_blit str ofs_src res ofs_dst len; rev_rec res str ofs_src' ofs_dst end let rev str = let len = String.length str in rev_rec (Bytes.create len) str 0 len let concat sep l = match l with | [] -> "" | x :: l -> let sep_len = String.length sep in let len = List.fold_left (fun len str -> len + sep_len + String.length str) (String.length x) l in let res = Bytes.create len in String.unsafe_blit x 0 res 0 (String.length x); ignore (List.fold_left (fun ofs str -> String.unsafe_blit sep 0 res ofs sep_len; let ofs = ofs + sep_len in let len = String.length str in String.unsafe_blit str 0 res ofs len; ofs + len) (String.length x) l); Bytes.unsafe_to_string res let rev_concat sep l = match l with | [] -> "" | x :: l -> let sep_len = String.length sep in let len = List.fold_left (fun len str -> len + sep_len + String.length str) (String.length x) l in let res = Bytes.create len in let ofs = len - String.length x in String.unsafe_blit x 0 res ofs (String.length x); ignore (List.fold_left (fun ofs str -> let ofs = ofs - sep_len in String.unsafe_blit sep 0 res ofs sep_len; let len = String.length str in let ofs = ofs - len in String.unsafe_blit str 0 res ofs len; ofs) ofs l); Bytes.unsafe_to_string res let rec explode_rec str ofs acc = if ofs = 0 then acc else let x, ofs = unsafe_extract_prev str ofs in explode_rec str ofs (x :: acc) let explode str = explode_rec str (String.length str) [] let rec rev_explode_rec str ofs acc = if ofs = String.length str then acc else let x, ofs = unsafe_extract_next str ofs in rev_explode_rec str ofs (x :: acc) let rev_explode str = rev_explode_rec str 0 [] let implode l = let l = List.map singleton l in let len = List.fold_left (fun len str -> len + String.length str) 0 l in let res = Bytes.create len in ignore (List.fold_left (fun ofs str -> let len = String.length str in String.unsafe_blit str 0 res ofs len; ofs + len) 0 l); Bytes.unsafe_to_string res let rev_implode l = let l = List.map singleton l in let len = List.fold_left (fun len str -> len + String.length str) 0 l in let res = Bytes.create len in ignore (List.fold_left (fun ofs str -> let len = String.length str in let ofs = ofs - len in String.unsafe_blit str 0 res ofs len; ofs) len l); Bytes.unsafe_to_string res (* +-----------------------------------------------------------------+ | Text transversal | +-----------------------------------------------------------------+ *) let rec iter_rec f str ofs = if ofs = String.length str then () else begin let chr, ofs = unsafe_extract_next str ofs in f chr; iter_rec f str ofs end let iter f str = iter_rec f str 0 let rec rev_iter_rec f str ofs = if ofs = 0 then () else begin let chr, ofs = unsafe_extract_prev str ofs in f chr; rev_iter_rec f str ofs end let rev_iter f str = rev_iter_rec f str (String.length str) let rec fold_rec f str ofs acc = if ofs = String.length str then acc else begin let chr, ofs = unsafe_extract_next str ofs in fold_rec f str ofs (f chr acc) end let fold f str acc = fold_rec f str 0 acc let rec rev_fold_rec f str ofs acc = if ofs = 0 then acc else begin let chr, ofs = unsafe_extract_prev str ofs in rev_fold_rec f str ofs (f chr acc) end let rev_fold f str acc = rev_fold_rec f str (String.length str) acc let rec map_rec buf f str ofs = if ofs = String.length str then Buffer.contents buf else begin let chr, ofs = unsafe_extract_next str ofs in Buffer.add_string buf (singleton (f chr)); map_rec buf f str ofs end let map f str = map_rec (Buffer.create (String.length str)) f str 0 let rec map_concat_rec buf f str ofs = if ofs = String.length str then Buffer.contents buf else begin let chr, ofs = unsafe_extract_next str ofs in Buffer.add_string buf (f chr); map_concat_rec buf f str ofs end let map_concat f str = map_concat_rec (Buffer.create (String.length str)) f str 0 let rec rev_map_rec buf f str ofs = if ofs = 0 then Buffer.contents buf else begin let chr, ofs = unsafe_extract_prev str ofs in Buffer.add_string buf (singleton (f chr)); rev_map_rec buf f str ofs end let rev_map f str = rev_map_rec (Buffer.create (String.length str)) f str (String.length str) let rec rev_map_concat_rec buf f str ofs = if ofs = 0 then Buffer.contents buf else begin let chr, ofs = unsafe_extract_prev str ofs in Buffer.add_string buf (f chr); rev_map_concat_rec buf f str ofs end let rev_map_concat f str = rev_map_concat_rec (Buffer.create (String.length str)) f str (String.length str) let rec filter_rec buf f str ofs = if ofs = String.length str then Buffer.contents buf else begin let chr, ofs = unsafe_extract_next str ofs in if f chr then Buffer.add_string buf (singleton chr); filter_rec buf f str ofs end let filter f str = filter_rec (Buffer.create (String.length str)) f str 0 let rec rev_filter_rec buf f str ofs = if ofs = 0 then Buffer.contents buf else begin let chr, ofs = unsafe_extract_prev str ofs in if f chr then Buffer.add_string buf (singleton chr); rev_filter_rec buf f str ofs end let rev_filter f str = rev_filter_rec (Buffer.create (String.length str)) f str (String.length str) let rec filter_map_rec buf f str ofs = if ofs = String.length str then Buffer.contents buf else begin let chr, ofs = unsafe_extract_next str ofs in (match f chr with | Some chr -> Buffer.add_string buf (singleton chr) | None -> ()); filter_map_rec buf f str ofs end let filter_map f str = filter_map_rec (Buffer.create (String.length str)) f str 0 let rec filter_map_concat_rec buf f str ofs = if ofs = String.length str then Buffer.contents buf else begin let chr, ofs = unsafe_extract_next str ofs in (match f chr with | Some txt -> Buffer.add_string buf txt | None -> ()); filter_map_concat_rec buf f str ofs end let filter_map_concat f str = filter_map_concat_rec (Buffer.create (String.length str)) f str 0 let rec rev_filter_map_rec buf f str ofs = if ofs = 0 then Buffer.contents buf else begin let chr, ofs = unsafe_extract_prev str ofs in (match f chr with | Some chr -> Buffer.add_string buf (singleton chr) | None -> ()); rev_filter_map_rec buf f str ofs end let rev_filter_map f str = rev_filter_map_rec (Buffer.create (String.length str)) f str (String.length str) let rec rev_filter_map_concat_rec buf f str ofs = if ofs = 0 then Buffer.contents buf else begin let chr, ofs = unsafe_extract_prev str ofs in (match f chr with | Some txt -> Buffer.add_string buf txt | None -> ()); rev_filter_map_concat_rec buf f str ofs end let rev_filter_map_concat f str = rev_filter_map_concat_rec (Buffer.create (String.length str)) f str (String.length str) (* +-----------------------------------------------------------------+ | Scanning | +-----------------------------------------------------------------+ *) let rec for_all_rec f str ofs = if ofs = String.length str then true else let chr, ofs = unsafe_extract_next str ofs in f chr && for_all_rec f str ofs let for_all f str = for_all_rec f str 0 let rec exists_rec f str ofs = if ofs = String.length str then false else let chr, ofs = unsafe_extract_next str ofs in f chr || exists_rec f str ofs let exists f str = exists_rec f str 0 let rec count_rec f str ofs n = if ofs = String.length str then n else let chr, ofs = unsafe_extract_next str ofs in count_rec f str ofs (if f chr then n + 1 else n) let count f str = count_rec f str 0 0 (* +-----------------------------------------------------------------+ | Tests | +-----------------------------------------------------------------+ *) let rec unsafe_sub_equal str ofs sub ofs_sub = if ofs_sub = String.length sub then true else (String.unsafe_get str ofs = String.unsafe_get sub ofs_sub) && unsafe_sub_equal str (ofs + 1) sub (ofs_sub + 1) let rec contains_rec str sub ofs = if ofs + String.length sub > String.length str then false else unsafe_sub_equal str ofs sub 0 || contains_rec str sub (unsafe_next str ofs) let contains str sub = contains_rec str sub 0 let starts_with str prefix = if String.length prefix > String.length str then false else unsafe_sub_equal str 0 prefix 0 let ends_with str suffix = let ofs = String.length str - String.length suffix in if ofs < 0 then false else unsafe_sub_equal str ofs suffix 0 (* +-----------------------------------------------------------------+ | Stripping | +-----------------------------------------------------------------+ *) let rec lfind predicate str ofs = if ofs = String.length str then ofs else let chr, ofs' = unsafe_extract_next str ofs in if predicate chr then lfind predicate str ofs' else ofs let rec rfind predicate str ofs = if ofs = 0 then 0 else let chr, ofs' = unsafe_extract_prev str ofs in if predicate chr then rfind predicate str ofs' else ofs let spaces = UCharInfo.load_property_tbl `White_Space let is_space ch = UCharTbl.Bool.get spaces ch let strip ?(predicate=is_space) str = let lofs = lfind predicate str 0 and rofs = rfind predicate str (String.length str) in if lofs < rofs then unsafe_sub str lofs (rofs - lofs) else "" let lstrip ?(predicate=is_space) str = let lofs = lfind predicate str 0 in unsafe_sub str lofs (String.length str - lofs) let rstrip ?(predicate=is_space) str = let rofs = rfind predicate str (String.length str) in unsafe_sub str 0 rofs let lchop = function | "" -> "" | str -> let ofs = unsafe_next str 0 in unsafe_sub str ofs (String.length str - ofs) let rchop = function | "" -> "" | str -> let ofs = unsafe_prev str (String.length str) in unsafe_sub str 0 ofs (* +-----------------------------------------------------------------+ | Buffers | +-----------------------------------------------------------------+ *) let add buf char = let code = UChar.code char in if code < 0x80 then Buffer.add_char buf (Char.unsafe_chr code) else if code <= 0x800 then begin Buffer.add_char buf (Char.unsafe_chr ((code lsr 6) lor 0xc0)); Buffer.add_char buf (Char.unsafe_chr ((code land 0x3f) lor 0x80)) end else if code <= 0x10000 then begin Buffer.add_char buf (Char.unsafe_chr ((code lsr 12) lor 0xe0)); Buffer.add_char buf (Char.unsafe_chr (((code lsr 6) land 0x3f) lor 0x80)); Buffer.add_char buf (Char.unsafe_chr ((code land 0x3f) lor 0x80)) end else if code <= 0x10ffff then begin Buffer.add_char buf (Char.unsafe_chr ((code lsr 18) lor 0xf0)); Buffer.add_char buf (Char.unsafe_chr (((code lsr 12) land 0x3f) lor 0x80)); Buffer.add_char buf (Char.unsafe_chr (((code lsr 6) land 0x3f) lor 0x80)); Buffer.add_char buf (Char.unsafe_chr ((code land 0x3f) lor 0x80)) end else invalid_arg "Zed_utf8.add" (* +-----------------------------------------------------------------+ | Offset API | +-----------------------------------------------------------------+ *) let extract str ofs = if ofs < 0 || ofs >= String.length str then raise Out_of_bounds else unsafe_extract str ofs let next str ofs = if ofs < 0 || ofs >= String.length str then raise Out_of_bounds else unsafe_next str ofs let extract_next str ofs = if ofs < 0 || ofs >= String.length str then raise Out_of_bounds else unsafe_extract_next str ofs let prev str ofs = if ofs <= 0 || ofs > String.length str then raise Out_of_bounds else unsafe_prev str ofs let extract_prev str ofs = if ofs <= 0 || ofs > String.length str then raise Out_of_bounds else unsafe_extract_prev str ofs (* +-----------------------------------------------------------------+ | Escaping | +-----------------------------------------------------------------+ *) let alphabetic = UCharInfo.load_property_tbl `Alphabetic let escaped_char ch = match UChar.code ch with | 7 -> "\\a" | 8 -> "\\b" | 9 -> "\\t" | 10 -> "\\n" | 11 -> "\\v" | 12 -> "\\f" | 13 -> "\\r" | 27 -> "\\e" | 92 -> "\\\\" | code when code >= 32 && code <= 126 -> String.make 1 (Char.chr code) | _ when UCharTbl.Bool.get alphabetic ch -> singleton ch | code when code <= 127 -> Printf.sprintf "\\x%02x" code | code when code <= 0xffff -> Printf.sprintf "\\u%04x" code | code -> Printf.sprintf "\\U%06x" code let add_escaped_char buf ch = match UChar.code ch with | 7 -> Buffer.add_string buf "\\a" | 8 -> Buffer.add_string buf "\\b" | 9 -> Buffer.add_string buf "\\t" | 10 -> Buffer.add_string buf "\\n" | 11 -> Buffer.add_string buf "\\v" | 12 -> Buffer.add_string buf "\\f" | 13 -> Buffer.add_string buf "\\r" | 27 -> Buffer.add_string buf "\\e" | 92 -> Buffer.add_string buf "\\\\" | code when code >= 32 && code <= 126 -> Buffer.add_char buf (Char.chr code) | _ when UCharTbl.Bool.get alphabetic ch -> add buf ch | code when code <= 127 -> Printf.bprintf buf "\\x%02x" code | code when code <= 0xffff -> Printf.bprintf buf "\\u%04x" code | code -> Printf.bprintf buf "\\U%06x" code let escaped str = let buf = Buffer.create (String.length str) in iter (add_escaped_char buf) str; Buffer.contents buf let add_escaped buf str = iter (add_escaped_char buf) str let add_escaped_string buf enc str = match try Some (CharEncoding.recode_string ~in_enc:enc ~out_enc:CharEncoding.utf8 str) with CharEncoding.Malformed_code -> None with | Some str -> add_escaped buf str | None -> String.iter (function | '\x20' .. '\x7e' as ch -> Buffer.add_char buf ch | ch -> Printf.bprintf buf "\\y%02x" (Char.code ch)) str let escaped_string enc str = let buf = Buffer.create (String.length str) in add_escaped_string buf enc str; Buffer.contents buf zed-2.0.5/src/zed_utf8.mli000066400000000000000000000261241361427230000153250ustar00rootroot00000000000000(* * zed_utf8.mli * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) (** UTF-8 enoded strings *) open CamomileLibrary type t = string (** Type of UTF-8 encoded strings. *) exception Invalid of string * string (** [Invalid(error, text)] Exception raised when an invalid UTF-8 encoded string is encountered. [text] is the faulty text and [error] is a description of the first error in [text]. *) exception Out_of_bounds (** Exception raised when trying to access a character which is outside the bounds of a string. *) (** {5 Validation} *) (** Result of cheking a string for correct UTF-8. *) type check_result = | Correct of int (** The string is correctly UTF-8 encoded, and the paramter is the length of the string. *) | Message of string (** The string is invalid and the parameter is an error message. *) val check : t -> check_result (** [check str] checks that [str] is a valid UTF-8 encoded string. *) val validate : t -> int (** Same as check but raises an exception in case the argument is not a valid text, otherwise returns the length of the string. *) val next_error : t -> int -> int * int * string (** [next_error str ofs] returns [(ofs', count, msg)] where [ofs'] is the offset of the start of the first invalid sequence after [ofs] (inclusive) in [str], [count] is the number of unicode character between [ofs] and [ofs'] (exclusive) and [msg] is an error message. If there is no error until the end of string then [ofs] is [String.length str] and [msg] is the empty string. *) (** {5 Construction} *) val singleton : UChar.t -> t (** [singleton ch] creates a string of length 1 containing only the given character. *) val make : int -> UChar.t -> t (** [make n ch] creates a string of length [n] filled with [ch]. *) val init : int -> (int -> UChar.t) -> t (** [init n f] returns the contenation of [singleton (f 0)], [singleton (f 1)], ..., [singleton (f (n - 1))]. *) val rev_init : int -> (int -> UChar.t) -> t (** [rev_init n f] returns the contenation of [singleton (f (n - 1))], ..., [singleton (f 1)], [singleton (f 0)]. *) (** {5 Informations} *) val length : t -> int (** Returns the length of the given string. *) (** {5 Comparison} *) val compare : t -> t -> int (** Compares two strings (in code point order). *) (** {5 Random access} *) val get : t -> int -> UChar.t (** [get str idx] returns the character at index [idx] in [str]. *) (** {5 String manipulation} *) val sub : t -> int -> int -> t (** [sub str ofs len] Returns the sub-string of [str] starting at [ofs] and of length [len]. *) val break : t -> int -> t * t (** [break str pos] returns the sub-strings before and after [pos] in [str]. It is more efficient than creating two sub-strings with {!sub}. *) val before : t -> int -> t (** [before str pos] returns the sub-string before [pos] in [str] *) val after : t -> int -> t (** [after str pos] returns the sub-string after [pos] in [str] *) val insert : t -> int -> t -> t (** [insert str pos sub] inserts [sub] in [str] at position [pos]. *) val remove : t -> int -> int -> t (** [remove str pos len] removes the [len] characters at position [pos] in [str] *) val replace : t -> int -> int -> t -> t (** [replace str pos len repl] replaces the [len] characters at position [pos] in [str] by [repl]. *) (** {5 Tranformation} *) val rev : t -> t (** [rev str] reverses all characters of [str]. *) val concat : t -> t list -> t (** [concat sep l] returns the concatenation of all strings of [l] separated by [sep]. *) val rev_concat : t -> t list -> t (** [concat sep l] returns the concatenation of all strings of [l] in reverse order separated by [sep]. *) val explode : t -> UChar.t list (** [explode str] returns the list of all characters of [str]. *) val rev_explode : t -> UChar.t list (** [rev_explode str] returns the list of all characters of [str] in reverse order. *) val implode : UChar.t list -> t (** [implode l] returns the concatenation of all characters of [l]. *) val rev_implode : UChar.t list -> t (** [rev_implode l] is the same as [implode (List.rev l)] but more efficient. *) (** {5 Text traversals} *) val iter : (UChar.t -> unit) -> t -> unit (** [iter f str] applies [f] an all characters of [str] starting from the left. *) val rev_iter : (UChar.t -> unit) -> t -> unit (** [rev_iter f str] applies [f] an all characters of [str] starting from the right. *) val fold : (UChar.t -> 'a -> 'a) -> t -> 'a -> 'a (** [fold f str acc] applies [f] on all characters of [str] starting from the left, accumulating a value. *) val rev_fold : (UChar.t -> 'a -> 'a) -> t -> 'a -> 'a (** [rev_fold f str acc] applies [f] on all characters of [str] starting from the right, accumulating a value. *) val map : (UChar.t -> UChar.t) -> t -> t (** [map f str] maps all characters of [str] with [f]. *) val rev_map : (UChar.t -> UChar.t) -> t -> t (** [rev_map f str] maps all characters of [str] with [f] in reverse order. *) val map_concat : (UChar.t -> t) -> t -> t (** [map f str] maps all characters of [str] with [f] and concatenate the result. *) val rev_map_concat : (UChar.t -> t) -> t -> t (** [rev_map f str] maps all characters of [str] with [f] in reverse order and concatenate the result. *) val filter : (UChar.t -> bool) -> t -> t (** [filter f str] filters characters of [str] with [f]. *) val rev_filter : (UChar.t -> bool) -> t -> t (** [rev_filter f str] filters characters of [str] with [f] in reverse order. *) val filter_map : (UChar.t -> UChar.t option) -> t -> t (** [filter_map f str] filters and maps characters of [str] with [f]. *) val rev_filter_map : (UChar.t -> UChar.t option) -> t -> t (** [rev_filter_map f str] filters and maps characters of [str] with [f] in reverse order. *) val filter_map_concat : (UChar.t -> t option) -> t -> t (** [filter_map f str] filters and maps characters of [str] with [f] and concatenate the result. *) val rev_filter_map_concat : (UChar.t -> t option) -> t -> t (** [rev_filter_map f str] filters and maps characters of [str] with [f] in reverse order and concatenate the result. *) (** {5 Scanning} *) val for_all : (UChar.t -> bool) -> t -> bool (** [for_all f text] returns whether all characters of [text] verify the predicate [f]. *) val exists : (UChar.t -> bool) -> t -> bool (** [exists f text] returns whether at least one character of [text] verify [f]. *) val count : (UChar.t -> bool) -> t -> int (** [count f text] returhs the number of characters of [text] verifying [f]. *) (** {5 Tests} *) val contains : t -> t -> bool (** [contains text sub] returns whether [sub] appears in [text] *) val starts_with : t -> t -> bool (** [starts_with text prefix] returns [true] iff [s] starts with [prefix]. *) val ends_with : t -> t -> bool (** [ends_with text suffix] returns [true] iff [s] ends with [suffix]. *) (** {5 Stripping} *) val strip : ?predicate : (UChar.t -> bool) -> t -> t (** [strip ?predicate text] returns [text] without its firsts and lasts characters that match [predicate]. [predicate] default to testing whether the given character has the [`White_Space] unicode property. For example: {[ strip "\n foo\n " = "foo" ]} *) val lstrip : ?predicate : (UChar.t -> bool) -> t -> t (** [lstrip ?predicate text] is the same as {!strip} but it only removes characters at the left of [text]. *) val rstrip : ?predicate : (UChar.t -> bool) -> t -> t (** [lstrip ?predicate text] is the same as {!strip} but it only removes characters at the right of [text]. *) val lchop : t -> t (** [lchop t] returns [t] without is first character. Returns [""] if [t = ""] *) val rchop : t -> t (** [rchop t] returns [t] without is last character. Returns [""] if [t = ""]. *) (** {5 Buffers} *) val add : Buffer.t -> UChar.t -> unit (** [add buf ch] is the same as [Buffer.add_string buf (singleton ch)] but is more efficient. *) (** {5 Escaping} *) val escaped_char : UChar.t -> t (** [escaped_char ch] returns a string containg [ch] or an escaped version of [ch] if: - [ch] is a control character (code < 32) - [ch] is the character with code 127 - [ch] is a non-ascii, non-alphabetic character It uses the syntax [\xXX], [\uXXXX], [\UXXXXXX] or a specific escape sequence [\n, \r, ...]. *) val add_escaped_char : Buffer.t -> UChar.t -> unit (** [add_escaped_char buf ch] is the same as [Buffer.add_string buf (escaped_char ch)] but a bit more efficient. *) val escaped : t -> t (** [escaped text] escape all characters of [text] as with [escape_char]. *) val add_escaped : Buffer.t -> t -> unit (** [add_escaped_char buf text] is the same as [Buffer.add_string buf (escaped text)] but a bit more efficient. *) val escaped_string : CamomileLibraryDefault.Camomile.CharEncoding.t -> string -> t (** [escaped_string enc str] escape the string [str] which is encoded with encoding [enc]. If decoding [str] with [enc] fails, it escape all non-printable bytes of [str] with the syntax [\yAB]. *) val add_escaped_string : Buffer.t -> CamomileLibraryDefault.Camomile.CharEncoding.t -> string -> unit (** [add_escaped_char buf enc text] is the same as [Buffer.add_string buf (escaped_string enc text)] but a bit more efficient. *) (** {5 Safe offset API} *) val next : t -> int -> int (** [next str ofs] returns the offset of the next character in [str]. *) val prev : t -> int -> int (** [prev str ofs] returns the offset of the previous character in [str]. *) val extract : t -> int -> UChar.t (** [extract str ofs] returns the code-point at offset [ofs] in [str]. *) val extract_next : t -> int -> UChar.t * int (** [extract_next str ofs] returns the code-point at offset [ofs] in [str] and the offset of the next character. *) val extract_prev : t -> int -> UChar.t * int (** [extract_prev str ofs] returns the code-point at the previous offset in [str] and this offset. *) (** {5 Unsafe offset API} *) (** These functions does not check that the given offset is inside the bounds of the given string. *) val unsafe_next : t -> int -> int (** [unsafe_next str ofs] returns the offset of the next character in [str]. *) val unsafe_prev : t -> int -> int (** [unsafe_prev str ofs] returns the offset of the previous character in [str]. *) val unsafe_extract : t -> int -> UChar.t (** [unsafe_extract str ofs] returns the code-point at offset [ofs] in [str]. *) val unsafe_extract_next : t -> int -> UChar.t * int (** [unsafe_extract_next str ofs] returns the code-point at offset [ofs] in [str] and the offset the next character. *) val unsafe_extract_prev : t -> int -> UChar.t * int (** [unsafe_extract_prev str ofs] returns the code-point at the previous offset in [str] and this offset. *) zed-2.0.5/src/zed_utils.ml000066400000000000000000000032231361427230000154210ustar00rootroot00000000000000(* * zed_utils.ml * ----------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Zed, an editor engine. *) open CamomileLibraryDefault.Camomile module Convert(US: UnicodeString.Type)= struct let of_list l= let buf= US.Buf.create 0 in let rec convert l= match l with | []-> () | c::tl -> US.Buf.add_char buf c; convert tl in convert l; US.Buf.contents buf let of_array a= let buf= US.Buf.create 0 in for i= 0 to Array.length a - 1 do US.Buf.add_char buf a.(i) done; US.Buf.contents buf let to_uChars us= let first= US.first us and last= US.last us in let length= US.length us in let rec create acc i= if US.compare_index us i first >= 0 then create (US.look us i :: acc) (US.prev us i) else acc in if length > 0 then create [] last else [] end let array_rev a= let len= Array.length a - 1 in Array.init len (fun i-> a.(len-i)) let rec list_compare ?(compare=compare) l1 l2= match l1, l2 with | [], []-> 0 | [], _-> -1 | _, []-> 1 | h1::t1, h2::t2-> match compare h1 h2 with | 0-> list_compare ~compare t1 t2 | _ as r-> r let array_compare ?(compare=compare) a1 a2= let len1= Array.length a1 and len2= Array.length a2 in let rec compare_aux pos= let remain1= len1 - pos and remain2= len2 - pos in if remain1 <= 0 && remain2 <= 0 then 0 else if remain1 <= 0 && remain2 > 0 then -1 else if remain1 > 0 && remain2 <= 0 then 1 else match compare a1.(pos) a2.(pos) with | 0-> compare_aux (pos + 1) | _ as r-> r in compare_aux 0 zed-2.0.5/style.css000066400000000000000000000050361361427230000141540ustar00rootroot00000000000000/* A style for ocamldoc. Daniel C. Buenzli, Jérémie Dimino */ body { padding: 0em; border: 0em; margin: 2em 10% 2em 10%; font-weight: normal; line-height: 130%; text-align: justify; background: white; color : black; min-width: 40ex; } pre, p, div, span, img, table, td, ol, ul, li { padding: 0em; border: 0em; margin: 0em } h1, h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 { fontsize: 100%; margin-bottom: 1em padding: 1ex 0em 0em 0em; border: 0em; margin: 1em 0em 0em 0em; font-weight : bold; text-align: center; } h1 { font-size : 140% } h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 { font-size : 100%; border-top-style : none; margin: 1ex 0em 0em 0em; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px; text-align: center; padding: 2px; } h2 { font-size : 120%; background-color: #90BDFF ; } h3 { background-color: #90DDFF; } h4 { background-color: #90EDFF; } h5 { background-color: #90FDFF; } h6 { background-color: #C0FFFF; } div.h7 { background-color: #E0FFFF; } div.h8 { background-color: #F0FFFF; } div.h9 { background-color: #FFFFFF; } .navbar { padding-bottom : 1em; margin-bottom: 1em; border-bottom: 1px solid #000000; border-bottom-style: dotted; } p { padding: 1em 0ex 0em 0em } a, a:link, a:visited, a:active, a:hover { color : #009; text-decoration: none } a:hover { color : #009; text-decoration : none; background-color: #5FFF88 } hr { border-style: none; } table { font-size : 100% /* Why ? */ } ul li { padding: 1em 0em 0em 0em; margin:0em 0em 0em 2.5ex } ol li { padding: 1em 0em 0em 0em; margin:0em 0em 0em 2em } pre { margin: 3ex 0em 1ex 0em; background-color: #edf0f9; } .keyword { font-weight: bold; color: #a020f0; } .keywordsign { font-weight: bold; color: #a020f0; } .typefieldcomment { color : #b22222; } .keywordsign { color: #a020f0; } .code { font-size: 100%; color: #5f5f5f; } .info { margin: 0em 0em 0em 2em } .comment { color : #b22222; } .constructor { color : #072 } .type { color : #228b22; } .string { color : #bc8f8f; } .warning { color : Red; font-weight : bold } div.sig_block { margin-left: 2em } .typetable { color : #b8860b; border-style : hidden } .indextable { border-style : hidden } .paramstable { border-style : hidden; padding: 5pt 5pt } .superscript { font-size : 80% } .subscript { font-size : 80% } zed-2.0.5/zed.descr000066400000000000000000000010221361427230000140750ustar00rootroot00000000000000Abstract engine for text edition in OCaml Zed is an abstract engine for text edition. It can be used to write text editors, edition widgets, readlines, ... Zed uses Camomile to fully support the Unicode specification, and implements an UTF-8 encoded string type with validation, and a rope datastructure to achieve efficient operations on large Unicode buffers. Zed also features a regular expression search on ropes. To support efficient text edition capabilities, Zed provides macro recording and cursor management facilities. zed-2.0.5/zed.opam000066400000000000000000000021011361427230000137300ustar00rootroot00000000000000opam-version: "2.0" maintainer: "opam-devel@lists.ocaml.org" authors: ["Jérémie Dimino"] homepage: "https://github.com/ocaml-community/zed" bug-reports: "https://github.com/ocaml-community/zed/issues" dev-repo: "git://github.com/ocaml-community/zed.git" license: "BSD3" depends: [ "ocaml" {>= "4.02.3"} "dune" {>= "1.1.0"} "base-bytes" "camomile" {>= "1.0.1"} "react" "charInfo_width" {>= "1.1.0" & < "2.0~"} ] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] synopsis: "Abstract engine for text edition in OCaml" description: """ Zed is an abstract engine for text edition. It can be used to write text editors, edition widgets, readlines, ... Zed uses Camomile to fully support the Unicode specification, and implements an UTF-8 encoded string type with validation, and a rope datastructure to achieve efficient operations on large Unicode buffers. Zed also features a regular expression search on ropes. To support efficient text edition capabilities, Zed provides macro recording and cursor management facilities."""