pax_global_header00006660000000000000000000000064136643362540014526gustar00rootroot0000000000000052 comment=2910781e1e946770ffe6f3657d4f0820c79d8730 lambda-term-3.1.0/000077500000000000000000000000001366433625400137145ustar00rootroot00000000000000lambda-term-3.1.0/.github/000077500000000000000000000000001366433625400152545ustar00rootroot00000000000000lambda-term-3.1.0/.github/CODEOWNERS000066400000000000000000000000101366433625400166360ustar00rootroot00000000000000* @diml lambda-term-3.1.0/.gitignore000066400000000000000000000000331366433625400157000ustar00rootroot00000000000000_build/ *.merlin *.install lambda-term-3.1.0/.travis.yml000066400000000000000000000004771366433625400160350ustar00rootroot00000000000000language: 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.06 - OCAML_VERSION=4.08 - OCAML_VERSION=4.10 os: - linux - osx lambda-term-3.1.0/CHANGES.md000066400000000000000000000140771366433625400153170ustar00rootroot000000000000003.1.0 (2020-05-30) ------------------ * `LTerm_read_line` and `LTerm_vi`: * vi visual mode * register support 3.0.1 (2020-05-06) ------------------ * `LTerm_read_line`: fix synchronization bug 3.0.0 (2020-04-25) ------------------ ### Additions * `LTerm_editor`: two editor modes: default and vi * `LTerm_read_line: class virtual ['a] term`: * `method editor_mode : LTerm_editor.mode signal`: the current editor mode * `method set_editor_mode : LTerm_editor.mode -> unit`: set the current editor mode Add initial support for vi editing mode to `LTerm_read_line`: * motions: * h l 0 ^ $ * j k gg G * w W e E b B ge gE * f F t T * aw iw aW iW * include or inner ( ), [ ], { }, < >, ' and " * generic quote: aq? iq? where ? could be any character * bracket matching: jump back and forth between matched brakcets * delete, change, yank with motions * paste: p P * line joining: J Many thanks to @nilsbecker for his feature-request on vi edit mode and the helps during the development on this topic! ### Breaking * `LTerm_read_line * class virtual ['a] term`: the type signature of `method private exec` is changed from `method private exec : action list -> 'a Lwt.t` to `?keys : LTerm_key.t list -> action list -> 'a loop_result Lwt.t` Since this is a private method and is intended to be used internally, the backward-compatibility will not be affected in most cases. ### General * Load inputrc file from ~/.config/.lambda-term-inputrc as per XDG conventions (@copy) 2.0.3 (2019-12-31) ------------------ LTerm\_edit: add horizontal scrolling support for wide width character 2.0.2 (2019-08-09) ------------------ LTerm\_history: catch and log `Zed_string.Invalid` exception 2.0.1 (2019-06-17) ------------------ * fix windows build (@db4, #72) * expand zchar before writing to windows console (@kandu, #75) 2.0 (2019-05-17) ---------------- ### Breaking * LTerm\_draw: type `point` is redefined to use `Zed_char.t` as the essential element to support wide, combined glyph * functions and methods: change parameter type from `UChar.t` or `Zed_utf8.t` to `Zed_char.t` or `Zed_string.t` * LTerm\_text * function `of_string` is renamed to `of_utf8` * function `of_string_maybe_invalid` is renamed to `of_utf8_maybe_invalid` * the new `of_string` function is of type `Zed_string.t -> t` * the new `of_string_maybe_invalid` function is of type `Zed_string.t -> t` ### General * depend on zed 2 * Lterm\_draw, LTerm\_widget, LTerm\_read\_line refactored to support wide, combined glyphs * add name to dune-project (Hannes Mehnert, #70) * port to dune (Jérémie Dimino, #69) * README: Add Travis badge (Kevin Ji, #66) * Add travis config (Anurag Soni, #65) * opam: update homepage, bug-reports and dev-repo fields (Jérémie Dimino) 1.13 (2018-06-01) ----------------- * Make lambda-term compatible with Lwt 4 and Camomile 1 (#63, @ncihnegn) 1.12 (2017-11-05) ----------------- * Fix: copy & pasting the terminal output doesn't adds many spaces after the end of lines (#52, Deokhwan Kim, fixes diml/utop#186) * -safe-string compatibility (#54) 1.11 (2017-04-04) ----------------- * Add history-search-prev and history-search-next (#47, Fabian Hemmer) * Allow frame widgets to be labeled (#36, Andrew Ray) * Add an alignment setting to label widgets (#36, Andrew Ray) * Add scrollbar widgets (#33, Andrew Ray) * Improve the `lambda-term-inputrc.5` man page (#41, Léon van Velzen) * Allow editor widgets to request a specific size and add a "double editor" example (#42, Fabian Bonk) * Add `^` to the list of characters recognized in inputrc files (#46, github user zhenya1007) * Switch the build to jbuilder * Drop compatibility with 4.01 1.10.1 (2016-08-15) ------------------- * fix a race condition in `LTerm_read_line`. The race would often appear when copy&pasting 1.10 (2016-04-07) ----------------- * add support for editing the current input with an external editor (action `edit-with-external-editor`), bound to `C-x C-e` by default * add forward search in history (action `next-search`), bound to `M-s` by default * add support for mouse clicks on widgets (thanks to Andrew Ray) * add support for looking up files in XDG locations (thanks to Genki Marshall) 1.9 (2015-06-23) ---------------- * add repl example (Martin DeMello) * add support for custom and local bindings 1.8 (2015-01-07) ---------------- * remove use of deprecated Lwt functions * add some iTerm2 keys * fix some invalid use of react 1.7 (2014-10-20) ---------------- * removed hard dependency on camlp4 (thanks to Peter Zotov) * added styled formatters (thanks to Gabriel Radanne) * doc fixes * Extended widget support (thanks to Alexey Vyskubov): - added modal frames - added radiobutton and checkbutton 1.6 (2014-04-21) ---------------- * Support for React 1.0.0 * fix OpenBSD builds 1.5 (2013-08-07) ---------------- * workaround camomile raising the wrong exception for encoding failures * add more default keybindings 1.4 (2013-03-26) ---------------- * added `C-b`, `C-f`, `C-h`, `M-p`, `M-n` by default * fix a segfault when running utop in an emacs terminal buffer 1.3 (2012-10-08) ---------------- * fix the bindings for `C-n` and `C-p` * binds `C-h` to delete-prev-char 1.2 (2012-07-30) ---------------- * better handling of newlines in read-line (avoid square selection bug) * add a module for managing history * use camomile for character encoding (remove iconv dependency) * include generated tables for color mappings to speed up the build * Windows fixes * use unicode version of IO console functions * better rendering method for read-line 1.1 (2011-08-06) ---------------- * fix a blinking problem on OS-X * bind the `kill-{prev,next}-word` editing actions * bind the undo action * add doc for edition actions * add `LTerm_key.to_string_compact` to print keys like emacs * use `Zed_input` for key bindings instead of hash tables * add support for macros * add the break action to interrupt read-line * add manual pages * allow to get the current pending key sequence in read-line * make the `LTerm_read_line.term` class more flexible lambda-term-3.1.0/LICENSE000066400000000000000000000027561366433625400147330ustar00rootroot00000000000000Copyright (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. lambda-term-3.1.0/Makefile000066400000000000000000000011611366433625400153530ustar00rootroot00000000000000INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) .PHONY: all all: dune build @install @examples/all .PHONY: examples examples: dune build @examples/all .PHONY: asciiart asciiart: dune build examples/asciiart/asciiart.exe .PHONY: install install: dune install $(INSTALL_ARGS) .PHONY: uninstall uninstall: dune uninstall $(INSTALL_ARGS) .PHONY: reinstall reinstall: $(MAKE) uninstall $(MAKE) install .PHONY: test test: dune runtest .PHONY: all-supported-ocaml-versions all-supported-ocaml-versions: dune build @install @examples/all @runtest --workspace dune-workspace.dev .PHONY: clean clean: dune clean lambda-term-3.1.0/README.md000066400000000000000000000065711366433625400152040ustar00rootroot00000000000000Lambda-Term =========== [![Build Status](https://travis-ci.org/ocaml-community/lambda-term.svg?branch=master)](https://travis-ci.org/ocaml-community/lambda-term) Lambda-Term is a cross-platform library for manipulating the terminal. It provides an abstraction for keys, mouse events, colors, as well as a set of widgets to write curses-like applications. The main objective of Lambda-Term is to provide a higher level functional interface to terminal manipulation than, for example, ncurses, by providing a native OCaml interface instead of bindings to a C library. Lambda-Term integrates with zed to provide text edition facilities in console applications. Installation ------------ To build and install Lambda-Term: $ dune build $ dune install Note that this will build Lambda-Term using the development build profile which has strict compilation flags. If the build fails, try passing `--profile=release` to `dune` or alternatively create a `dune-workspace` file with the following contents: (lang dune 1.1) (profile release) ### HTML API Documentation _(optional)_ To build the documentation: $ dune build @doc You can then consult it by openning `_build/default/_doc/_html/index.html`. ### Tests _(optional)_ To build and execute tests: $ dune runtest ### Examples _(optional)_ To build the examples: $ dune build @examples Binaries for the examples will be in `_build/default/examples`. The `asciiart` example is not built by default as it as an additional dependency on the `camlimages` library. To build it run: $ dune build examples/asciiart/asciiart.exe Terminal emulators compatibility -------------------------------- All terminal emulators behave differently, especially regarding how keystrokes are reported to the application on its standard input. Lambda-Term tries to handle all of them, but it may happen that a particular key of combination of keys is not recognized by Lambda-Term, and thus does not produce the expected effect (for example: arrow keys or backspace not working). To check what is reported by your terminal you can run the script `print_sequences.ml` which at the root of the repository: $ ocaml print_sequences.ml press 'q' to quit \027[A \027[D \027[C \027[A \027[D a z e q You can then send the result to jeremie@dimino.org, including: * the application you are using as terminal emulator, * the contents of the `TERM` environment variable inside the terminal (`echo $TERM`), * the output of `print_sequences.ml` with, for each line, the keystroke. Key bindings ------------ Key bindings can be set in `~/.config/.lambda-term-inputrc`. See [lambda-term-inputrc](lambda-term-inputrc). Useful mappings: ``` # This allows zsh-like searching the history by pressing up/down [read-line] up: history-search-prev down: history-search-next ``` Main modules ------------ * `LTerm`: basic interface to the terminal, it allows to put the terminal in _raw_ mode, hide the cursor, render an offscreen array of points, ... * `LTerm_draw`: drawing functions, for rendering in an offscreen array. * `LTerm_read_line`: line edition. * `LTerm_inputrc`: parsing of configurations files for key bindings. * `LTerm_history`: history and history file management. * `LTerm_ui`: helpers for writing full-screen applications. * `LTerm_widget`: widget system (not stable). * `LTerm_resources`: resources loading for widgets. lambda-term-3.1.0/dune000066400000000000000000000002041366433625400145660ustar00rootroot00000000000000(install (section share_root) (files lambda-term-inputrc lambda-termrc)) (alias (name examples) (deps (alias examples/all))) lambda-term-3.1.0/dune-project000066400000000000000000000000431366433625400162330ustar00rootroot00000000000000(lang dune 1.1) (name lambda-term) lambda-term-3.1.0/dune-workspace.dev000066400000000000000000000004241366433625400173430ustar00rootroot00000000000000(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))) lambda-term-3.1.0/examples/000077500000000000000000000000001366433625400155325ustar00rootroot00000000000000lambda-term-3.1.0/examples/asciiart/000077500000000000000000000000001366433625400173315ustar00rootroot00000000000000lambda-term-3.1.0/examples/asciiart/asciiart.ml000066400000000000000000000154511366433625400214700ustar00rootroot00000000000000(* * asciiart.ml * ----------- * Copyright : (c) 2016, Andy Ray * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* ascii chars of increasing intensity *) let palette = " .*:o&8#@" (* grayscale conversion coefficients *) let coefs = [| 0.229; 0.587; 0.114 |] (* load image *) let load file = let img = OImages.load file [] in match OImages.tag img with | OImages.Index8 img | OImages.Index16 img -> img#to_rgb24 | OImages.Rgb24 img -> img | _ -> failwith "not supported" (* images will be scaled down by averaging pixels in blocks of this size *) let avg_cols = ref 5 let avg_rows = ref 10 let filename = ref "test.png" let () = Arg.(parse [ "-cols", Set_int avg_cols, "num cols to average"; "-rows", Set_int avg_rows, "num rows to average"; ] (fun s -> filename := s) "asciiart [options] filename") (* scale image and convert to indices into palette *) let indices img = let rows = img#height in let cols = img#width in let avg = float_of_int (!avg_rows * !avg_cols) in let luma r g b = ((float_of_int r *. coefs.(0)) +. (float_of_int g *. coefs.(1)) +. (float_of_int b *. coefs.(2))) in Array.init (rows / !avg_rows) (fun row -> Array.init (cols / !avg_cols) (fun col -> let sum = ref 0. in for row=row * !avg_rows to ((row+1) * !avg_rows)-1 do for col=col * !avg_cols to ((col+1) * !avg_cols)-1 do let pel = img#get col row in sum := !sum +. (luma pel.Images.r pel.Images.g pel.Images.b) done done; let sum = !sum /. (256. *. avg) in max 0 @@ min 8 (int_of_float (sum *. 9.)))) open Lwt open LTerm_widget open LTerm_geom open CamomileLibrary (* scrollable asciiart widget *) class asciiart img = object(self) inherit t "asciiart" as super method! can_focus = true (* scrollable interfaces *) val vscroll = new scrollable val hscroll = new scrollable method vscroll = vscroll method hscroll = hscroll method document_size = { rows = img#height / !avg_rows; cols = img#width / !avg_cols; } initializer vscroll#set_document_size self#document_size.rows; hscroll#set_document_size self#document_size.cols method! set_allocation r = super#set_allocation r; let size = size_of_rect r in vscroll#set_page_size size.rows; hscroll#set_page_size size.cols val style = LTerm_style.({ none with foreground=Some white; background=Some black }) (* buffer the image - reconvert when the scale changes *) val mutable stored_img : (int * int * (int array array)) option = None method img = match stored_img with | Some(r, c, i) when r = !avg_rows && c = !avg_cols -> i | _ -> stored_img <- Some(!avg_rows, !avg_cols, indices img); self#img method! draw ctx _focused = let { rows; cols } = LTerm_draw.size ctx in let img = self#img in for row=0 to rows-1 do for col=0 to cols-1 do LTerm_draw.draw_char ~style ctx row col @@ Zed_char.unsafe_of_char palette.[ try img.(row + vscroll#offset).(col + hscroll#offset) with _ -> 0 ] done done (* delta from center of screen *) method private mouse_delta_event ev = let open LTerm_mouse in match ev with | LTerm_event.Mouse m when m.button=Button1 && m.control=true -> let alloc = self#allocation in let size = size_of_rect alloc in vscroll#set_offset (vscroll#offset + m.LTerm_mouse.row - alloc.row1 - size.rows/2); hscroll#set_offset (hscroll#offset + m.LTerm_mouse.col - alloc.col1 - size.cols/2); true | _ -> false (* adjust scale, which changes the document size *) method private scale_event = function | LTerm_event.Key{LTerm_key.code=LTerm_key.Char c;_} when c = UChar.of_char 'w' -> avg_rows := max 1 (!avg_rows - 1); vscroll#set_document_size self#document_size.rows; self#queue_draw; true | LTerm_event.Key{LTerm_key.code=LTerm_key.Char c;_} when c = UChar.of_char 's' -> avg_rows := !avg_rows + 1; vscroll#set_document_size self#document_size.rows; self#queue_draw; true | LTerm_event.Key{LTerm_key.code=LTerm_key.Char c;_} when c = UChar.of_char 'a' -> avg_cols := max 1 (!avg_cols - 1); hscroll#set_document_size self#document_size.cols; self#queue_draw; true | LTerm_event.Key{LTerm_key.code=LTerm_key.Char c;_} when c = UChar.of_char 'd' -> avg_cols := !avg_cols + 1; hscroll#set_document_size self#document_size.cols; self#queue_draw; true | _ -> false (* page up/down *) method page_event = function | LTerm_event.Key{LTerm_key.code=LTerm_key.Next_page;_} -> vscroll#set_offset @@ vscroll#page_next; self#queue_draw; true | LTerm_event.Key{LTerm_key.code=LTerm_key.Prev_page;_} -> vscroll#set_offset @@ vscroll#page_prev; self#queue_draw; true | _ -> false initializer self#on_event (fun ev -> self#scale_event ev || self#page_event ev || self#mouse_delta_event ev) end (* place vertical and horizontal scroll bars around the picture *) let with_scrollbar ?down widget = let vbox = new vbox in let hbox = new hbox in (* make scroll bars roughly the same size *) let vscroll = new vscrollbar ~width:3 widget#vscroll in let hscroll = new hscrollbar ~height:2 widget#hscroll in let spacing = new spacing ~rows:2 ~cols:3 () in hbox#add widget; hbox#add ~expand:false (new vline); hbox#add ~expand:false vscroll; vbox#add hbox; vbox#add ~expand:false (new hline); let hbox = new hbox in hbox#add hscroll; hbox#add ~expand:false (new vline); hbox#add ~expand:false spacing; vbox#add ~expand:false hbox; (* moving focus *) widget#set_focus { widget#focus with right = Some(vscroll :> t); down = Some(hscroll :> t) }; vscroll#set_focus { vscroll#focus with down = Some(hscroll :> t) }; hscroll#set_focus { hscroll#focus with up = Some(vscroll :> t); down }; (* events *) widget#on_event (fun ev -> vscroll#mouse_event ev && hscroll#mouse_event ev); vscroll#on_event widget#page_event; vbox let main () = let img = load !filename in let waiter, wakener = wait () in let exit = new button "exit" in exit#on_click (wakeup wakener); let vbox = with_scrollbar ~down:(exit :> t) (new asciiart img) in vbox#add ~expand:false (new hline); vbox#add ~expand:false exit; let top = new frame in top#set vbox; top#on_event (function (* quit with escape key *) | LTerm_event.Key{LTerm_key.code=LTerm_key.Escape;_} -> wakeup wakener (); false | _ -> false); Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term top waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/asciiart/dune000066400000000000000000000001601366433625400202040ustar00rootroot00000000000000(executable (name asciiart) (libraries lambda-term camlimages.png camlimages.jpeg)) lambda-term-3.1.0/examples/buttons.ml000066400000000000000000000023501366433625400175620ustar00rootroot00000000000000(* * buttons.ml * ---------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget let main () = let waiter, wakener = wait () in let vbox = new vbox in let button = new button ~brackets:("[ ", " ]") "exit退出" in let label = new label "_" in button#on_click (wakeup wakener); vbox#add button; vbox#add label; for i = 0 to 2 do let hbox = new hbox in let button i = let button = new button ("button按钮" ^ string_of_int i) in button#on_click (fun () -> label#set_text (string_of_int i)); button in hbox#add (button (i * 3 + 1)); hbox#add ~expand:false (new vline); hbox#add (button (i * 3 + 2)); hbox#add ~expand:false (new vline); hbox#add (button (i * 3 + 3)); vbox#add ~expand:false (new hline); vbox#add hbox done; let frame = new frame in frame#set vbox; frame#set_label ~alignment:LTerm_geom.H_align_center "Button test按钮测试"; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term frame waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/checkbuttons.ml000066400000000000000000000030411366433625400205560ustar00rootroot00000000000000(* * checkbuttons.ml * ---------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget let main () = let waiter, wakener = wait () in let vbox = new vbox in let checked_label = new label "" in let create_button n = new checkbutton ("button按钮" ^ (string_of_int n)) false in let checkbuttons = Array.init 9 create_button in let callback () = let new_label = ref "" in for i = 0 to 8 do if checkbuttons.(i)#state then new_label := !new_label ^ " " ^ string_of_int i else () done; checked_label#set_text !new_label in let button = new button "exit退出" in button#on_click (wakeup wakener); vbox#add ~expand:false button; vbox#add ~expand:false (new hline); let use_checkbutton n = let cb = checkbuttons.(n) in cb#on_click callback; cb in for i = 0 to 2 do let hbox = new hbox in hbox#add (use_checkbutton i); hbox#add ~expand:false (new vline); hbox#add (use_checkbutton (i + 3)); hbox#add ~expand:false (new vline); hbox#add (use_checkbutton (i + 6)); vbox#add ~expand:false hbox done; vbox#add ~expand:false (new hline); vbox#add ~expand:false checked_label; vbox#add (new t "glue") ; let frame = new frame in frame#set vbox; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term frame waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/clock.ml000066400000000000000000000016071366433625400171630ustar00rootroot00000000000000(* * clock.ml * -------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget let get_time () = let localtime = Unix.localtime (Unix.time ()) in Printf.sprintf "%02u:%02u:%02u" localtime.Unix.tm_hour localtime.Unix.tm_min localtime.Unix.tm_sec let main () = let waiter, wakener = wait () in let vbox = new vbox in let clock = new label (get_time ()) in let button = new button "exit退出" in vbox#add clock; vbox#add button; (* Update the time every second. *) ignore (Lwt_engine.on_timer 1.0 true (fun _ -> clock#set_text (get_time ()))); (* Quit when the exit button is clicked. *) button#on_click (wakeup wakener); (* Run in the standard terminal. *) Lazy.force LTerm.stdout >>= fun term -> run term vbox waiter let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/colors.ml000066400000000000000000000010651366433625400173670ustar00rootroot00000000000000(* * colors.ml * --------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_style open LTerm_text let () = let rec loop i = if i = 16 then Lwt.return () else LTerm.printls (eval [S(Printf.sprintf "color %d: " i); B_fg(index i); S"foreground"; E_fg; S" "; B_bg(index i); S"background"; E_bg]) >>= fun () -> loop (i + 1) in Lwt_main.run (loop 0) lambda-term-3.1.0/examples/colors_256.ml000066400000000000000000000007321366433625400177630ustar00rootroot00000000000000(* * colors_256.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_style open LTerm_text let () = let rec loop i = if i = 16 then Lwt.return () else LTerm.printls (eval [S(Printf.sprintf "color %d: " i); B_fg(index i); S"example"; E_fg]) >>= fun () -> loop (i + 1) in Lwt_main.run (loop 0) lambda-term-3.1.0/examples/double_editor.ml000066400000000000000000000041171366433625400207070ustar00rootroot00000000000000(* * double_editor.ml * ---------- * Copyright : (c) 2016, Fabian Bonk * Licence : BSD3 * * This file is a part of Lambda-Term. *) open LTerm_geom let ( >>= ) = Lwt.( >>= ) (* helper functions *) let make_key ?(ctrl = false) ?(meta = false) ?(shift = false) c = let code = match c with | `Char c -> LTerm_key.Char (CamomileLibrary.UChar.of_char c) | `Other key -> key in { LTerm_key.control = ctrl; meta; shift; code } let frame widget = let frame = new LTerm_widget.frame in frame#set widget; frame let main () = let waiter, wakener = Lwt.wait () in let ctrl_c = [make_key ~ctrl:true @@ `Char 'c'] in let tab = [make_key @@ `Other LTerm_key.Tab] in let quit = [LTerm_edit.Custom (Lwt.wakeup wakener)] in let vbox = new LTerm_widget.vbox in let top_editor = new LTerm_edit.edit () in let top_frame = frame top_editor in (* make bottom editor a fixed 10 rows in size *) let bottom_editor = new LTerm_edit.edit ~size:{ rows = 10; cols = 1 } () in (* changed my mind: make it 5 rows smaller *) bottom_editor#set_allocation { bottom_editor#allocation with row1 = bottom_editor#allocation.row1 - 5 }; let bottom_frame = frame bottom_editor in vbox#add top_frame; (* in versions before PR#42 this would either crash or make the bottom editor unusable *) vbox#add ~expand:false bottom_frame; (* exit on C-c *) top_editor#bind ctrl_c quit; bottom_editor#bind ctrl_c quit; let send_key key = LTerm_edit.Custom (fun () -> vbox#send_event @@ LTerm_event.Key (make_key key)) in (* switch editors on Tab *) top_editor#bind tab [send_key @@ `Other LTerm_key.Down]; bottom_editor#bind tab [send_key @@ `Other LTerm_key.Up]; let label = new LTerm_widget.label "Press Tab to switch between editors.\nPress C-c to exit." in vbox#add ~expand:false label; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> LTerm_widget.run term ~save_state:false ~load_resources:false vbox waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/dune000066400000000000000000000007701366433625400164140ustar00rootroot00000000000000(executables (names double_editor events colors colors_256 rgb move hello clock buttons focus scroll scroll_debug checkbuttons radiobuttons shell repl modal read_password read_yes_no editor) (libraries lambda-term str) (flags :standard -safe-string)) (alias (name all) (deps (glob_files *.exe))) (alias (name all.bc) (deps (glob_files *.bc))) lambda-term-3.1.0/examples/editor.ml000066400000000000000000000023141366433625400173520ustar00rootroot00000000000000(* * editor.ml * --------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile open Lwt let main () = let waiter, wakener = wait () in let hbox = new LTerm_widget.hbox in let frame = new LTerm_widget.frame in let editor = new LTerm_edit.edit () in let vscroll = new LTerm_widget.vscrollbar ~width:1 editor#vscroll in frame#set editor; hbox#add frame; hbox#add ~expand:false vscroll; (* Exit when the user presses C-x C-c *) editor#bind (let open LTerm_key in [ { control = true; meta = false; shift = false ; code = Char (UChar.of_char 'x') } ; { control = true; meta = false; shift = false ; code = Char (UChar.of_char 'c') } ]) [ LTerm_edit.Custom (fun () -> wakeup wakener ()) ]; Zed_edit.insert editor#context (Zed_rope.of_string @@ Zed_string.of_utf8 "\ This is a simple edition widget. Type C-x C-c to exit. "); Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> LTerm_widget.run term hbox waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/events.ml000066400000000000000000000014671366433625400174000ustar00rootroot00000000000000(* * events.ml * --------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* Show events read from the terminal *) open Lwt let rec loop term = LTerm.read_event term >>= fun ev -> Lwt_io.printl (LTerm_event.to_string ev) >>= fun () -> match ev with | LTerm_event.Key{ LTerm_key.code = LTerm_key.Escape; _ } -> return () | _ -> loop term let main () = Lwt_io.printl "press escape to exit" >>= fun () -> Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> LTerm.enter_raw_mode term >>= fun mode -> Lwt.finalize (fun () -> loop term) (fun () -> LTerm.leave_raw_mode term mode >>= fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/focus.ml000066400000000000000000000035021366433625400172030ustar00rootroot00000000000000(* * focus.ml * ---------- * Copyright : (c) 2016, Andy Ray * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget let mode = try Sys.argv.(1) with _ -> "none" let main () = let waiter, wakener = wait () in let vbox = new vbox in let top = new button mode in let leftright = new hbox in let left = new button "left" in let right = new button "right" in let glue = new t "glue" in leftright#add ~expand:false left; leftright#add glue; leftright#add ~expand:false right; let exit = new button "exit" in exit#on_click (wakeup wakener); vbox#add top; vbox#add ~expand:false leftright; vbox#add ~expand:false exit; (* we have a layout like [ top ] [l][...........][r] [ exit ] Focus will start in 'top'. With no focus specifications when we press down focus will move to exit. There's no way to get to the 'left'/'right' buttons. This is because lambda-term will search in a line down from the centre of top, through the 'glue' and hit exit. We can fix this two ways. In the "set" mode when 'top' is focussed and down is pressed we jump to 'left'. In "glue" mode when we search down though the 'glue' widget it points to the 'right' button and we jump there. Finally, in "error" mode an exception is raised as focus is set to a widget with can_focus=false. *) begin match mode with | "set" -> top#set_focus { top#focus with LTerm_geom.down = Some(left :> t) } | "glue" -> glue#set_focus { glue#focus with LTerm_geom.down = Some(right :> t) } | "error" -> top#set_focus { top#focus with LTerm_geom.left = Some(glue :> t) } | _ -> () end; Lazy.force LTerm.stdout >>= fun term -> run term vbox waiter let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/hello.ml000066400000000000000000000016251366433625400171730ustar00rootroot00000000000000(* * hello.ml * -------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt let main () = (* Create a thread waiting for escape to be pressed. *) let waiter, wakener = wait () in (* Create the UI. *) let vbox = new LTerm_widget.vbox in vbox#add (new LTerm_widget.label "Hello, world!"); vbox#add (new LTerm_widget.label "你好，世界！"); vbox#add (new LTerm_widget.label "ハロー・ワールド"); vbox#add (new LTerm_widget.label "안녕, 세계!"); vbox#add (new LTerm_widget.label "Press escape to exit."); vbox#on_event (function | LTerm_event.Key { LTerm_key.code = LTerm_key.Escape; _ } -> wakeup wakener (); true | _ -> false); (* Run. *) Lazy.force LTerm.stdout >>= fun term -> LTerm_widget.run term vbox waiter let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/modal.ml000066400000000000000000000024261366433625400171640ustar00rootroot00000000000000open LTerm_widget let main () = let do_run, push_layer, pop_layer, exit = prepare_simple_run () in let vbox = new vbox in let button = new button "exit" in button#on_click exit; vbox#add button; let change = new button "change counter" in vbox#add change; let counter = ref 42 in let label = new label "" in let update_label () = label#set_text ("Counter: " ^ (string_of_int !counter)) in vbox#add label; update_label (); let change_counter d = fun () -> counter := !counter + d; update_label () in let frame = new frame in frame#set vbox; (* Layer 2 *) let layer2 = new modal_frame in let vbox' = new vbox in layer2#set vbox'; let message = new label "This is a new modal layer.\nPress 'close' to close it." in vbox'#add message; vbox'#add (new hline); let increment = new button "increment counter" in let decrement = new button "decrement counter" in increment#on_click (change_counter 1); decrement#on_click (change_counter (-1)); vbox'#add increment; vbox'#add decrement; vbox'#add (new hline); let close = new button "close" in close#on_click pop_layer; vbox'#add close; (* set 'change' button to open modal layer *) change#on_click (push_layer layer2); do_run frame let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/move.ml000066400000000000000000000035121366433625400170330ustar00rootroot00000000000000(* * move.ml * ------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_geom open LTerm_text open LTerm_key let rec loop ui coord = LTerm_ui.wait ui >>= function | LTerm_event.Key{ code = Up; _ } -> coord := { !coord with row = !coord.row - 1 }; LTerm_ui.draw ui; loop ui coord | LTerm_event.Key{ code = Down; _ } -> coord := { !coord with row = !coord.row + 1 }; LTerm_ui.draw ui; loop ui coord | LTerm_event.Key{ code = Left; _ } -> coord := { !coord with col = !coord.col - 1 }; LTerm_ui.draw ui; loop ui coord | LTerm_event.Key{ code = Right; _ } -> coord := { !coord with col = !coord.col + 1 }; LTerm_ui.draw ui; loop ui coord | LTerm_event.Key{ code = Escape; _ } -> return () | _ -> loop ui coord let draw ui matrix coord = let size = LTerm_ui.size ui in let ctx = LTerm_draw.context matrix size in LTerm_draw.clear ctx; LTerm_draw.draw_frame_labelled ctx { row1 = 0; col1 = 0; row2 = size.rows; col2 = size.cols } ~alignment:H_align_center (Zed_string.of_utf8 "Use arrow keys to move text 文字") LTerm_draw.Light; if size.rows > 2 && size.cols > 2 then begin let ctx = LTerm_draw.sub ctx { row1 = 1; col1 = 1; row2 = size.rows - 1; col2 = size.cols - 1 } in LTerm_draw.draw_styled ctx coord.row coord.col (eval [B_fg LTerm_style.lblue; S "Move m̀é 囧"; E_fg]) end let main () = Lazy.force LTerm.stdout >>= fun term -> (* Coordinates of the message. *) let coord = ref { row = 0; col = 0 } in LTerm_ui.create term (fun matrix size -> draw matrix size !coord) >>= fun ui -> Lwt.finalize (fun () -> loop ui coord) (fun () -> LTerm_ui.quit ui) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/radiobuttons.ml000066400000000000000000000037161366433625400206100ustar00rootroot00000000000000(* * radiobuttons.ml *) open Lwt open LTerm_widget let main () = let waiter, wakener = wait () in let vbox = new vbox in let result_int = (new label "1") in let result_string = (new label "foo") in let group_int = new radiogroup in let group_string = new radiogroup in let callback_int = function | Some n -> result_int#set_text (string_of_int n) | None -> () in let callback_string = function | Some s -> result_string#set_text s | None -> () in group_int#on_state_change callback_int; group_string#on_state_change callback_string; let button = new button "exit" in button#on_click (wakeup wakener); vbox#add ~expand:false button; vbox#add ~expand:false (new hline); let button = new button "reset radiobuttons" in let reset = fun () -> group_int#switch_to 1; group_string#switch_to "foo" in button#on_click reset; vbox#add ~expand:false button; vbox#add ~expand:false (new hline); let hbox = new hbox in hbox#add (new radiobutton group_int "Number 1" 1); hbox#add ~expand:false (new vline); hbox#add (new radiobutton group_string "String 'foo'" "foo"); vbox#add ~expand:false hbox; let hbox = new hbox in hbox#add (new radiobutton group_int "Number 2" 2); hbox#add ~expand:false (new vline); hbox#add (new radiobutton group_string "String 'bar'" "bar"); vbox#add ~expand:false hbox; let hbox = new hbox in hbox#add (new radiobutton group_int "Number 3" 3); hbox#add ~expand:false (new vline); hbox#add (new radiobutton group_string "String 'baz'" "baz"); vbox#add ~expand:false hbox; vbox#add ~expand:false (new hline); vbox#add ~expand:false result_int; vbox#add ~expand:false result_string; vbox#add (new t "glue") ; let frame = new frame in frame#set vbox; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term frame waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/read_password.ml000066400000000000000000000015661366433625400207310ustar00rootroot00000000000000(* * read_password.ml * ---------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* Read a password and display it. *) open Lwt_react let ( >>= ) = Lwt.( >>= ) class read_password term = object(self) inherit LTerm_read_line.read_password () as super inherit [Zed_string.t] LTerm_read_line.term term method! send_action = function | LTerm_read_line.Break -> (* Ignore Ctrl+C *) () | action -> super#send_action action initializer self#set_prompt (S.const (LTerm_text.of_utf8 "Type a password: ")) end let main () = LTerm_inputrc.load () >>= fun () -> Lazy.force LTerm.stdout >>= fun term -> (new read_password term)#run >>= fun password -> Lwt_io.printlf "You typed %S" (Zed_string.to_utf8 password) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/read_yes_no.ml000066400000000000000000000024301366433625400203520ustar00rootroot00000000000000(* * read_yes_no.ml * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt let rec read_char term = LTerm.read_event term >>= function | LTerm_event.Key { LTerm_key.code = LTerm_key.Char ch; LTerm_key.control = true ; _ } when ch = CamomileLibraryDefault.Camomile.UChar.of_char 'c' -> (* Exit on Ctrl+C *) Lwt.fail (Failure "interrupted") | LTerm_event.Key { LTerm_key.code = LTerm_key.Char ch ; _ } -> Lwt.return ch | _ -> read_char term let rec read_yes_no term = LTerm.fprint term "Do you accept (y/n) ? " >>= fun () -> read_char term >|= Zed_utf8.singleton >>= fun ch -> LTerm.fprintl term ch >>= fun () -> match ch with | "y" -> return true | "n" -> return false | _ -> LTerm.fprintl term "Please enter 'y' or 'n'!" >>= fun () -> read_yes_no term let main () = Lazy.force LTerm.stdout >>= fun term -> LTerm.enter_raw_mode term >>= fun mode -> Lwt.finalize (fun () -> read_yes_no term >>= function | true -> LTerm.fprintl term "You accepted." | false -> LTerm.fprintl term "You did not accept.") (fun () -> LTerm.leave_raw_mode term mode) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/repl.ml000066400000000000000000000061421366433625400170310ustar00rootroot00000000000000(* * repl.ml * -------- * Copyright : (c) 2015, Martin DeMello * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* Add a REPL to an existing interpreter *) open React open Lwt open LTerm_text (* +-----------------------------------------------------------------+ | Interpreter | +-----------------------------------------------------------------+ *) (* A simple model of an interpreter. It maintains some state, and exposes a function * eval : state -> input -> (new_state, output) *) module Interpreter = struct type state = { n : int } let eval state s = let out = "evaluated " ^ s in let new_state = { n = state.n + 1 } in (new_state, out) end (* +-----------------------------------------------------------------+ | Prompt and output wrapping | +-----------------------------------------------------------------+ *) (* Create a prompt based on the current interpreter state *) let make_prompt state = let prompt = Printf.sprintf "In [%d]: " state.Interpreter.n in eval [ S prompt ] (* Format the interpreter output for REPL display *) let make_output state out = let output = Printf.sprintf "Out [%d]: %s" state.Interpreter.n out in eval [ S output ] (* +-----------------------------------------------------------------+ | Customization of the read-line engine | +-----------------------------------------------------------------+ *) class read_line ~term ~history ~state = object(self) inherit LTerm_read_line.read_line ~history () inherit [Zed_string.t] LTerm_read_line.term term method! show_box = false initializer self#set_prompt (S.const (make_prompt state)) end (* +-----------------------------------------------------------------+ | Main loop | +-----------------------------------------------------------------+ *) let rec loop term history state = Lwt.catch (fun () -> let rl = new read_line ~term ~history:(LTerm_history.contents history) ~state in rl#run >|= fun command -> Some command) (function | Sys.Break -> return None | exn -> Lwt.fail exn) >>= function | Some command -> let command_utf8= Zed_string.to_utf8 command in let state, out = Interpreter.eval state command_utf8 in LTerm.fprintls term (make_output state out) >>= fun () -> LTerm_history.add history command; loop term history state | None -> loop term history state (* +-----------------------------------------------------------------+ | Entry point | +-----------------------------------------------------------------+ *) let main () = LTerm_inputrc.load () >>= fun () -> Lwt.catch (fun () -> let state = { Interpreter.n = 1 } in Lazy.force LTerm.stdout >>= fun term -> loop term (LTerm_history.create []) state) (function | LTerm_read_line.Interrupt -> Lwt.return () | exn -> Lwt.fail exn) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/rgb.ml000066400000000000000000000013011366433625400166310ustar00rootroot00000000000000(* * rgb.ml * ------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_style open LTerm_text let main () = if Array.length Sys.argv <> 4 then begin LTerm.eprintlf "usage: %s " (Filename.basename Sys.executable_name) >>= fun () -> exit 2 end else begin let r = int_of_string Sys.argv.(1) and g = int_of_string Sys.argv.(2) and b = int_of_string Sys.argv.(3) in LTerm.printls (eval [S(Printf.sprintf "color with component (%d, %d, %d): " r g b); B_fg(rgb r g b); S"example"; E_fg]) end let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/scroll.ml000066400000000000000000000034241366433625400173650ustar00rootroot00000000000000(* * scroll.ml * ---------- * Copyright : (c) 2016, Andy Ray * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget open LTerm_geom (* a simple widget with scrollbar support *) class scrollable_nums (scroll : scrollable) = object inherit t "nums" initializer scroll#set_range 197 method! can_focus = false method! draw ctx _focused = let { rows; _ } = LTerm_draw.size ctx in for row=0 to rows-1 do LTerm_draw.draw_string ctx row 0 (Zed_string.of_utf8 (string_of_int (row + scroll#offset))) done end let main () = let waiter, wakener = wait () in let exit = new button "exit" in exit#on_click (wakeup wakener); let adj = new scrollable in let scroll = new vscrollbar adj in let nums = new scrollable_nums adj in let hbox = new hbox in hbox#add ~expand:true nums; hbox#add ~expand:false scroll; (* buttons to set scroll offset *) let prev = new button "prev" in prev#on_click (fun () -> adj#set_offset (adj#offset-1)); let next = new button "next" in next#on_click (fun () -> adj#set_offset (adj#offset+1)); let decr = new button "decr" in decr#on_click (fun () -> adj#set_offset adj#decr); let incr = new button "incr" in incr#on_click (fun () -> adj#set_offset adj#incr); adj#on_offset_change (fun _ -> scroll#queue_draw); let vbox = new vbox in vbox#add hbox; vbox#add ~expand:false (new hline); vbox#add ~expand:false prev; vbox#add ~expand:false next; vbox#add ~expand:false decr; vbox#add ~expand:false incr; vbox#add ~expand:false exit; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term vbox waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/scroll_debug.ml000066400000000000000000000073221366433625400205340ustar00rootroot00000000000000(* * scroll_debug.ml * ---------- * Copyright : (c) 2016, Andy Ray * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt open LTerm_widget open LTerm_geom class scroll_label scroll = object inherit label "scroll" method! can_focus = false method! size_request = { rows=1; cols=0 } val style = LTerm_style.{none with foreground = Some red; background = Some green }; method! draw ctx _focused = LTerm_draw.fill_style ctx style; LTerm_draw.draw_string_aligned ctx 0 H_align_center ~style (Zed_string.of_utf8 (Printf.sprintf "%i/%i" scroll#offset scroll#range)) end let main () = let waiter, wakener = wait () in let exit = new button "exit" in exit#on_click (wakeup wakener); let vbox = new vbox in let add_scroll (vbox : vbox) ~range ~size = let adj = new scrollable in let hscroll = new hscrollbar adj in let label = new scroll_label adj in adj#set_range range; adj#set_mouse_mode `middle; adj#set_scroll_bar_mode (`fixed size); vbox#add ~expand:false (label :> t); vbox#add ~expand:false (new hline); vbox#add ~expand:false (hscroll :> t); vbox#add ~expand:false (new hline); adj in let scrolls = List.map (fun range -> add_scroll vbox ~range ~size:1) [ 0; 10; 30; 60; 100; 200; 1000 ] in let mouse_mode = let vbox = new vbox in let mouse_mode = new radiogroup in mouse_mode#on_state_change (function | None -> () | Some(m) -> List.iter (fun h -> h#set_mouse_mode m) scrolls); vbox#add ~expand:false (new label "mouse mode"); vbox#add ~expand:false (new radiobutton mouse_mode "middle" `middle); vbox#add ~expand:false (new radiobutton mouse_mode "ratio" `ratio); vbox#add ~expand:false (new radiobutton mouse_mode "auto" `auto); vbox#add ~expand:true (new spacing ()); vbox in let scroll_mode = let vbox = new vbox in let scroll_mode = new radiogroup in let ranged_widget group name value range = let button = new radiobutton group name value in let scroll = new hslider range in button, scroll in vbox#add ~expand:false (new label "scroll mode"); let f,fr = ranged_widget scroll_mode "fixed " `fixed 10 in let d,dr = ranged_widget scroll_mode "dynamic " `dynamic 10 in let sbox = let in_frame w = let f = new frame in f#set w; f in let v1 = new vbox in v1#add ~expand:true f; v1#add ~expand:true d; let v2 = new vbox in v2#add ~expand:false (in_frame fr); v2#add ~expand:false (in_frame dr); let h = new hbox in h#add ~expand:false v1; h#add ~expand:false v2; h in vbox#add ~expand:false sbox; let set_mode f o = List.iter (fun h -> h#set_scroll_bar_mode (f o)) scrolls in let fixed o = `fixed ((o*5)+1) in let dynamic o = `dynamic (o*50) in scroll_mode#on_state_change (function | None -> () | Some(`fixed) -> set_mode fixed fr#offset | Some(`dynamic) -> set_mode dynamic dr#offset ); fr#on_offset_change (fun o -> if f#state then set_mode fixed o); dr#on_offset_change (fun o -> if d#state then set_mode dynamic o); vbox in let hbox = new hbox in hbox#add (new spacing ()); hbox#add ~expand:false mouse_mode; hbox#add (new spacing ()); hbox#add ~expand:false scroll_mode; hbox#add (new spacing ()); vbox#add ~expand:true (new spacing ()); vbox#add ~expand:false hbox; vbox#add ~expand:true (new spacing ()); vbox#add ~expand:false exit; Lazy.force LTerm.stdout >>= fun term -> LTerm.enable_mouse term >>= fun () -> Lwt.finalize (fun () -> run term vbox waiter) (fun () -> LTerm.disable_mouse term) let () = Lwt_main.run (main ()) lambda-term-3.1.0/examples/shell.ml000066400000000000000000000134011366433625400171720ustar00rootroot00000000000000(* * shell.ml * -------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* A mini shell *) open CamomileLibraryDefault.Camomile open React open Lwt open LTerm_style open LTerm_text open LTerm_geom (* +-----------------------------------------------------------------+ | Prompt creation | +-----------------------------------------------------------------+ *) (* The function [make_prompt] creates the prompt. Parameters are: - size: the current size of the terminal. - exit_code: the exit code of the last executed command. - time: the current time. *) let make_prompt size exit_code time = let tm = Unix.localtime time in let code = string_of_int exit_code in (* Replace the home directory by "~" in the current path. *) let path = Sys.getcwd () in let path = try let home = Sys.getenv "HOME" in if Zed_utf8.starts_with path home then Zed_utf8.replace path 0 (Zed_utf8.length home) "~" else path with Not_found -> path in (* Shorten the path if it is too large for the size of the terminal. *) let path_len = Zed_utf8.length path in let size_for_path = size.cols - 24 - Zed_utf8.length code in let path = if path_len > size_for_path then if size_for_path >= 2 then ".." ^ Zed_utf8.after path (path_len - size_for_path + 2) else path else path in eval [ B_bold true; B_fg lcyan; S"─( "; B_fg lmagenta; S(Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg; S" )─< "; B_fg lyellow; S path; E_fg; S" >─"; S(Zed_utf8.make (size.cols - 24 - Zed_utf8.length code - Zed_utf8.length path) (UChar.of_int 0x2500)); S"[ "; B_fg(if exit_code = 0 then lwhite else lred); S code; E_fg; S" ]─"; E_fg; S"\n"; B_fg lred; S(try Sys.getenv "USER" with Not_found -> ""); E_fg; B_fg lgreen; S"@"; E_fg; B_fg lblue; S(Unix.gethostname ()); E_fg; B_fg lgreen; S" $ "; E_fg; E_bold; ] (* +-----------------------------------------------------------------+ | Listing binaries of the path for completion | +-----------------------------------------------------------------+ *) module String_set = Set.Make(String) let colon_re = Str.regexp ":" let get_paths () = try Str.split colon_re (Sys.getenv "PATH") with Not_found -> [] (* Get the set of all binaries with a name starting with [prefix]. *) let get_binaries () = Lwt_list.fold_left_s (fun set dir -> Lwt.catch (fun () -> Lwt_stream.fold (fun file set -> if file <> "." && file <> ".." then String_set.add file set else set) (Lwt_unix.files_of_directory dir) set) (function | Unix.Unix_error _ -> return set | exn -> Lwt.fail exn)) String_set.empty (get_paths ()) >|= String_set.elements >|= List.map Zed_string.unsafe_of_utf8 (* +-----------------------------------------------------------------+ | Customization of the read-line engine | +-----------------------------------------------------------------+ *) (* Signal updated every second with the current time. *) let time = let time, set_time = S.create (Unix.time ()) in (* Update the time every second. *) ignore (Lwt_engine.on_timer 1.0 true (fun _ -> set_time (Unix.time ()))); time class read_line ~term ~history ~exit_code ~binaries = object(self) inherit LTerm_read_line.read_line ~history () inherit [Zed_string.t] LTerm_read_line.term term method! completion = let prefix = Zed_rope.to_string self#input_prev in let binaries = List.filter (fun file -> Zed_string.starts_with ~prefix file) binaries in self#set_completion 0 (List.map (fun file -> (file, Zed_string.unsafe_of_utf8 " ")) binaries) initializer self#set_prompt (S.l2 (fun size time -> make_prompt size exit_code time) self#size time) end (* +-----------------------------------------------------------------+ | Main loop | +-----------------------------------------------------------------+ *) let rec loop term history exit_code = get_binaries () >>= fun binaries -> Lwt.catch (fun () -> (new read_line ~term ~history:(LTerm_history.contents history) ~exit_code ~binaries)#run >|= fun command -> Some command) (function | Sys.Break -> return None | exn -> Lwt.fail exn) >>= function | Some command -> let command_utf8= Zed_string.to_utf8 command in Lwt.catch (fun () -> Lwt_process.exec (Lwt_process.shell command_utf8)) (function | Unix.Unix_error (Unix.ENOENT, _, _) -> LTerm.fprintls term (eval [B_fg lred; S "command not found"]) >>= fun () -> Lwt.return (Unix.WEXITED 127) | exn -> Lwt.fail exn) >>= fun status -> LTerm_history.add history command; loop term history (match status with | Unix.WEXITED code -> code | Unix.WSIGNALED code -> code | Unix.WSTOPPED code -> code) | None -> loop term history 130 (* +-----------------------------------------------------------------+ | Entry point | +-----------------------------------------------------------------+ *) let main () = LTerm_inputrc.load () >>= fun () -> Lwt.catch (fun () -> Lazy.force LTerm.stdout >>= fun term -> loop term (LTerm_history.create []) 0) (function | LTerm_read_line.Interrupt -> Lwt.return () | exn -> Lwt.fail exn) let () = Lwt_main.run (main ()) lambda-term-3.1.0/lambda-term-inputrc000066400000000000000000000023421366433625400175070ustar00rootroot00000000000000# -*- conf-colon -*- # Copy this file to your ~/.config/.lambda-term-inputrc [read-line] # Read-line only key bindings [edit] # General key bindings # Each line is of the form: # # : # # where is a list of keys in emacs style. For example # to bind Control+w to cut the word before the cursor, write: # # C-w: kill-prev-word # # may contains several action. For example, to insert # "Hello, world!" when pressing Control+h, write: # # C-h: insert(H), insert(e), insert(l), insert(l), insert(o), insert(,), insert( ), insert(w), insert(o), insert(r), insert(l), insert(d), insert(!) # # Note that in keys and actions, lambda-term recognize only ascii # character, if you want to use non-ascii ones, you must write them # U+. For example to bind Control+é to inserting "É", # write: # # C-U+e9: insert(U+c9) # # For a list of possible actions, run the command # "lambda-term-actions". # # This file is divided in sections, and each section refer to a # particular set of key bindings. There is two sections: [edit] and # [read-line]. The [edit] section is for key bindings that apply # everywhere, and the [read-line] section is for key bindings that # apply only in read-line. lambda-term-3.1.0/lambda-term.descr000066400000000000000000000010311366433625400171160ustar00rootroot00000000000000Terminal manipulation library for OCaml Lambda-term is a cross-platform library for manipulating the terminal. It provides an abstraction for keys, mouse events, colors, as well as a set of widgets to write curses-like applications. The main objective of lambda-term is to provide a higher level functional interface to terminal manipulation than, for example, ncurses, by providing a native OCaml interface instead of bindings to a C library. Lambda-term integrates with zed to provide text edition facilities in console applications. lambda-term-3.1.0/lambda-term.opam000066400000000000000000000022251366433625400167600ustar00rootroot00000000000000opam-version: "2.0" maintainer: "jeremie@dimino.org" authors: ["Jérémie Dimino"] homepage: "https://github.com/ocaml-community/lambda-term" bug-reports: "https://github.com/ocaml-community/lambda-term/issues" dev-repo: "git://github.com/ocaml-community/lambda-term.git" license: "BSD3" build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] depends: [ "ocaml" {>= "4.02.3"} "lwt" {>= "4.0.0"} "lwt_log" "react" "zed" {>= "3.0.0" & < "4.0"} "camomile" {>= "1.0.1"} "lwt_react" "mew_vi" {>= "0.5.0" & < "0.6.0"} "dune" {>= "1.1.0"} ] synopsis: "Terminal manipulation library for OCaml" description: """ Lambda-term is a cross-platform library for manipulating the terminal. It provides an abstraction for keys, mouse events, colors, as well as a set of widgets to write curses-like applications. The main objective of lambda-term is to provide a higher level functional interface to terminal manipulation than, for example, ncurses, by providing a native OCaml interface instead of bindings to a C library. Lambda-term integrates with zed to provide text edition facilities in console applications.""" lambda-term-3.1.0/lambda-termrc000066400000000000000000000013171366433625400163530ustar00rootroot00000000000000button.focused.foreground: lyellow button.focused.background: blue checkbutton.focused.foreground: lyellow checkbutton.focused.background: blue radiobutton.focused.foreground: lyellow radiobutton.focused.background: blue scrollbar.focused.foreground: lyellow scrollbar.focused.background: blue scrollbar.barstyle: outline scrollbar.track: false slider.focused.foreground: lyellow slider.focused.background: blue slider.barstyle: filled slider.track: true ! ! For monochrome experience comment out the resources above and uncomment two ! following lines: ! !button.focused.reverse: true !checkbutton.focused.reverse: true !radiobutton.focused.reverse: true !scrollbar.focused.reverse: true !slider.focused.reverse: true lambda-term-3.1.0/man/000077500000000000000000000000001366433625400144675ustar00rootroot00000000000000lambda-term-3.1.0/man/dune000066400000000000000000000001261366433625400153440ustar00rootroot00000000000000(install (section man) (files lambda-term-actions.1 lambda-term-inputrc.5)) lambda-term-3.1.0/man/lambda-term-actions.1000066400000000000000000000010421366433625400203710ustar00rootroot00000000000000\" lambda-term-actions.1 \" --------------------- \" Copyright : (c) 2011, Jeremie Dimino \" Licence : BSD3 \" \" This file is a part of Lambda-Term. .TH LAMBDA-TERM-ACTIONS 1 "August 2011" .SH NAME lambda-term-actions \- Display lambda-term editing actions .SH SYNOPSIS .B lambda-term-actions .SH DESCRIPTION .B lambda-term-actions displays the list of actions that can be used in the ~/.config/.lambda-term-inputrc file. .SH AUTHOR Jérémie Dimino .SH "SEE ALSO" .BR lambda-term-inputrc (5). lambda-term-3.1.0/man/lambda-term-inputrc.5000066400000000000000000000042571366433625400204340ustar00rootroot00000000000000\" lambda-term-inputrc.5 \" --------------------- \" Copyright : (c) 2011, Jeremie Dimino \" Licence : BSD3 \" \" This file is a part of Lambda-Term. .TH LAMBDA-TERM-INPUTRC 5 "August 2011" .SH NAME lambda-term-inputrc \- Key bindings for lambda-term applications .SH SYNOPSIS .B ~/.config/.lambda-term-inputrc .SH DESCRIPTION This manual page describes the format of the .I ~/.config/.lambda-term-inputrc file. This file is a text file which associates editing actions to key sequences. Comments start with a '#' character and empty lines are ignored. Bindings are of the form: : Where .I is a sequence of keys in the emacs format. For example Control+w is written "C-w", Control+Meta+x followed by "e" is written "C-M-x e". .I is a list of editing actions separeted by commas. The list of all available actions with a short description can be obtained by running the command .BR lambda-term-actions (1) in a terminal. The file is divided in two section, the .B [edit] section and the .B [read-line] section. The first one is for key bindings that apply everyhere and the second for key bindings that apply only in read-line. Here is an example of bindings: [read-line] C-w: kill-prev-word M-!: play-macro In addition to letters and symbols the following keys can be used: * enter * escape * tab * up * down * left * right * f1 * f2 * f3 * f4 * f5 * f6 * f7 * f8 * f9 * f10 * f11 * f12 * next * prev * home * end * insert * delete * backspace Note that lambda-term accept only ascii characters in the configuration file, to use other unicode character you must use the notation .I U+ where .I is the code of the character in hexadecimal. .SH FILES .I ~/.config/.lambda-term-inputrc .SH EXAMPLE [edit] C-e: play-macro [read-line] C-left: complete-bar-prev C-right: complete-bar-next .SH AUTHOR Jérémie Dimino .SH "SEE ALSO" .BR lambda-term-actions (1). lambda-term-3.1.0/print_sequences.ml000066400000000000000000000024341366433625400174600ustar00rootroot00000000000000(* * print_sequences.ml * ------------------ * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* Script to print sequences returned by the terminal. You can execute it like this: # ocaml print_sequences.ml *) #load "unix.cma";; let () = (* Setup terminal attributes. *) let attr = Unix.tcgetattr Unix.stdin in Unix.tcsetattr Unix.stdin Unix.TCSAFLUSH { attr with Unix.c_brkint = false; Unix.c_inpck = false; Unix.c_istrip = false; Unix.c_ixon = false; Unix.c_csize = 8; Unix.c_parenb = false; Unix.c_echo = false; Unix.c_icanon = false; Unix.c_vmin = 1; Unix.c_vtime = 0; Unix.c_isig = false; }; (* Read and print key sequences. *) print_endline "press 'q' to quit"; let buf = Bytes.create 128 in let rec loop () = let n = Unix.read Unix.stdin buf 0 (Bytes.length buf) in let s = Bytes.to_string (Bytes.sub buf 0 n) in print_endline (String.escaped s); if s <> "q" then loop () in let result = try loop (); `OK with exn -> `Exn exn in (* Reset terminal attributes. *) Unix.tcsetattr Unix.stdin Unix.TCSAFLUSH attr; match result with | `OK -> () | `Exn exn -> raise exn lambda-term-3.1.0/src/000077500000000000000000000000001366433625400145035ustar00rootroot00000000000000lambda-term-3.1.0/src/config/000077500000000000000000000000001366433625400157505ustar00rootroot00000000000000lambda-term-3.1.0/src/config/gen.ml000066400000000000000000000014121366433625400170510ustar00rootroot00000000000000let write fn s = let oc = open_out fn in output_string oc s; close_out oc let () = let ic = open_in "ocamlc-config" in let rec loop acc = match input_line ic with | exception End_of_file -> close_in ic; acc | line -> loop (Scanf.sscanf line "%[^:]: %s" (fun a b -> (a, b)) :: acc) in let config = loop [] in let system = List.assoc "system" config in Printf.ksprintf (write "lTerm_config.h") "\ #ifndef __LTERM_CONFIG_H #define __LTERM_CONFIG_H #define SYS_%s #endif /* __LTERM_CONFIG_H */ " system; if system = "openbsd" then begin write "c_flags" "(-I/usr/local/include)"; write "c_library_flags" "(-L/usr/local/lib -lcharset)" end else begin write "c_flags" "()"; write "c_library_flags" "()" end lambda-term-3.1.0/src/dune000066400000000000000000000012131366433625400153560ustar00rootroot00000000000000(library (name lambda_term) (public_name lambda-term) (wrapped false) (libraries lwt lwt.unix lwt_react zed lwt_log mew_vi) (flags (:standard -safe-string)) (synopsis "Cross-platform library for terminal manipulation") (c_names lTerm_term_stubs lTerm_unix_stubs lTerm_windows_stubs) (c_flags (:standard (:include c_flags))) (c_library_flags (:standard (:include c_library_flags))) ) (ocamllex lTerm_inputrc lTerm_resource_lexer) (rule (targets c_flags c_library_flags lTerm_config.h) (deps ocamlc-config) (action (run %{ocaml} %{dep:config/gen.ml}))) (rule (with-stdout-to ocamlc-config (run %{ocamlc} -config))) lambda-term-3.1.0/src/gen/000077500000000000000000000000001366433625400152545ustar00rootroot00000000000000lambda-term-3.1.0/src/gen/gen_color_mappings.ml000066400000000000000000000233421366433625400214570ustar00rootroot00000000000000(* * gen_color_mappings.ml * --------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* This program generates the contents of the file lTerm_color_mappings.ml which contains tables used to convert RGB colors to indexes. *) (* +-----------------------------------------------------------------+ | Mapping generation | +-----------------------------------------------------------------+ *) type map = { count_r : int; count_g : int; count_b : int; index_r : string; index_g : string; index_b : string; map : string; } module Int_set = Set.Make(struct type t = int let compare x y = x - y end) let reindex set = let indexes = String.make 256 '\x00' in let rec loop idx prev = function | [] -> for i = prev to 255 do indexes.[i] <- char_of_int idx done; indexes | next :: rest -> let middle = (prev + next) / 2 in for i = prev to middle do indexes.[i] <- char_of_int idx done; let idx = idx + 1 in for i = middle + 1 to next - 1 do indexes.[i] <- char_of_int idx done; loop idx next rest in match Int_set.elements set with | [] -> assert false | n :: rest -> loop 0 n rest let pi = 4. *. atan 1. let hsv_of_rgb (r, g, b) = let r = float r /. 255. and g = float g /. 255. and b = float b /. 255. in let min = min r (min g b) and max = max r (max g b) in let h = if min = max then 0. else if max = r then mod_float (60. *. (g -. b) /. (max -. min) +. 360.) 360. else if max = g then 60. *. (b -. r) /. (max -. min) +. 120. else 60. *. (r -. g) /. (max -. min) +. 240. and s = if max = 0. then 0. else 1. -. min /. max and v = max in (h *. pi /. 180., s, v) let sqr x = x *. x let dist color1 color2 = let (h1, s1, v1) = hsv_of_rgb color1 and (h2, s2, v2) = hsv_of_rgb color2 in let x1 = s1 *. cos h1 and y1 = s1 *. sin h1 and z1 = v1 in let x2 = s2 *. cos h2 and y2 = s2 *. sin h2 and z2 = v2 in sqr (x1 -. x2) +. sqr (y1 -. y2) +. sqr (z1 -. z2) let make_map start colors = let rec loop idx acc = function | [] -> acc | n :: rest -> loop (idx + 1) ((idx, ((n lsr 16) land 0xff, (n lsr 8) land 0xff, n land 0xff)) :: acc) rest in let colors = loop start [] colors in let set_r, set_g, set_b = List.fold_left (fun (set_r, set_g, set_b) (idx, (r, g, b)) -> (Int_set.add r set_r, Int_set.add g set_g, Int_set.add b set_b)) (Int_set.empty, Int_set.empty, Int_set.empty) colors in let count_r = Int_set.cardinal set_r and count_g = Int_set.cardinal set_g and count_b = Int_set.cardinal set_b and index_r = reindex set_r and index_g = reindex set_g and index_b = reindex set_b and value_r = Array.of_list (Int_set.elements set_r) and value_g = Array.of_list (Int_set.elements set_g) and value_b = Array.of_list (Int_set.elements set_b) in let map = String.make (count_r * count_g * count_b) '\x00' in for ir = 0 to count_r - 1 do for ig = 0 to count_g - 1 do for ib = 0 to count_b - 1 do let color = (value_r.(ir), value_g.(ig), value_b.(ib)) in let rec loop min idx_of_min = function | [] -> idx_of_min | (idx, color') :: rest -> let d = dist color color' in if d < min then loop d idx rest else loop min idx_of_min rest in map.[ir + count_r * (ig + count_g * ib)] <- char_of_int (loop max_float 0 colors) done done done; { count_r; count_g; count_b; index_r; index_g; index_b; map } (* +-----------------------------------------------------------------+ | Color tables | +-----------------------------------------------------------------+ *) let colors_16 = make_map 0 [ 0x000000; 0xcd0000; 0x00cd00; 0xcdcd00; 0x0000ee; 0xcd00cd; 0x00cdcd; 0xe5e5e5; 0x7f7f7f; 0xff0000; 0x00ff00; 0xffff00; 0x5c5cff; 0xff00ff; 0x00ffff; 0xffffff; ] let colors_88 = make_map 16 [ 0x000000; 0x00008b; 0x0000cd; 0x0000ff; 0x008b00; 0x008b8b; 0x008bcd; 0x008bff; 0x00cd00; 0x00cd8b; 0x00cdcd; 0x00cdff; 0x00ff00; 0x00ff8b; 0x00ffcd; 0x00ffff; 0x8b0000; 0x8b008b; 0x8b00cd; 0x8b00ff; 0x8b8b00; 0x8b8b8b; 0x8b8bcd; 0x8b8bff; 0x8bcd00; 0x8bcd8b; 0x8bcdcd; 0x8bcdff; 0x8bff00; 0x8bff8b; 0x8bffcd; 0x8bffff; 0xcd0000; 0xcd008b; 0xcd00cd; 0xcd00ff; 0xcd8b00; 0xcd8b8b; 0xcd8bcd; 0xcd8bff; 0xcdcd00; 0xcdcd8b; 0xcdcdcd; 0xcdcdff; 0xcdff00; 0xcdff8b; 0xcdffcd; 0xcdffff; 0xff0000; 0xff008b; 0xff00cd; 0xff00ff; 0xff8b00; 0xff8b8b; 0xff8bcd; 0xff8bff; 0xffcd00; 0xffcd8b; 0xffcdcd; 0xffcdff; 0xffff00; 0xffff8b; 0xffffcd; 0xffffff; 0x2e2e2e; 0x5c5c5c; 0x737373; 0x8b8b8b; 0xa2a2a2; 0xb9b9b9; 0xd0d0d0; 0xe7e7e7; ] let colors_256 = make_map 16 [ 0x000000; 0x00005f; 0x000087; 0x0000af; 0x0000d7; 0x0000ff; 0x005f00; 0x005f5f; 0x005f87; 0x005faf; 0x005fd7; 0x005fff; 0x008700; 0x00875f; 0x008787; 0x0087af; 0x0087d7; 0x0087ff; 0x00af00; 0x00af5f; 0x00af87; 0x00afaf; 0x00afd7; 0x00afff; 0x00d700; 0x00d75f; 0x00d787; 0x00d7af; 0x00d7d7; 0x00d7ff; 0x00ff00; 0x00ff5f; 0x00ff87; 0x00ffaf; 0x00ffd7; 0x00ffff; 0x5f0000; 0x5f005f; 0x5f0087; 0x5f00af; 0x5f00d7; 0x5f00ff; 0x5f5f00; 0x5f5f5f; 0x5f5f87; 0x5f5faf; 0x5f5fd7; 0x5f5fff; 0x5f8700; 0x5f875f; 0x5f8787; 0x5f87af; 0x5f87d7; 0x5f87ff; 0x5faf00; 0x5faf5f; 0x5faf87; 0x5fafaf; 0x5fafd7; 0x5fafff; 0x5fd700; 0x5fd75f; 0x5fd787; 0x5fd7af; 0x5fd7d7; 0x5fd7ff; 0x5fff00; 0x5fff5f; 0x5fff87; 0x5fffaf; 0x5fffd7; 0x5fffff; 0x870000; 0x87005f; 0x870087; 0x8700af; 0x8700d7; 0x8700ff; 0x875f00; 0x875f5f; 0x875f87; 0x875faf; 0x875fd7; 0x875fff; 0x878700; 0x87875f; 0x878787; 0x8787af; 0x8787d7; 0x8787ff; 0x87af00; 0x87af5f; 0x87af87; 0x87afaf; 0x87afd7; 0x87afff; 0x87d700; 0x87d75f; 0x87d787; 0x87d7af; 0x87d7d7; 0x87d7ff; 0x87ff00; 0x87ff5f; 0x87ff87; 0x87ffaf; 0x87ffd7; 0x87ffff; 0xaf0000; 0xaf005f; 0xaf0087; 0xaf00af; 0xaf00d7; 0xaf00ff; 0xaf5f00; 0xaf5f5f; 0xaf5f87; 0xaf5faf; 0xaf5fd7; 0xaf5fff; 0xaf8700; 0xaf875f; 0xaf8787; 0xaf87af; 0xaf87d7; 0xaf87ff; 0xafaf00; 0xafaf5f; 0xafaf87; 0xafafaf; 0xafafd7; 0xafafff; 0xafd700; 0xafd75f; 0xafd787; 0xafd7af; 0xafd7d7; 0xafd7ff; 0xafff00; 0xafff5f; 0xafff87; 0xafffaf; 0xafffd7; 0xafffff; 0xd70000; 0xd7005f; 0xd70087; 0xd700af; 0xd700d7; 0xd700ff; 0xd75f00; 0xd75f5f; 0xd75f87; 0xd75faf; 0xd75fd7; 0xd75fff; 0xd78700; 0xd7875f; 0xd78787; 0xd787af; 0xd787d7; 0xd787ff; 0xd7af00; 0xd7af5f; 0xd7af87; 0xd7afaf; 0xd7afd7; 0xd7afff; 0xd7d700; 0xd7d75f; 0xd7d787; 0xd7d7af; 0xd7d7d7; 0xd7d7ff; 0xd7ff00; 0xd7ff5f; 0xd7ff87; 0xd7ffaf; 0xd7ffd7; 0xd7ffff; 0xff0000; 0xff005f; 0xff0087; 0xff00af; 0xff00d7; 0xff00ff; 0xff5f00; 0xff5f5f; 0xff5f87; 0xff5faf; 0xff5fd7; 0xff5fff; 0xff8700; 0xff875f; 0xff8787; 0xff87af; 0xff87d7; 0xff87ff; 0xffaf00; 0xffaf5f; 0xffaf87; 0xffafaf; 0xffafd7; 0xffafff; 0xffd700; 0xffd75f; 0xffd787; 0xffd7af; 0xffd7d7; 0xffd7ff; 0xffff00; 0xffff5f; 0xffff87; 0xffffaf; 0xffffd7; 0xffffff; 0x080808; 0x121212; 0x1c1c1c; 0x262626; 0x303030; 0x3a3a3a; 0x444444; 0x4e4e4e; 0x585858; 0x626262; 0x6c6c6c; 0x767676; 0x808080; 0x8a8a8a; 0x949494; 0x9e9e9e; 0xa8a8a8; 0xb2b2b2; 0xbcbcbc; 0xc6c6c6; 0xd0d0d0; 0xdadada; 0xe4e4e4; 0xeeeeee; ] (* +-----------------------------------------------------------------+ | Color generation | +-----------------------------------------------------------------+ *) let add_string str strings = let rec aux n strings = match strings with | [] -> let id = "data" ^ string_of_int n in (id, [(id, str)]) | (id, str') :: _ when str = str' -> (id, strings) | x :: strings -> let id, strings = aux (n + 1) strings in (id, x :: strings) in aux 0 strings let code_of_map map strings = let index_r, strings = add_string map.index_r strings in let index_g, strings = add_string map.index_g strings in let index_b, strings = add_string map.index_b strings in let mapping, strings = add_string map.map strings in let code = Printf.sprintf "{ count_r = %d; count_g = %d; count_b = %d; index_r = %s; index_g = %s; index_b = %s; map = %s; }" map.count_r map.count_g map.count_b index_r index_g index_b mapping in (code, strings) let print_string oc str = let rec aux i = if i = String.length str then () else begin if i > 0 then output_string oc "\\\n "; let len = min 16 (String.length str - i) in for i = i to i + len - 1 do Printf.fprintf oc "\\%03u" (Char.code str.[i]) done; aux (i + len) end in aux 0 let () = let oc = if Array.length Sys.argv < 2 then stdout else open_out Sys.argv.(1) in let strings = [] in let code16, strings = code_of_map colors_16 strings in let code88, strings = code_of_map colors_88 strings in let code256, strings = code_of_map colors_256 strings in output_string oc "(* * lTerm_color_mappings.ml * ----------------------- * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* This file was generated by gen_color_mappings.ml. *) "; List.iter (fun (id, str) -> Printf.fprintf oc "let %s = \"%a\"\n" id print_string str) strings; Printf.fprintf oc " type map = { count_r : int; count_g : int; count_b : int; index_r : string; index_g : string; index_b : string; map : string; } let colors_16 = %s let colors_88 = %s let colors_256 = %s " code16 code88 code256 lambda-term-3.1.0/src/lTerm.ml000066400000000000000000001275251366433625400161340ustar00rootroot00000000000000(* * lTerm.ml * -------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile open Lwt_react open LTerm_geom let return, (>>=) = Lwt.return, Lwt.(>>=) let uspace = UChar.of_char ' ' let yspace = Zed_char.unsafe_of_uChar uspace (* +-----------------------------------------------------------------+ | TTYs sizes | +-----------------------------------------------------------------+ *) external get_size_from_fd : Unix.file_descr -> size = "lt_term_get_size_from_fd" external set_size_from_fd : Unix.file_descr -> size -> unit = "lt_term_set_size_from_fd" let get_size_from_fd fd = Lwt_unix.check_descriptor fd; get_size_from_fd (Lwt_unix.unix_file_descr fd) let set_size_from_fd fd size = Lwt_unix.check_descriptor fd; set_size_from_fd (Lwt_unix.unix_file_descr fd) size (* +-----------------------------------------------------------------+ | The terminal type | +-----------------------------------------------------------------+ *) exception Not_a_tty let () = Printexc.register_printer (function | Not_a_tty -> Some "terminal is not a tty" | _ -> None) module Int_map = Map.Make(struct type t = int let compare a b = a - b end) type t = { model : string; colors : int; windows : bool; bold_is_bright : bool; color_map : LTerm_color_mappings.map; (* Informations. *) mutable raw_mode : bool; (* Whether the terminal is currently in raw mode. *) mutable incoming_fd : Lwt_unix.file_descr; mutable outgoing_fd : Lwt_unix.file_descr; (* File descriptors. *) mutable ic : Lwt_io.input_channel; mutable oc : Lwt_io.output_channel; (* Channels. *) mutable input_stream : char Lwt_stream.t; (* Stream of characters read from the terminal. *) mutable next_event : LTerm_event.t Lwt.t option; (* Thread reading the next event from the terminal. We cannot cancel the reading of an event, so we keep the last thread to reuse it in case the user cancels [read_event]. *) mutable read_event : bool; (* Whether a thread is currently reading an event. *) mutable last_reported_size : size; (* The last size reported by [read_event]. *) mutable size : size; (* The current size of the terminal. *) incoming_encoding : CharEncoding.t; outgoing_encoding : CharEncoding.t; (* Characters encodings. *) outgoing_is_utf8 : bool; (* Whether the outgoing encoding is UTF-8. *) notify : LTerm_event.t Lwt_condition.t; (* Condition used to send a spontaneous event. *) mutable event : unit event; (* Event which handles SIGWINCH. *) mutable incoming_is_a_tty : bool; mutable outgoing_is_a_tty : bool; (* Whether input/output are tty devices. *) mutable escape_time : float; (* Time to wait before returning the escape key. *) } (* +-----------------------------------------------------------------+ | Signals | +-----------------------------------------------------------------+ *) let resize_event, send_resize = E.create () let send_resize () = send_resize () let () = match LTerm_unix.sigwinch with | None -> (* Check for size when something happen. *) ignore (LTerm_dlist.add_l send_resize (LTerm_dlist.create ())) | Some signum -> try ignore (Lwt_unix.on_signal signum (fun _ -> send_resize ())) with Not_found -> ignore (LTerm_dlist.add_l send_resize (LTerm_dlist.create ())) (* +-----------------------------------------------------------------+ | Creation | +-----------------------------------------------------------------+ *) let default_model = try Sys.getenv "TERM" with Not_found -> "dumb" let colors_of_term = function | "Eterm-256color" -> 256 | "Eterm-88color" -> 88 | "gnome-256color" -> 256 | "iTerm.app" -> 256 | "konsole-256color" -> 256 | "mlterm-256color" -> 256 | "mrxvt-256color" -> 256 | "putty-256color" -> 256 | "rxvt-256color" -> 256 | "rxvt-88color" -> 88 | "rxvt-unicode-256color" -> 256 | "rxvt-unicode" -> 88 | "screen-256color" -> 256 | "screen-256color-bce" -> 256 | "screen-256color-bce-s" -> 256 | "screen-256color-s" -> 256 | "st-256color" -> 256 | "vte-256color" -> 256 | "xterm-256color" -> 256 | "xterm+256color" -> 256 | "xterm-88color" -> 88 | "xterm+88color" -> 88 | _ -> 16 exception No_such_encoding of string let char_encoding_of_name name = try CharEncoding.of_name name with Not_found -> raise (No_such_encoding name) (* UTF-8 on windows. *) let () = CharEncoding.alias "CP65001" "UTF-8" let empty_stream = Lwt_stream.from (fun () -> return None) let create ?(windows=Sys.win32) ?(model=default_model) ?incoming_encoding ?outgoing_encoding incoming_fd incoming_channel outgoing_fd outgoing_channel = Lwt.catch (fun () -> (* Colors stuff. *) let colors = if windows then 16 else colors_of_term model in let bold_is_bright = match model with | "linux" (* The linux frame buffer *) | "xterm-color" (* The MacOS-X terminal *) -> true | _ -> false in let color_map = match colors with | 16 -> LTerm_color_mappings.colors_16 | 88 -> LTerm_color_mappings.colors_88 | 256 -> LTerm_color_mappings.colors_256 | n -> Printf.ksprintf failwith "LTerm.create: unknown number of colors (%d)" n in (* Encodings. *) let incoming_encoding = char_encoding_of_name (match incoming_encoding with | Some name -> name | None -> if windows then Printf.sprintf "CP%d" (LTerm_windows.get_console_cp ()) else LTerm_unix.system_encoding) and outgoing_encoding = char_encoding_of_name (match outgoing_encoding with | Some name -> name | None -> if windows then Printf.sprintf "CP%d" (LTerm_windows.get_console_output_cp ()) else LTerm_unix.system_encoding) in (* Check if fds are ttys. *) Lwt_unix.isatty incoming_fd >>= fun incoming_is_a_tty -> Lwt_unix.isatty outgoing_fd >>= fun outgoing_is_a_tty -> (* Create the terminal. *) let term = { model; colors; windows; bold_is_bright; color_map; raw_mode = false; incoming_fd; outgoing_fd; ic = incoming_channel; oc = outgoing_channel; input_stream = empty_stream; next_event = None; read_event = false; incoming_encoding; outgoing_encoding; outgoing_is_utf8 = CharEncoding.name_of outgoing_encoding = "UTF-8"; notify = Lwt_condition.create (); event = E.never; incoming_is_a_tty; outgoing_is_a_tty; escape_time = 0.1; size = { rows = 0; cols = 0 }; last_reported_size = { rows = 0; cols = 0 }; } in term.input_stream <- Lwt_stream.from (fun () -> Lwt_io.read_char_opt term.ic); (* Setup initial size and size updater. *) if term.outgoing_is_a_tty then begin let check_size () = let size = get_size_from_fd term.outgoing_fd in if size <> term.size then begin term.size <- size; Lwt_condition.signal term.notify (LTerm_event.Resize size) end in term.size <- get_size_from_fd term.outgoing_fd; term.last_reported_size <- term.size; term.event <- E.map check_size resize_event end; return term) Lwt.fail let set_io ?incoming_fd ?incoming_channel ?outgoing_fd ?outgoing_channel term = let get opt x = match opt with | Some x -> x | None -> x in let incoming_fd = get incoming_fd term.incoming_fd and outgoing_fd = get outgoing_fd term.outgoing_fd and incoming_channel = get incoming_channel term.ic and outgoing_channel = get outgoing_channel term.oc in (* Check if fds are ttys. *) Lwt_unix.isatty incoming_fd >>= fun incoming_is_a_tty -> Lwt_unix.isatty outgoing_fd >>= fun outgoing_is_a_tty -> (* Apply changes. *) term.incoming_fd <- incoming_fd; term.outgoing_fd <- outgoing_fd; term.ic <- incoming_channel; term.oc <- outgoing_channel; term.incoming_is_a_tty <- incoming_is_a_tty; term.outgoing_is_a_tty <- outgoing_is_a_tty; return () let model t = t.model let colors t = t.colors let windows t = t.windows let is_a_tty t = t.incoming_is_a_tty && t.outgoing_is_a_tty let incoming_is_a_tty t = t.incoming_is_a_tty let outgoing_is_a_tty t = t.outgoing_is_a_tty let escape_time t = t.escape_time let set_escape_time t time = t.escape_time <- time let size term = if term.outgoing_is_a_tty then begin let size = get_size_from_fd term.outgoing_fd in if size <> term.size then begin term.size <- size; Lwt_condition.signal term.notify (LTerm_event.Resize size) end; size end else raise Not_a_tty let get_size term = Lwt.catch (fun () -> return (size term)) Lwt.fail let set_size _ _ = Lwt.fail (Failure "LTerm.set_size is deprecated") (* +-----------------------------------------------------------------+ | Events | +-----------------------------------------------------------------+ *) class output_single (cell : UChar.t option ref) = object method put char = cell := Some char method flush () = () method close_out () = () end let read_char term = begin Lwt_stream.get term.input_stream >>= fun byte_opt -> match byte_opt with | Some byte -> return byte | None -> Lwt.fail End_of_file end >>= fun first_byte -> let cell = ref None in let output = new CharEncoding.convert_uchar_output term.incoming_encoding (new output_single cell) in let rec loop st = match !cell with | Some char -> return char | None -> Lwt_stream.next st >>= fun byte -> assert (output#output (Bytes.make 1 byte) 0 1 = 1); output#flush (); loop st in Lwt.catch (fun () -> assert (output#output (Bytes.make 1 first_byte) 0 1 = 1); Lwt_stream.parse term.input_stream loop) (function | CharEncoding.Malformed_code | Lwt_stream.Empty -> return (UChar.of_char first_byte) | exn -> Lwt.fail exn) >>= fun char -> return (LTerm_event.Key { LTerm_key.control = false; LTerm_key.meta = false; LTerm_key.shift = false; LTerm_key.code = LTerm_key.Char char; }) let rec next_event term = if term.windows then LTerm_windows.read_console_input term.incoming_fd >>= fun input -> match input with | LTerm_windows.Resize -> if term.outgoing_is_a_tty then let size = get_size_from_fd term.outgoing_fd in if size <> term.size then begin term.size <- size; return (LTerm_event.Resize size) end else next_event term else next_event term | LTerm_windows.Key key -> return (LTerm_event.Key key) | LTerm_windows.Mouse mouse -> let window = (LTerm_windows.get_console_screen_buffer_info term.outgoing_fd).LTerm_windows.window in return (LTerm_event.Mouse { mouse with LTerm_mouse.row = mouse.LTerm_mouse.row - window.row1; LTerm_mouse.col = mouse.LTerm_mouse.col - window.col1; }) else LTerm_unix.parse_event ~escape_time:term.escape_time term.incoming_encoding term.input_stream let wrap_next_event next_event term = match term.next_event with | Some thread -> thread | None -> (* Create a non-cancelable thread. *) let waiter, wakener = Lwt.wait () in term.next_event <- Some waiter; (* Connect the [next_event term] thread to [waiter]. *) ignore (Lwt.try_bind (fun () -> next_event term) (fun v -> term.next_event <- None; Lwt.wakeup wakener v; return ()) (fun e -> term.next_event <- None; Lwt.wakeup_exn wakener e; return ())); waiter let read_event term = if term.read_event then Lwt.fail (Failure "LTerm.read_event: cannot read events from two thread at the same time") else if term.size <> term.last_reported_size then begin term.last_reported_size <- term.size; return (LTerm_event.Resize term.last_reported_size) end else begin term.read_event <- true; Lwt.finalize (fun () -> if term.incoming_is_a_tty then Lwt.pick [wrap_next_event next_event term; Lwt_condition.wait term.notify] >>= fun ev -> match ev with | LTerm_event.Resize size -> term.last_reported_size <- size; return (LTerm_event.Resize size) | ev -> return ev else wrap_next_event read_char term) (fun () -> term.read_event <- false; return ()) end (* +-----------------------------------------------------------------+ | Modes | +-----------------------------------------------------------------+ *) type mode = | Mode_fake | Mode_unix of Unix.terminal_io | Mode_windows of LTerm_windows.console_mode let enter_raw_mode term = if term.incoming_is_a_tty then if term.raw_mode then return Mode_fake else if term.windows then begin let mode = LTerm_windows.get_console_mode term.incoming_fd in LTerm_windows.set_console_mode term.incoming_fd { mode with LTerm_windows.cm_echo_input = false; LTerm_windows.cm_line_input = false; LTerm_windows.cm_mouse_input = true; LTerm_windows.cm_processed_input = false; LTerm_windows.cm_window_input = true; }; term.raw_mode <- true; return (Mode_windows mode) end else begin Lwt_unix.tcgetattr term.incoming_fd >>= fun attr -> Lwt_unix.tcsetattr term.incoming_fd Unix.TCSAFLUSH { attr with (* Inspired from Python-3.0/Lib/tty.py: *) Unix.c_brkint = false; Unix.c_inpck = false; Unix.c_istrip = false; Unix.c_ixon = false; Unix.c_csize = 8; Unix.c_parenb = false; Unix.c_echo = false; Unix.c_icanon = false; Unix.c_vmin = 1; Unix.c_vtime = 0; Unix.c_isig = false; } >>= fun () -> term.raw_mode <- true; return (Mode_unix attr) end else Lwt.fail Not_a_tty let leave_raw_mode term mode = if term.incoming_is_a_tty then match mode with | Mode_fake -> return () | Mode_unix attr -> term.raw_mode <- false; Lwt_unix.tcsetattr term.incoming_fd Unix.TCSAFLUSH attr | Mode_windows mode -> term.raw_mode <- false; LTerm_windows.set_console_mode term.incoming_fd mode; return () else Lwt.fail Not_a_tty let enable_mouse term = if term.outgoing_is_a_tty then if term.windows then return () else Lwt_io.write term.oc "\027[?1000h" else Lwt.fail Not_a_tty let disable_mouse term = if term.outgoing_is_a_tty then if term.windows then return () else Lwt_io.write term.oc "\027[?1000l" else Lwt.fail Not_a_tty (* +-----------------------------------------------------------------+ | Cursor | +-----------------------------------------------------------------+ *) let show_cursor term = if term.outgoing_is_a_tty then if term.windows then begin let size, _ = LTerm_windows.get_console_cursor_info term.outgoing_fd in LTerm_windows.set_console_cursor_info term.outgoing_fd size true; return () end else Lwt_io.write term.oc "\027[?25h" else Lwt.fail Not_a_tty let hide_cursor term = if term.outgoing_is_a_tty then if term.windows then begin let size, _ = LTerm_windows.get_console_cursor_info term.outgoing_fd in LTerm_windows.set_console_cursor_info term.outgoing_fd size false; return () end else Lwt_io.write term.oc "\027[?25l" else Lwt.fail Not_a_tty let goto term coord = if term.outgoing_is_a_tty then if term.windows then begin Lwt_io.flush term.oc >>= fun () -> let window = (LTerm_windows.get_console_screen_buffer_info term.outgoing_fd).LTerm_windows.window in LTerm_windows.set_console_cursor_position term.outgoing_fd { row = window.row1 + coord.row; col = window.col1 + coord.col; }; return () end else begin Lwt_io.fprint term.oc "\027[H" >>= fun () -> (if coord.row > 0 then Lwt_io.fprintf term.oc "\027[%dB" coord.row else return ()) >>= fun () -> (if coord.col > 0 then Lwt_io.fprintf term.oc "\027[%dC" coord.col else return ()) >>= fun () -> return () end else Lwt.fail Not_a_tty let move term rows cols = if term.outgoing_is_a_tty then if term.windows then begin Lwt_io.flush term.oc >>= fun () -> let pos = (LTerm_windows.get_console_screen_buffer_info term.outgoing_fd).LTerm_windows.cursor_position in LTerm_windows.set_console_cursor_position term.outgoing_fd { row = pos.row + rows; col = pos.col + cols; }; return () end else begin match rows with | n when n < 0 -> Lwt_io.fprintf term.oc "\027[%dA" (-n) | n when n > 0 -> Lwt_io.fprintf term.oc "\027[%dB" n | _ -> return () end >>= fun () -> begin match cols with | n when n < 0 -> Lwt_io.fprintf term.oc "\027[%dD" (-n) | n when n > 0 -> Lwt_io.fprintf term.oc "\027[%dC" n | _ -> return () end else Lwt.fail Not_a_tty (* +-----------------------------------------------------------------+ | Erasing text | +-----------------------------------------------------------------+ *) let clear_screen term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace (info.LTerm_windows.size.cols * info.LTerm_windows.size.rows) { row = 0; col = 0 } in return () end else Lwt_io.write term.oc "\027[2J" else Lwt.fail Not_a_tty let clear_screen_next term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace (info.LTerm_windows.size.cols * (info.LTerm_windows.size.rows - info.LTerm_windows.cursor_position.row) + info.LTerm_windows.size.cols - info.LTerm_windows.cursor_position.col) info.LTerm_windows.cursor_position in return () end else Lwt_io.write term.oc "\027[J" else Lwt.fail Not_a_tty let clear_screen_prev term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace (info.LTerm_windows.size.cols * info.LTerm_windows.cursor_position.row + info.LTerm_windows.cursor_position.col) { row = 0; col = 0 } in return () end else Lwt_io.write term.oc "\027[1J" else Lwt.fail Not_a_tty let clear_line term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace info.LTerm_windows.size.cols { row = info.LTerm_windows.cursor_position.row; col = 0 } in return () end else Lwt_io.write term.oc "\027[2K" else Lwt.fail Not_a_tty let clear_line_next term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace (info.LTerm_windows.size.cols - info.LTerm_windows.cursor_position.col) info.LTerm_windows.cursor_position in return () end else Lwt_io.write term.oc "\027[K" else Lwt.fail Not_a_tty let clear_line_prev term = if term.outgoing_is_a_tty then if term.windows then begin let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let _ = LTerm_windows.fill_console_output_character term.outgoing_fd uspace info.LTerm_windows.cursor_position.col { row = info.LTerm_windows.cursor_position.row; col = 0 } in return () end else Lwt_io.write term.oc "\027[1K" else Lwt.fail Not_a_tty (* +-----------------------------------------------------------------+ | State | +-----------------------------------------------------------------+ *) let save_state term = if term.outgoing_is_a_tty then if term.windows then return () else Lwt_io.write term.oc "\027[?1049h" else Lwt.fail Not_a_tty let load_state term = if term.outgoing_is_a_tty then if term.windows then return () else Lwt_io.write term.oc "\027[?1049l" else Lwt.fail Not_a_tty (* +-----------------------------------------------------------------+ | String recoding | +-----------------------------------------------------------------+ *) let vline = UChar.of_char '|' let vlline = UChar.of_char '+' let dlcorner = UChar.of_char '+' let urcorner = UChar.of_char '+' let huline = UChar.of_char '+' let hdline = UChar.of_char '+' let vrline = UChar.of_char '+' let hline = UChar.of_char '-' let cross = UChar.of_char '+' let ulcorner = UChar.of_char '+' let drcorner = UChar.of_char '+' let question = UChar.of_char '?' module UNF = UNF.Make (UText) (* Map characters that cannot be encoded to ASCII ones. *) let map_char char = match UChar.code char with | 0x2500 -> hline | 0x2501 -> hline | 0x2502 -> vline | 0x2503 -> vline | 0x2504 -> hline | 0x2505 -> hline | 0x2506 -> vline | 0x2507 -> vline | 0x2508 -> hline | 0x2509 -> hline | 0x250a -> vline | 0x250b -> vline | 0x250c -> drcorner | 0x250d -> drcorner | 0x250e -> drcorner | 0x250f -> drcorner | 0x2510 -> dlcorner | 0x2511 -> dlcorner | 0x2512 -> dlcorner | 0x2513 -> dlcorner | 0x2514 -> urcorner | 0x2515 -> urcorner | 0x2516 -> urcorner | 0x2517 -> urcorner | 0x2518 -> ulcorner | 0x2519 -> ulcorner | 0x251a -> ulcorner | 0x251b -> ulcorner | 0x251c -> vrline | 0x251d -> vrline | 0x251e -> vrline | 0x251f -> vrline | 0x2520 -> vrline | 0x2521 -> vrline | 0x2522 -> vrline | 0x2523 -> vrline | 0x2524 -> vlline | 0x2525 -> vlline | 0x2526 -> vlline | 0x2527 -> vlline | 0x2528 -> vlline | 0x2529 -> vlline | 0x252a -> vlline | 0x252b -> vlline | 0x252c -> hdline | 0x252d -> hdline | 0x252e -> hdline | 0x252f -> hdline | 0x2530 -> hdline | 0x2531 -> hdline | 0x2532 -> hdline | 0x2533 -> hdline | 0x2534 -> huline | 0x2535 -> huline | 0x2536 -> huline | 0x2537 -> huline | 0x2538 -> huline | 0x2539 -> huline | 0x253a -> huline | 0x253b -> huline | 0x253c -> cross | 0x253d -> cross | 0x253e -> cross | 0x253f -> cross | 0x2540 -> cross | 0x2541 -> cross | 0x2542 -> cross | 0x2543 -> cross | 0x2544 -> cross | 0x2545 -> cross | 0x2546 -> cross | 0x2547 -> cross | 0x2548 -> cross | 0x2549 -> cross | 0x254a -> cross | 0x254b -> cross | 0x254c -> hline | 0x254d -> hline | 0x254e -> vline | 0x254f -> vline | 0x2550 -> hline | 0x2551 -> vline | _ -> match UNF.nfd_decompose char with | char :: _ -> if UChar.code char <= 127 then char else question | [] -> question class output_to_buffer buf res = object method output str ofs len = Buffer.add_subbytes buf str ofs len; len method flush () = () method close_out () = res := Buffer.contents buf end let encode_string term str = if term.outgoing_is_utf8 then (* Do not recode [str] if the output is UTF-8. *) str else let buf = Buffer.create (String.length str) in let res = ref "" in let output = new CharEncoding.uchar_output_channel_of term.outgoing_encoding (new output_to_buffer buf res) in let rec loop ofs = if ofs = String.length str then begin output#close_out (); !res end else begin let ch, ofs = Zed_utf8.unsafe_extract_next str ofs in (try output#put ch with CharEncoding.Out_of_range | UChar.Out_of_range -> output#put (map_char ch)); loop ofs end in loop 0 let encode_char term ch = if term.outgoing_is_utf8 then Zed_utf8.singleton ch else begin let res = ref "" in let output = new CharEncoding.uchar_output_channel_of term.outgoing_encoding (new output_to_buffer (Buffer.create 8) res) in (try output#put ch with CharEncoding.Out_of_range | UChar.Out_of_range -> output#put (map_char ch)); output#close_out (); !res end (* +-----------------------------------------------------------------+ | Styled printing | +-----------------------------------------------------------------+ *) module Codes = struct let bold = ";1" let underline = ";4" let blink = ";5" let reverse = ";7" let foreground = 30 let background = 40 end let fprint term str = Lwt_io.fprint term.oc (encode_string term str) let fprintl term str = fprint term (str ^ "\n") let fprintf term fmt = Printf.ksprintf (fun str -> fprint term str) fmt let fprintlf term fmt = Printf.ksprintf (fun str -> fprintl term str) fmt let add_int buf n = let rec loop = function | 0 -> () | n -> loop (n / 10); Buffer.add_char buf (Char.unsafe_chr (48 + (n mod 10))) in if n = 0 then Buffer.add_char buf '0' else loop n let map_color term r g b = let open LTerm_color_mappings in let map = term.color_map in (* The [String.unsafe_get]s are safe because the private type [LTerm_style.color] ensure that all components are in the range [0..255]. *) Char.code (String.unsafe_get map.map (Char.code (String.unsafe_get map.index_r r) + map.count_r * (Char.code (String.unsafe_get map.index_g g) + map.count_g * Char.code (String.unsafe_get map.index_b b)))) let add_index term buf base n = if n < 8 then begin Buffer.add_char buf ';'; add_int buf (base + n) end else if n < 16 && term.bold_is_bright then if base = Codes.foreground then begin Buffer.add_string buf ";1;"; add_int buf (base + n - 8) end else begin Buffer.add_char buf ';'; add_int buf (base + n - 8) end else begin Buffer.add_char buf ';'; add_int buf (base + 8); Buffer.add_string buf ";5;"; add_int buf n end let add_color term buf base = function | LTerm_style.Default -> () | LTerm_style.Index n -> add_index term buf base n | LTerm_style.RGB(r, g, b) -> add_index term buf base (map_color term r g b) let add_style term buf style = let open LTerm_style in Buffer.add_string buf "\027[0"; (match style.bold with Some true -> Buffer.add_string buf Codes.bold | _ -> ()); (match style.underline with Some true -> Buffer.add_string buf Codes.underline | _ -> ()); (match style.blink with Some true -> Buffer.add_string buf Codes.blink | _ -> ()); (match style.reverse with Some true -> Buffer.add_string buf Codes.reverse | _ -> ()); (match style.foreground with Some color -> add_color term buf Codes.foreground color | None -> ()); (match style.background with Some color -> add_color term buf Codes.background color | None -> ()); Buffer.add_char buf 'm' let expand term text = if Array.length text = 0 then "" else begin let buf = Buffer.create 256 in Buffer.add_string buf "\027[0m"; let rec loop idx prev_style = if idx = Array.length text then begin Buffer.add_string buf "\027[0m"; Buffer.contents buf end else begin let ch, style = Array.unsafe_get text idx in if not (LTerm_style.equal style prev_style) then add_style term buf style; Buffer.add_string buf (Zed_char.to_utf8 ch); loop (idx + 1) style end in loop 0 LTerm_style.none end let windows_fg_color term = function | LTerm_style.Default -> 7 | LTerm_style.Index n -> n | LTerm_style.RGB(r, g, b) -> map_color term r g b let windows_bg_color term = function | LTerm_style.Default -> 0 | LTerm_style.Index n -> n | LTerm_style.RGB(r, g, b) -> map_color term r g b let windows_default_attributes = { LTerm_windows.foreground = 7; LTerm_windows.background = 0 } let windows_attributes_of_style term style = let open LTerm_style in if style.reverse = Some true then { LTerm_windows.foreground = (match style.background with Some color -> windows_bg_color term color | None -> 0); LTerm_windows.background = (match style.foreground with Some color -> windows_fg_color term color | None -> 7); } else { LTerm_windows.foreground = (match style.foreground with Some color -> windows_fg_color term color | None -> 7); LTerm_windows.background = (match style.background with Some color -> windows_bg_color term color | None -> 0); } let fprints_windows term oc text = let rec loop idx prev_attr = if idx = Array.length text then begin Lwt_io.flush oc >>= fun () -> LTerm_windows.set_console_text_attribute term.outgoing_fd windows_default_attributes; return () end else begin let ch, style = Array.unsafe_get text idx in let attr = windows_attributes_of_style term style in begin if attr <> prev_attr then Lwt_io.flush oc >>= fun () -> LTerm_windows.set_console_text_attribute term.outgoing_fd attr; return () else return () end >>= fun () -> let chars= Zed_char.to_raw ch in let s= chars |> List.map (encode_char term) |> String.concat "" in Lwt_io.write oc s >>= fun () -> loop (idx + 1) attr end in Lwt_io.flush oc >>= fun () -> LTerm_windows.set_console_text_attribute term.outgoing_fd windows_default_attributes; loop 0 windows_default_attributes let fprints term text = if term.outgoing_is_a_tty then if term.windows then Lwt_io.atomic (fun oc -> fprints_windows term oc text) term.oc else fprint term (expand term text) else fprint term (Zed_string.to_utf8 (LTerm_text.to_string text)) let fprintls term text = fprints term (Array.append text (LTerm_text.of_utf8 "\n")) (* +-----------------------------------------------------------------+ | Printing with contexts | +-----------------------------------------------------------------+ *) type context = { ctx_term : t; ctx_oc : Lwt_io.output_channel; mutable ctx_style : LTerm_style.t; mutable ctx_attr : LTerm_windows.text_attributes; } let clear_styles term oc = if term.outgoing_is_a_tty then if term.windows then Lwt_io.flush oc >>= fun () -> LTerm_windows.set_console_text_attribute term.outgoing_fd windows_default_attributes; return () else Lwt_io.write oc "\027[0m" else return () let with_context term f = Lwt_io.atomic (fun oc -> let ctx = { ctx_term = term; ctx_oc = oc; ctx_style = LTerm_style.none; ctx_attr = windows_default_attributes; } in clear_styles term oc >>= fun () -> Lwt.finalize (fun () -> f ctx) (fun () -> clear_styles term oc)) term.oc let update_style ctx style = if ctx.ctx_term.outgoing_is_a_tty then begin if ctx.ctx_term.windows then begin let attr = windows_attributes_of_style ctx.ctx_term style in if attr <> ctx.ctx_attr then Lwt_io.flush ctx.ctx_oc >>= fun () -> LTerm_windows.set_console_text_attribute ctx.ctx_term.outgoing_fd attr; ctx.ctx_attr <- attr; return () else return () end else begin if not (LTerm_style.equal style ctx.ctx_style) then begin let buf = Buffer.create 16 in add_style ctx.ctx_term buf style; Lwt_io.write ctx.ctx_oc (Buffer.contents buf) >>= fun () -> ctx.ctx_style <- style; return () end else return () end end else return () let context_term ctx = ctx.ctx_term let context_oc ctx = ctx.ctx_oc (* +-----------------------------------------------------------------+ | Styles setting | +-----------------------------------------------------------------+ *) let set_style term style = if term.outgoing_is_a_tty then if term.windows then begin let attr = windows_attributes_of_style term style in Lwt_io.atomic (fun oc -> Lwt_io.flush oc >>= fun () -> LTerm_windows.set_console_text_attribute term.outgoing_fd attr; return ()) term.oc end else begin let buf = Buffer.create 16 in add_style term buf style; Lwt_io.fprint term.oc (Buffer.contents buf) end else return () (* +-----------------------------------------------------------------+ | Rendering | +-----------------------------------------------------------------+ *) let same_style p1 p2 = let open LTerm_draw in p1.bold = p2.bold && p1.underline = p2.underline && p1.blink = p2.blink && p1.reverse = p2.reverse && p1.foreground = p2.foreground && p1.background = p2.background let unknown_uchar = UChar.of_int 0xfffd let unknown_char = Zed_char.unsafe_of_uChar unknown_uchar let unknown_utf8 = Zed_char.to_utf8 unknown_char let render_style term buf old_point new_point = let open LTerm_draw in if not (same_style new_point old_point) then begin (* Reset styles if they are different from the previous point. *) Buffer.add_string buf "\027[0"; if new_point.bold then Buffer.add_string buf Codes.bold; if new_point.underline then Buffer.add_string buf Codes.underline; if new_point.blink then Buffer.add_string buf Codes.blink; if new_point.reverse then Buffer.add_string buf Codes.reverse; add_color term buf Codes.foreground new_point.foreground; add_color term buf Codes.background new_point.background; Buffer.add_char buf 'm'; end let render_point term buf old_point new_point = render_style term buf old_point new_point; (* Skip control characters, otherwise output will be messy. *) if UChar.code (Zed_char.core new_point.LTerm_draw.char) < 32 then Buffer.add_string buf unknown_utf8 else Buffer.add_string buf (Zed_char.to_utf8 new_point.LTerm_draw.char) type render_kind = Render_screen | Render_box let render_update_unix term kind old_matrix matrix = let open LTerm_draw in let buf = Buffer.create 16 in Buffer.add_string buf (match kind with | Render_screen -> (* Go the the top-left and reset attributes *) "\027[H\027[0m" | Render_box -> (* Go the the beginnig of line and reset attributes *) "\r\027[0m"); (* The last displayed point. *) let last_point = ref { char = yspace; bold = false; underline = false; blink = false; reverse = false; foreground = LTerm_style.default; background = LTerm_style.default; } in let rows = Array.length matrix and old_rows = Array.length old_matrix in for y = 0 to rows - 1 do let line = Array.unsafe_get matrix y in (* If the current line is equal to the displayed one, skip it *) if y >= old_rows || line <> Array.unsafe_get old_matrix y then begin for x = 0 to Array.length line - 1 do let point = !(Array.unsafe_get line x) in match point with | Elem elem-> render_point term buf !last_point elem; last_point := elem | WidthHolder _n-> () done end; if y < rows - 1 then Buffer.add_char buf '\n' done; Buffer.add_string buf "\027[0m"; (* Go to the beginning of the line if rendering a box. *) if kind = Render_box then Buffer.add_char buf '\r'; fprint term (Buffer.contents buf) let blank_windows = { LTerm_windows.ci_char = yspace; LTerm_windows.ci_foreground = 7; LTerm_windows.ci_background = 0; } let windows_char_info term point char = if point.LTerm_draw.reverse then { LTerm_windows.ci_char = char; LTerm_windows.ci_foreground = windows_bg_color term point.LTerm_draw.background; LTerm_windows.ci_background = windows_fg_color term point.LTerm_draw.foreground; } else { LTerm_windows.ci_char = char; LTerm_windows.ci_foreground = windows_fg_color term point.LTerm_draw.foreground; LTerm_windows.ci_background = windows_bg_color term point.LTerm_draw.background; } let render_windows term kind handle_newlines matrix = (* Build the matrix of char infos *) let matrix = Array.map (fun line -> let len = Array.length line - (if handle_newlines then 1 else 0) in if len < 0 then invalid_arg "LTerm.print_box_with_newlines"; let res = Array.make len blank_windows in let rec loop i = if i = len then res else begin match !(Array.unsafe_get line i) with | LTerm_draw.Elem point-> let code = UChar.code (Zed_char.core point.LTerm_draw.char) in if handle_newlines && code = 10 then begin (* Copy styles. *) Array.unsafe_set res i (windows_char_info term point yspace); for i = i + 1 to len - 1 do match !(Array.unsafe_get line i) with | LTerm_draw.Elem point-> Array.unsafe_set res i (windows_char_info term point yspace) | _-> () done; res end else begin let char = if code < 32 then unknown_char else point.LTerm_draw.char in Array.unsafe_set res i (windows_char_info term point char); loop (i + 1) end | WidthHolder _n-> res end in loop 0) matrix in let rows = Array.length matrix in begin match kind with | Render_screen -> return () | Render_box -> (* Ensure that there is enough place to display the box. *) fprint term "\r" >>= fun () -> fprint term (String.make (rows - 1) '\n') >>= fun () -> Lwt_io.flush term.oc end >>= fun () -> let info = LTerm_windows.get_console_screen_buffer_info term.outgoing_fd in let window_rect = info.LTerm_windows.window in let rect = match kind with | Render_screen -> window_rect | Render_box -> { window_rect with row1 = info.LTerm_windows.cursor_position.row - (rows - 1); row2 = info.LTerm_windows.cursor_position.row + 1 } in ignore ( LTerm_windows.write_console_output term.outgoing_fd matrix { rows = Array.length matrix; cols = if matrix = [||] then 0 else Array.length matrix.(0) } { row = 0; col = 0 } rect ); return () let render_update term old_matrix matrix = if term.outgoing_is_a_tty then if term.windows then render_windows term Render_screen false matrix else render_update_unix term Render_screen old_matrix matrix else Lwt.fail Not_a_tty let render term m = render_update term [||] m let print_box term matrix = if term.outgoing_is_a_tty then begin if Array.length matrix > 0 then begin if term.windows then render_windows term Render_box false matrix else render_update_unix term Render_box [||] matrix end else fprint term "\r" end else Lwt.fail Not_a_tty let print_box_with_newlines_unix term matrix = let open LTerm_draw in let buf = Buffer.create 16 in (* Go the the beginnig of line and reset attributes *) Buffer.add_string buf "\r\027[0m"; (* The last displayed point. *) let last_point = ref { char = yspace; bold = false; underline = false; blink = false; reverse = false; foreground = LTerm_style.default; background = LTerm_style.default; } in let rows = Array.length matrix in for y = 0 to rows - 1 do let line = Array.unsafe_get matrix y in let cols = Array.length line - 1 in if cols < 0 then invalid_arg "LTerm.print_box_with_newlines"; let rec loop x = match !(Array.unsafe_get line x) with | Elem point-> let code = UChar.code (Zed_char.core point.char) in if x = cols then begin if code = 10 && y < rows - 1 then Buffer.add_char buf '\n' end else if code = 10 then begin (* Use the style of the newline for the rest of the line. *) render_style term buf !last_point point; last_point := point; (* Erase everything until the end of line. *) Buffer.add_string buf "\027[K"; if y < rows - 1 then Buffer.add_char buf '\n' end else begin render_point term buf !last_point point; last_point := point; loop (x + 1) end | WidthHolder _n-> loop (x+1) in loop 0 done; Buffer.add_string buf "\027[0m\r"; fprint term (Buffer.contents buf) let print_box_with_newlines term matrix = if term.outgoing_is_a_tty then begin if Array.length matrix > 0 then begin if term.windows then render_windows term Render_box true matrix else print_box_with_newlines_unix term matrix end else fprint term "\r" end else Lwt.fail Not_a_tty (* +-----------------------------------------------------------------+ | Misc | +-----------------------------------------------------------------+ *) let flush term = Lwt_io.flush term.oc let get_size_from_fd fd = return (get_size_from_fd fd) let set_size_from_fd fd size = return (set_size_from_fd fd size) (* +-----------------------------------------------------------------+ | Standard terminals | +-----------------------------------------------------------------+ *) let stdout = lazy(create Lwt_unix.stdin Lwt_io.stdin Lwt_unix.stdout Lwt_io.stdout) let stderr = lazy(create Lwt_unix.stdin Lwt_io.stdin Lwt_unix.stderr Lwt_io.stderr) let print str = Lazy.force stdout >>= fun term -> fprint term str let printl str = Lazy.force stdout >>= fun term -> fprintl term str let printf fmt = Printf.ksprintf print fmt let prints str = Lazy.force stdout >>= fun term -> fprints term str let printlf fmt = Printf.ksprintf printl fmt let printls str = Lazy.force stdout >>= fun term -> fprintls term str let eprint str = Lazy.force stderr >>= fun term -> fprint term str let eprintl str = Lazy.force stderr >>= fun term -> fprintl term str let eprintf fmt = Printf.ksprintf eprint fmt let eprints str = Lazy.force stderr >>= fun term -> fprints term str let eprintlf fmt = Printf.ksprintf eprintl fmt let eprintls str = Lazy.force stderr >>= fun term -> fprintls term str lambda-term-3.1.0/src/lTerm.mli000066400000000000000000000317311366433625400162760ustar00rootroot00000000000000(* * lTerm.mli * --------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Terminal definitions *) open CamomileLibrary type t (** Type of terminals. *) (** {6 Creation} *) exception No_such_encoding of string (** Exception raised when an encoding does not exist. *) val create : ?windows : bool -> ?model : string -> ?incoming_encoding : string -> ?outgoing_encoding : string -> Lwt_unix.file_descr -> Lwt_io.input_channel -> Lwt_unix.file_descr -> Lwt_io.output_channel -> t Lwt.t (** [create ?windows ?model ?incoming_encoding ?outgoing_encoding input_fd input_channel outout_fd output_channel] creates a new terminal using [input_fd] and [input_channel] for inputs and [output_fd] and [output_channel] for outputs. - [windows] indicates whether the terminal is a windows console (not mintty, rxvt, ...). It defaults to [Sys.win32]. - [model] is the type of the terminal, such as "rxvt" or "xterm". It defaults to the contents of the "TERM" environment variable, or to "dumb" if this one is not found. It is used to determine capabilities of the terminal, such as the number of colors. This is not used if [windows] is [true]. - [incoming_encoding] is the encoding used for incoming data. It defaults to [LTerm_windows.get_console_cp] if [windows] is [true] and [LTerm_unix.system_encoding] otherwise. - [outgoing_encoding] is the encoding used for outgoing data. It defaults to [LTerm_windows.get_console_output_cp] if [windows] is [true] and [LTerm_unix.system_encoding] otherwise. Note that transliteration is used so printing unicode character on the terminal will never fail. If one of the two given encodings does not exist, it raises [No_such_encoding]. Note about terminal resize: in the windows console resizes are not automatically detected. Lambda-term will only check for resize only when something happens. If you want it to poll just write somewhere in your program: {[ Lwt_engine.on_timer 1.0 true ignore ]} *) (** {6 Informations} *) val model : t -> string (** Returns the model of the terminal. *) val colors : t -> int (** Number of colors of the terminal. *) val windows : t -> bool (** Whether the terminal is a windows console or not. *) val is_a_tty : t -> bool (** [is_a_tty term] whether the intput and output of the given terminal are connected to a tty device. *) val incoming_is_a_tty : t -> bool (** [incoming_is_a_tty term] whether the input of [term] is a tty device. *) val outgoing_is_a_tty : t -> bool (** [incoming_is_a_tty term] whether the output of [term] is a tty device. *) val escape_time : t -> float (** Time waited before returning the escape key. This is not used on windows. *) val set_escape_time : t -> float -> unit (** Set the time waited before returning the escape key. *) exception Not_a_tty (** Exception raised when trying to use a function that can only be used on terminals. *) val size : t -> LTerm_geom.size (** Returns the curent size of the terminal. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) (** {6 Modes} *) type mode (** Type of terminal modes. *) val enter_raw_mode : t -> mode Lwt.t (** [enter_raw_mode term] puts the terminal in ``raw mode''. In this mode keyboard events are returned as they happen. In normal mode only complete line are returned. It returns the current terminal mode that can be restored using {!leave_raw_mode}. It raises {!Not_a_tty} if the input of the given terminal is not tty. *) val leave_raw_mode : t -> mode -> unit Lwt.t (** [leave_raw_mode term mode] leaves the raw mode by restoring the given mode. It raises {!Not_a_tty} if the input of the given terminal is not tty. *) val enable_mouse : t -> unit Lwt.t (** Enable mouse events reporting. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val disable_mouse : t -> unit Lwt.t (** Disable mouse events reporting. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) (** {6 Cursor} *) val show_cursor : t -> unit Lwt.t (** Make the cursor visible. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val hide_cursor : t -> unit Lwt.t (** Make the cursor invisible. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val goto : t -> LTerm_geom.coord -> unit Lwt.t (** [goto term coord] moves the cursor to the given coordinates. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val move : t -> int -> int -> unit Lwt.t (** [move term rows columns] moves the cursor by the given number of lines and columns. Both [rows] and [columns] may be negavite. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) (** {6 Erasing text} *) val clear_screen : t -> unit Lwt.t (** [clear_screen term] clears the entire screen. *) val clear_screen_next : t -> unit Lwt.t (** [clear_screen_next term] clears the screen from the cursor to the bottom of the screen. *) val clear_screen_prev : t -> unit Lwt.t (** [clear_screen_prev term] clears the screen from the cursor to the top of the screen. *) val clear_line : t -> unit Lwt.t (** [clear_line term] erases the current line. *) val clear_line_next : t -> unit Lwt.t (** [clear_line_next term] erases the current line from the cursor to the end of the line. *) val clear_line_prev : t -> unit Lwt.t (** [clear_line_prev term] erases the current line from the cursor to the beginning of the line. *) (** {6 State} *) val save_state : t -> unit Lwt.t (** Save the current state of the terminal so it can be restored latter. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val load_state : t -> unit Lwt.t (** Load the previously saved state of the terminal. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) (** {6 Events} *) val read_event : t -> LTerm_event.t Lwt.t (** Reads and returns one event. The terminal should be in raw mode before calling this function, otherwise event will not be reported as they happen. It does not fail if the terminal is not a tty. Note: you must not call {!read_event} from multiple thread at the same time, it will raise {!Failure} if you try to do so. *) (** {6 Printing} *) (** All these functions accept only valid UTF-8 strings (or unicode styled text). Strings are recoded on the fly using the terminal output encoding (except if the terminal output encoding is already UTF-8, in which case the string is just printed as-it). The general name of a printing function is [print]. Where [] is one of: - ['f'], which means that the function takes as argument a terminal - nothing, which means that the function prints on {!stdout} - ['e'], which means that the function prints on {!stderr} and [] is a combination of: - ['l'] which means that a new-line character is printed after the message - ['f'] which means that the function takes as argument a {b format} instead of a string - ['s'] which means that the function takes as argument a styled string instead of a string Note that if the terminal is not a tty, styles are stripped. *) val fprint : t -> Zed_utf8.t -> unit Lwt.t val fprintl : t -> Zed_utf8.t -> unit Lwt.t val fprintf : t -> ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val fprints : t -> LTerm_text.t -> unit Lwt.t val fprintlf : t -> ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val fprintls : t -> LTerm_text.t -> unit Lwt.t val print : Zed_utf8.t -> unit Lwt.t val printl : Zed_utf8.t -> unit Lwt.t val printf : ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val prints : LTerm_text.t -> unit Lwt.t val printlf : ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val printls : LTerm_text.t -> unit Lwt.t val eprint : Zed_utf8.t -> unit Lwt.t val eprintl : Zed_utf8.t -> unit Lwt.t val eprintf : ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val eprints : LTerm_text.t -> unit Lwt.t val eprintlf : ('a, unit, Zed_utf8.t, unit Lwt.t) format4 -> 'a val eprintls : LTerm_text.t -> unit Lwt.t (** {8 Printing contexts} *) (** You shoud use these functions when you to print a lot of styled text that does not entirely fit in a single {!LTerm_text.t} value. This is more efficient than calling manually {!set_style} since styles will be modified only when needed. *) type context (** A context for styled printing. *) val with_context : t -> (context -> 'a Lwt.t) -> 'a Lwt.t (** [with_context term f] creates a new printing context and pass it to [f]. Note that calls to [with_context] are serialized. *) val update_style : context -> LTerm_style.t -> unit Lwt.t (** [update_style ctx style] updates the style of the context with [style]. If needed styles of the terminal are modified. *) val context_term : context -> t (** Returns the terminal used by the given context. *) val context_oc : context -> Lwt_io.output_channel (** Returns the output channel used by the given context. Note that this channel cannot be used after {!with_context} has terminated. *) val encode_string : t -> Zed_utf8.t -> string (** [encode_string term str] encodes an UTF-8 string using the terminal encoding. *) val encode_char : t -> UChar.t -> string (** [encode_char term ch] encodes an unicode character using the terminal encoding. *) (** {6 Styles} *) val set_style : t -> LTerm_style.t -> unit Lwt.t (** Change the style of the termina for subsequent unstyled output. It does nothing if the output is not a tty. *) (** {6 Rendering} *) val render : t -> LTerm_draw.matrix -> unit Lwt.t (** Render an offscreen array to the given terminal. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val render_update : t -> LTerm_draw.matrix -> LTerm_draw.matrix -> unit Lwt.t (** [render_update displayed to_display] does the same as [render to_display] but assumes that [displayed] contains the current displayed text. This reduces the amount of text sent to the terminal. It raises {!Not_a_tty} if the output of the given terminal is not a tty. *) val print_box : t -> LTerm_draw.matrix -> unit Lwt.t (** [print_box term matrix] prints the contents of [matrix] starting at current cursor row. Note that when you have the choice between using {!fprints} and {!print_box} you should use {!print_box} because it works better under windows and is more efficient. The cursor is moved to the beginning of the last displayed line. *) val print_box_with_newlines : t -> LTerm_draw.matrix -> unit Lwt.t (** [print_box term matrix] Same as {!print_box} but [matrix] may contains newline characters. It must contain one more column that the terminal (in case a line of the length of the terminal ends with a newline). The difference between {!print_box} and {!print_box_with_newlines} is that when the text is selected in the terminal, with {!print_box} it will always be a box with the dimensions of [matrix]. With {!print_box_with_newlines} it may contains lines longer than the width of the terminal. The contents of a line after the first newline character (if any) in a row of [matrix] is ignored. The rest of the line get the style of the newline character. *) (** {6 Misc} *) val flush : t -> unit Lwt.t (** Flushes the underlying output channel used by the terminal. *) (** {6 Well known instances} *) val stdout : t Lwt.t Lazy.t (** Terminal using {!Lwt_unix.stdin} as input and {!Lwt_unix.stdout} as output. *) val stderr : t Lwt.t Lazy.t (** Terminal using {!Lwt_unix.stdin} as input and {!Lwt_unix.stderr} as output. *) (** {6 Low-level functions} *) val get_size_from_fd : Lwt_unix.file_descr -> LTerm_geom.size Lwt.t (** [get_size_from_fd fd] returns the size of the terminal accessible via the given file descriptor. *) val set_size_from_fd : Lwt_unix.file_descr -> LTerm_geom.size -> unit Lwt.t (** [set_size_from_fd fd size] tries to set the size of the terminal accessible via the given file descriptor. *) (** {6 Modification} *) val set_io : ?incoming_fd : Lwt_unix.file_descr -> ?incoming_channel : Lwt_io.input_channel -> ?outgoing_fd : Lwt_unix.file_descr -> ?outgoing_channel : Lwt_io.output_channel -> t -> unit Lwt.t (** Modifies file descriptors/channels of a terminal. Unspecified arguments are kept unchanged. Note: before modifying a terminal you should ensure that no operation is pending on it. *) (**/**) val get_size : t -> LTerm_geom.size Lwt.t val set_size : t -> LTerm_geom.size -> unit Lwt.t lambda-term-3.1.0/src/lTerm_buttons_impl.ml000066400000000000000000000140011366433625400207130ustar00rootroot00000000000000(* * lTerm_buttons_impl.ml * --------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) module Make (LiteralIntf: LiteralIntf.Type) = struct open CamomileLibraryDefault.Camomile open LTerm_geom open LTerm_key open LTerm_mouse open LTerm_widget_callbacks let section = Lwt_log.Section.make "lambda-term(buttons_impl)" class t = LTerm_widget_base_impl.t let space = Char(UChar.of_char ' ') class button ?brackets initial_label = let (bl, br)= match brackets with | Some (bl, br)-> LiteralIntf.to_string_exn bl, LiteralIntf.to_string_exn br | None-> Zed_string.unsafe_of_utf8 "< ",Zed_string.unsafe_of_utf8 " >" in let brackets_size = LTerm_text.aval_width (Zed_string.width bl) + LTerm_text.aval_width (Zed_string.width br) in object(self) inherit t "button" method! can_focus = true val click_callbacks = LTerm_widget_callbacks.create () method on_click ?switch f = register switch click_callbacks f val mutable size_request = { rows = 1; cols = brackets_size + (LTerm_text.aval_width (Zed_string.width (LiteralIntf.to_string_exn initial_label))) } method! size_request = size_request val mutable label = LiteralIntf.to_string_exn initial_label method label = LiteralIntf.of_string label method label_zed = label method set_label text = let text= LiteralIntf.to_string_exn text in label <- text; size_request <- { rows = 1; cols = brackets_size + (LTerm_text.aval_width (Zed_string.width text)) }; self#queue_draw initializer self#on_event (function | LTerm_event.Key { control = false; meta = false; shift = false; code = Enter } -> exec_callbacks click_callbacks (); true | LTerm_event.Mouse m when m.button = Button1 -> exec_callbacks click_callbacks (); true | _ -> false) val mutable focused_style = LTerm_style.none val mutable unfocused_style = LTerm_style.none method! update_resources = let rc = self#resource_class and resources = self#resources in focused_style <- LTerm_resources.get_style (rc ^ ".focused") resources; unfocused_style <- LTerm_resources.get_style (rc ^ ".unfocused") resources method private apply_style ctx focused = let style = if focused = (self :> t) then focused_style else unfocused_style in LTerm_draw.fill_style ctx style method! draw ctx focused = let { rows; cols } = LTerm_draw.size ctx in let width = LTerm_text.aval_width (Zed_string.width label) in self#apply_style ctx focused; LTerm_draw.draw_string ctx (rows / 2) ((cols - width - brackets_size) / 2) (Zed_string.append (Zed_string.append bl label) br) end class checkbutton initial_label initial_state = object(self) inherit button initial_label val mutable state = initial_state initializer self#on_event (fun ev -> let update () = state <- not state; (* checkbutton changes the state when clicked, so has to be redrawn *) self#queue_draw; exec_callbacks click_callbacks (); true in match ev with | LTerm_event.Key { control = false; meta = false; shift = false; code } when (code = Enter || code = space) -> update () | LTerm_event.Mouse m when m.button = Button1 -> update () | _ -> false); self#set_resource_class "checkbutton" method state = state method! draw ctx focused = let { rows; _ } = LTerm_draw.size ctx in let checked = Zed_string.unsafe_of_utf8 (if state then "[x] " else "[ ] ") in self#apply_style ctx focused; LTerm_draw.draw_string ctx (rows / 2) 0 (Zed_string.append checked label); end class type ['a] radio = object method on : unit method off : unit method id : 'a end class ['a] radiogroup = object val state_change_callbacks = LTerm_widget_callbacks.create () method on_state_change ?switch f = register switch state_change_callbacks f val mutable state = None val mutable buttons = [] method state = state method register_object (button : 'a radio) = (* Switch the first button added to group to 'on' state *) if buttons = [] then button#on else (); buttons <- button :: buttons; () method switch_to some_id = let switch_button button = if button#id = some_id then button#on else button#off in List.iter switch_button buttons; state <- Some some_id; exec_callbacks state_change_callbacks state end class ['a] radiobutton (group : 'a radiogroup) initial_label (id : 'a) = object(self) inherit button initial_label val mutable state = false initializer self#on_event (fun ev -> let update () = if state (* no need to do anything if the button is on already *) then () else group#switch_to id; (* event is consumed in any case *) exec_callbacks click_callbacks (); true in match ev with | LTerm_event.Key { control = false; meta = false; shift = false; code } when (code = Enter || code = space) -> update () | LTerm_event.Mouse m when m.button = Button1 -> update () | _ -> false); self#set_resource_class "radiobutton"; group#register_object (self :> 'a radio) method! draw ctx focused = let { rows; _ } = LTerm_draw.size ctx in let checked = Zed_string.unsafe_of_utf8 (if state then "(o) " else "( ) ") in self#apply_style ctx focused; LTerm_draw.draw_string ctx (rows / 2) 0 (Zed_string.append checked self#label_zed); method state = state method on = state <- true; self#queue_draw method off = state <- false; self#queue_draw method id = id end end lambda-term-3.1.0/src/lTerm_color_mappings.ml000066400000000000000000004366301366433625400212300ustar00rootroot00000000000000(* * lTerm_color_mappings.ml * ----------------------- * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* This file was generated by gen_color_mappings.ml. *) let data0 = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\003\003\003\003\003\003\003\003\003\ \003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\ \003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\ \003\003\003\003\003\003\003\003\003\003\004\004\004\004\004\004\ \004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\ \004\004\004\005\005\005\005\005\005\005\005\005\005\005\005\005" let data1 = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\003\003\003\003\003\003\ \003\003\003\003\003\003\003\003\003\003\004\004\004\004\004\004\ \004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005" let data2 = "\000\001\001\001\001\009\002\003\003\001\001\009\002\003\003\003\ \003\009\002\002\003\003\003\011\002\002\003\003\003\011\010\010\ \010\011\011\011\004\005\005\005\005\009\006\008\008\001\001\009\ \006\008\008\007\007\009\006\002\007\007\007\015\006\002\007\007\ \007\015\010\010\010\015\015\011\004\004\005\005\005\013\004\012\ \012\005\005\013\006\012\012\007\007\015\006\006\007\007\007\015\ \006\006\007\007\007\015\014\014\015\015\015\015\004\004\005\005\ \005\013\004\012\012\005\005\013\006\012\012\007\007\015\006\006\ \007\007\007\015\006\006\007\007\007\015\014\014\015\015\015\015\ \004\004\013\013\013\013\004\012\012\013\013\013\014\012\012\012\ \007\015\014\014\012\007\007\015\014\014\007\007\007\015\014\014\ \015\015\015\015\004\004\013\013\013\013\004\012\012\013\013\013\ \014\012\012\012\012\013\014\014\012\015\015\015\014\014\012\015\ \015\015\014\014\014\015\015\015" let data3 = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\001\ \001\001\001\001\001\001\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\002\ \002\002\002\002\002\002\002\002\003\003\003\003\003\003\003\003\ \003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\ \004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\004\ \004\004\004\004\004\004\004\005\005\005\005\005\005\005\005\005\ \005\005\005\005\005\005\005\005\005\005\005\005\005\005\006\006\ \006\006\006\006\006\006\006\006\006\006\006\006\006\006\006\006\ \006\006\006\006\007\007\007\007\007\007\007\007\007\007\007\008\ \008\008\008\008\008\008\008\008\008\008\008\008\009\009\009\009\ \009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\009\ \009\009\009\009\010\010\010\010\010\010\010\010\010\010\010\010" let data4 = "\016\032\032\032\032\032\048\048\048\064\064\020\036\052\032\032\ \032\048\048\048\064\064\020\040\036\036\052\052\052\068\068\068\ \068\020\020\036\036\036\052\052\052\052\068\068\020\020\040\036\ \036\036\052\052\052\068\068\020\020\040\040\036\036\056\052\052\ \052\068\024\024\040\040\040\056\056\056\056\072\072\024\024\044\ \040\040\040\056\056\056\072\072\024\024\044\040\040\040\056\056\ \056\072\072\028\028\044\044\044\040\060\060\060\076\076\028\028\ \044\044\044\044\060\060\060\076\076\017\033\049\032\032\032\048\ \048\048\064\064\021\080\053\032\032\032\048\048\048\064\064\025\ \041\057\057\052\052\048\048\048\064\064\020\020\057\036\036\052\ \052\068\068\068\068\020\020\040\036\036\036\052\052\052\068\068\ \020\020\040\040\036\036\052\052\052\052\068\024\024\024\040\040\ \040\056\056\056\072\068\024\024\024\044\040\040\056\056\056\072\ \072\024\024\024\044\040\040\056\056\056\072\072\028\028\028\044\ \044\040\060\060\060\076\072\028\028\028\044\044\044\044\060\060\ \060\076\017\034\033\033\049\049\049\065\065\065\065\022\038\054\ \054\049\049\048\048\048\064\064\021\042\081\082\053\053\053\069\ \069\069\069\021\042\082\082\053\053\053\069\069\069\069\025\025\ \041\041\057\057\073\073\073\073\073\025\025\041\041\057\057\057\ \073\073\073\073\025\024\041\041\061\057\057\077\077\073\073\029\ \024\045\045\061\061\077\077\077\077\073\029\024\045\045\061\061\ \077\077\077\077\073\029\028\045\045\061\061\061\077\077\077\077\ \029\028\045\045\061\061\061\061\061\077\077\017\017\033\033\033\ \049\049\049\049\065\065\017\017\054\033\033\049\049\065\065\065\ \065\021\042\082\082\053\053\053\069\069\069\069\021\021\082\082\ \083\053\053\053\053\069\069\021\021\041\083\083\057\053\053\053\ \069\069\025\025\041\041\057\057\057\073\073\073\073\025\025\041\ \041\041\057\057\057\057\073\073\025\029\045\041\041\061\057\057\ \057\073\073\025\029\045\041\041\061\057\057\057\077\073\029\029\ \045\045\045\061\061\061\077\077\077\029\029\045\045\045\061\061\ \061\061\077\077\017\017\034\033\033\033\049\049\049\065\065\017\ \017\034\033\033\033\049\049\049\065\065\022\022\038\038\054\054\ \070\070\070\070\070\021\021\038\083\083\054\053\053\053\069\069\ \021\021\042\083\083\084\053\053\053\069\069\021\021\042\042\084\ \084\053\053\053\069\069\025\025\046\041\041\041\057\057\057\073\ \073\025\025\046\041\041\041\057\057\057\073\073\025\025\046\041\ \041\041\057\057\057\073\073\029\029\046\045\045\045\061\061\061\ \077\077\029\029\046\045\045\045\061\061\061\077\077\017\017\034\ \034\033\033\050\049\049\049\065\017\017\034\034\033\033\049\049\ \049\049\065\022\022\038\038\054\054\054\070\070\070\070\022\022\ \038\038\054\054\054\070\070\070\070\021\021\042\042\084\084\054\ \053\053\069\069\021\021\042\042\084\084\085\053\053\053\069\026\ \025\042\042\042\085\085\057\053\053\069\025\025\046\046\041\041\ \057\057\057\057\073\025\025\046\046\041\041\041\057\057\057\073\ \025\025\046\046\045\041\041\057\057\057\073\029\029\046\046\045\ \045\045\061\061\061\077\018\018\034\034\034\050\050\050\050\066\ \066\018\018\018\034\034\034\050\050\050\066\065\022\018\038\038\ \055\054\054\071\071\070\070\022\022\038\038\038\054\054\054\054\ \070\070\022\022\043\038\038\038\054\054\054\070\070\026\022\042\ \042\038\085\085\054\054\053\069\026\026\042\042\042\085\085\058\ \086\074\074\026\026\047\042\042\042\058\058\086\074\074\026\026\ \047\042\042\042\086\086\086\074\074\030\030\046\046\046\041\062\ \062\062\078\078\030\029\046\046\046\045\062\062\062\078\078\018\ \018\035\034\034\034\050\050\050\066\066\018\018\018\035\034\034\ \050\050\050\066\066\023\018\039\039\055\055\071\071\071\071\070\ \022\023\039\038\038\055\054\054\054\070\070\022\022\043\038\038\ \038\054\054\054\070\070\022\022\043\043\038\038\054\054\054\054\ \070\026\026\047\042\042\042\058\058\086\074\074\026\026\047\042\ \042\042\058\058\086\087\074\026\026\047\042\042\042\086\086\086\ \087\074\030\030\047\046\046\042\062\087\087\087\078\030\030\046\ \046\046\046\062\062\062\078\078\018\018\035\034\034\034\050\050\ \050\066\066\018\018\018\035\034\034\050\050\050\066\066\023\018\ \039\039\055\055\071\071\071\071\070\022\023\039\038\038\055\054\ \054\054\071\070\022\022\043\038\038\038\054\054\054\070\070\022\ \022\043\043\038\038\054\054\054\054\070\026\026\047\042\042\038\ \086\086\086\075\074\026\026\047\042\042\042\086\086\086\087\074\ \026\026\047\042\042\042\086\086\086\087\074\030\030\047\047\046\ \042\063\087\087\087\074\030\030\046\046\046\046\062\062\062\062\ \078\019\019\035\035\035\034\051\051\051\067\067\019\019\019\035\ \035\034\051\051\051\067\066\023\019\039\039\055\055\055\071\071\ \071\071\023\023\039\039\039\055\055\055\071\071\071\023\023\043\ \039\039\039\055\055\055\071\071\022\022\043\043\039\038\038\054\ \054\054\070\027\027\043\043\043\038\059\059\059\075\075\027\027\ \047\043\043\042\059\087\087\087\075\027\027\047\047\043\042\059\ \087\087\087\074\031\031\047\047\047\042\063\087\087\087\079\031\ \030\047\047\047\046\063\063\062\079\079\019\019\035\035\035\035\ \051\051\051\067\067\019\019\019\035\035\035\035\051\051\051\067\ \023\019\039\039\055\055\055\055\055\071\071\023\023\039\039\039\ \055\055\055\055\071\071\023\023\043\039\039\039\055\055\055\071\ \071\023\023\043\043\039\039\039\055\055\055\071\027\023\043\043\ \043\039\059\059\059\075\075\027\027\043\043\043\043\059\059\059\ \075\075\027\027\043\043\043\043\059\059\059\059\075\031\027\047\ \047\047\043\063\063\059\079\079\031\031\047\047\047\047\063\063\ \063\079\079" let data5 = "\000\000\000\000\000\001\001\001\001\001\001\001\001\001\002\002\ \002\002\002\002\002\002\002\002\003\003\003\003\003\003\003\003\ \003\003\004\004\004\004\004\004\004\004\004\004\005\005\005\005\ \005\005\005\005\005\005\006\006\006\006\006\006\006\006\006\006\ \007\007\007\007\007\007\007\007\007\007\008\008\008\008\008\008\ \008\008\008\008\009\009\009\009\009\009\009\009\010\010\010\010\ \010\011\011\011\011\011\011\011\012\012\012\012\012\012\012\012\ \012\012\013\013\013\013\013\013\013\013\013\013\014\014\014\014\ \014\014\014\014\015\015\015\015\015\016\016\016\016\016\016\016\ \017\017\017\017\017\017\017\017\017\017\018\018\018\018\018\018\ \018\018\018\018\019\019\019\019\019\019\019\019\020\020\020\020\ \020\021\021\021\021\021\021\021\022\022\022\022\022\022\022\022\ \022\022\023\023\023\023\023\023\023\023\023\023\024\024\024\024\ \024\024\024\024\025\025\025\025\025\026\026\026\026\026\026\026\ \027\027\027\027\027\027\027\027\027\027\028\028\028\028\028\028\ \028\028\028\028\028\028\028\029\029\029\029\029\029\029\029\029" let data6 = "\016\052\052\052\052\052\052\052\052\052\052\052\052\088\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\022\058\ \094\052\052\052\052\052\052\052\052\052\052\088\088\088\088\088\ \124\124\124\124\124\160\160\160\160\160\196\196\022\064\058\094\ \094\052\052\052\052\052\052\052\052\088\088\088\088\088\124\124\ \124\124\124\160\160\160\160\160\196\196\022\022\064\058\058\094\ \094\094\052\052\052\052\052\088\088\088\088\088\124\124\124\124\ \124\160\160\160\160\160\196\196\022\022\064\058\058\058\094\094\ \094\094\130\130\130\130\088\088\088\088\124\124\124\124\124\160\ \160\160\160\160\196\196\022\022\022\064\058\058\058\094\094\094\ \094\094\130\130\130\130\130\130\130\166\166\166\166\166\166\202\ \202\202\202\202\022\022\022\064\064\058\058\058\094\094\094\094\ \094\130\130\130\130\130\130\130\166\166\166\166\166\166\202\202\ \202\202\022\022\022\064\064\064\058\058\058\094\094\094\094\094\ \094\130\130\130\130\130\130\166\166\166\166\166\166\202\202\202\ \022\022\022\022\064\064\064\058\058\058\058\094\094\094\094\094\ \094\130\130\130\130\130\166\166\166\166\166\202\202\202\022\022\ \022\022\064\064\064\064\058\058\058\058\094\094\094\094\094\130\ \130\130\130\130\130\166\166\166\166\166\202\202\022\022\022\022\ \070\064\064\064\058\058\058\058\058\094\094\094\094\094\130\130\ \130\130\130\166\166\166\166\166\202\202\022\022\022\022\070\064\ \064\064\064\058\058\058\058\094\094\094\094\094\130\130\130\130\ \130\166\166\166\166\166\202\202\022\022\022\022\070\070\064\064\ \064\064\058\058\058\100\094\094\094\094\094\130\130\130\130\130\ \166\166\166\166\166\202\028\028\028\028\070\070\070\064\064\064\ \064\064\100\100\100\100\100\136\136\136\136\136\130\172\172\172\ \172\166\208\208\028\028\028\028\028\070\070\064\064\064\064\064\ \064\100\100\100\100\136\136\136\136\136\136\172\172\172\172\172\ \208\208\028\028\028\028\028\070\070\070\064\064\064\064\064\100\ \100\100\100\100\136\136\136\136\136\172\172\172\172\172\208\208\ \028\028\028\028\028\070\070\070\064\064\064\064\064\100\100\100\ \100\100\136\136\136\136\136\172\172\172\172\172\208\208\028\028\ \028\028\028\070\070\070\070\070\064\064\064\106\106\100\100\100\ \142\136\136\136\136\136\172\172\172\172\172\208\034\034\034\034\ \034\070\070\070\070\070\070\070\064\106\106\106\106\142\142\142\ \142\142\136\178\178\178\178\172\214\214\034\034\034\034\034\076\ \070\070\070\070\070\070\070\106\106\106\106\106\142\142\142\142\ \142\178\178\178\178\178\214\214\034\034\034\034\034\076\076\070\ \070\070\070\070\070\106\106\106\106\106\142\142\142\142\142\178\ \178\178\178\178\214\214\034\034\034\034\034\076\076\076\070\070\ \070\070\070\106\106\106\106\106\142\142\142\142\142\178\178\178\ \178\178\214\214\034\034\034\034\034\076\076\076\076\070\070\070\ \070\070\106\106\106\106\106\142\142\142\142\184\178\178\178\178\ \220\214\040\040\040\040\040\076\076\076\076\076\076\076\070\112\ \112\112\112\106\148\148\148\148\184\184\184\184\184\178\220\220\ \040\040\040\040\040\076\076\076\076\076\076\076\076\112\112\112\ \112\112\148\148\148\148\148\184\184\184\184\184\220\220\040\040\ \040\040\040\082\076\076\076\076\076\076\076\112\112\112\112\112\ \148\148\148\148\148\184\184\184\184\184\220\220\040\040\040\040\ \040\082\082\076\076\076\076\076\076\112\112\112\112\112\148\148\ \148\148\148\184\184\184\184\184\220\220\040\040\040\040\040\082\ \082\082\082\076\076\076\076\076\112\112\112\112\112\148\148\148\ \148\148\184\184\184\184\226\220\046\046\046\046\046\082\082\082\ \082\082\082\082\076\118\118\118\118\112\154\154\154\154\190\190\ \190\190\190\226\226\226\046\046\046\046\046\082\082\082\082\082\ \082\082\082\118\118\118\118\118\154\154\154\154\154\190\190\190\ \190\190\226\226\017\053\089\052\052\052\052\052\052\052\052\052\ \052\088\088\088\088\088\124\124\124\124\124\160\160\160\160\160\ \196\196\023\232\095\052\052\052\052\052\052\052\052\052\052\088\ \088\088\088\088\124\124\124\124\124\160\160\160\160\160\196\196\ \029\065\101\094\052\052\052\052\052\052\052\052\052\088\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\022\022\ \064\058\058\094\052\052\052\052\052\052\052\088\088\088\088\088\ \124\124\124\124\124\160\160\160\160\160\196\196\022\022\022\058\ \058\058\094\094\094\052\052\052\052\088\088\088\088\088\124\124\ \124\124\124\160\160\160\160\160\196\196\022\022\022\064\058\058\ \058\094\094\094\094\094\130\130\130\130\130\130\124\124\124\124\ \124\160\160\160\160\160\196\196\022\022\022\022\064\058\058\058\ \094\094\094\094\094\130\130\130\130\130\130\166\166\166\166\166\ \166\166\202\202\202\202\022\022\022\022\064\064\058\058\058\094\ \094\094\094\094\130\130\130\130\130\130\166\166\166\166\166\166\ \166\202\202\202\022\022\022\022\064\064\064\058\058\058\094\094\ \094\094\094\094\130\130\130\130\130\130\166\166\166\166\166\202\ \202\202\022\022\022\022\022\064\064\064\058\058\058\058\094\094\ \094\094\094\130\130\130\130\130\166\166\166\166\166\166\202\202\ \022\022\022\022\022\064\064\064\064\058\058\058\058\094\094\094\ \094\094\130\130\130\130\130\166\166\166\166\166\202\202\022\022\ \022\022\022\064\064\064\064\058\058\058\058\094\094\094\094\094\ \130\130\130\130\130\166\166\166\166\166\202\202\022\022\022\022\ \022\070\064\064\064\064\058\058\058\100\094\094\094\094\094\130\ \130\130\130\130\166\166\166\166\166\202\028\028\028\028\028\070\ \070\064\064\064\064\064\100\100\100\100\094\094\136\136\136\130\ \130\172\172\166\166\166\208\202\028\028\028\028\028\070\070\070\ \064\064\064\064\064\100\100\100\100\136\136\136\136\136\172\172\ \172\172\172\172\208\208\028\028\028\028\028\070\070\070\064\064\ \064\064\064\100\100\100\100\100\136\136\136\136\136\172\172\172\ \172\172\208\208\028\028\028\028\028\070\070\070\070\064\064\064\ \064\064\100\100\100\100\136\136\136\136\136\172\172\172\172\172\ \208\208\028\028\028\028\028\070\070\070\070\070\064\064\064\064\ \106\100\100\100\142\136\136\136\136\136\172\172\172\172\172\208\ \034\034\034\034\034\034\070\070\070\070\070\070\064\106\106\106\ \106\142\142\142\142\136\136\178\178\178\172\172\214\208\034\034\ \034\034\034\034\076\070\070\070\070\070\070\106\106\106\106\106\ \142\142\142\142\142\178\178\178\178\178\214\214\034\034\034\034\ \034\034\076\076\070\070\070\070\070\106\106\106\106\106\142\142\ \142\142\142\178\178\178\178\178\214\214\034\034\034\034\034\034\ \076\076\070\070\070\070\070\070\106\106\106\106\106\142\142\142\ \142\178\178\178\178\178\214\214\034\034\034\034\034\034\076\076\ \076\076\070\070\070\070\112\106\106\106\106\142\142\142\142\184\ \178\178\178\178\220\214\040\040\040\040\040\040\076\076\076\076\ \076\076\070\112\112\112\112\106\148\148\148\148\184\184\184\184\ \178\178\220\220\040\040\040\040\040\040\076\076\076\076\076\076\ \076\112\112\112\112\112\148\148\148\148\148\184\184\184\184\184\ \220\220\040\040\040\040\040\040\076\076\076\076\076\076\076\076\ \112\112\112\112\148\148\148\148\148\184\184\184\184\184\220\220\ \040\040\040\040\040\040\082\076\076\076\076\076\076\076\112\112\ \112\112\112\148\148\148\148\148\184\184\184\184\220\220\040\040\ \040\040\040\040\082\082\082\076\076\076\076\076\112\112\112\112\ \112\148\148\148\148\148\184\184\184\184\226\220\046\046\046\046\ \046\046\082\082\082\082\082\082\076\118\118\118\118\112\154\154\ \154\154\190\190\190\190\190\226\226\226\046\046\046\046\046\046\ \082\082\082\082\082\082\082\082\118\118\118\118\118\154\154\154\ \154\190\190\190\190\190\226\226\017\054\053\089\089\052\052\052\ \052\052\052\052\052\088\088\088\088\088\124\124\124\124\124\160\ \160\160\160\160\196\196\024\060\096\089\052\052\052\052\052\052\ \052\052\052\088\088\088\088\088\124\124\124\124\124\160\160\160\ \160\160\196\196\023\066\233\234\095\052\052\052\052\052\052\052\ \052\088\088\088\088\088\124\124\124\124\124\160\160\160\160\160\ \196\196\029\029\234\234\095\095\052\052\052\052\052\052\052\088\ \088\088\088\088\124\124\124\124\124\160\160\160\160\160\196\196\ \029\022\065\065\101\101\094\052\052\052\052\052\052\088\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\022\022\ \022\065\101\058\058\094\094\094\094\130\052\088\088\088\088\088\ \124\124\124\124\124\160\160\160\160\160\196\196\022\022\022\022\ \064\058\058\058\094\094\094\094\094\130\130\130\130\130\130\166\ \166\166\166\166\160\160\160\160\196\196\022\022\022\022\022\064\ \058\058\058\094\094\094\094\094\130\130\130\130\130\130\166\166\ \166\166\166\166\202\202\202\202\022\022\022\022\022\064\064\058\ \058\058\094\094\094\094\094\130\130\130\130\130\130\166\166\166\ \166\166\166\202\202\202\022\022\022\022\022\064\064\064\058\058\ \058\058\094\094\094\094\094\130\130\130\130\130\166\166\166\166\ \166\202\202\202\022\022\022\022\022\064\064\064\064\058\058\058\ \058\094\094\094\094\130\130\130\130\130\130\166\166\166\166\166\ \202\202\022\022\022\022\022\070\064\064\064\058\058\058\058\094\ \094\094\094\094\130\130\130\130\130\166\166\166\166\166\202\202\ \022\022\022\022\022\022\064\064\064\064\058\058\058\100\094\094\ \094\094\094\130\130\130\130\166\166\166\166\166\202\202\028\028\ \028\028\028\028\070\064\064\064\064\064\100\100\100\100\094\094\ \136\136\130\130\130\130\166\166\166\166\166\202\028\028\028\028\ \028\028\070\070\064\064\064\064\064\100\100\100\100\136\136\136\ \136\136\172\172\172\172\172\166\208\208\028\028\028\028\028\028\ \070\070\070\064\064\064\064\100\100\100\100\100\136\136\136\136\ \136\172\172\172\172\172\208\208\028\028\028\028\028\028\070\070\ \070\064\064\064\064\064\100\100\100\100\136\136\136\136\136\172\ \172\172\172\172\208\208\028\028\028\028\028\028\070\070\070\070\ \070\064\064\064\106\100\100\100\142\136\136\136\136\136\172\172\ \172\172\208\208\034\034\034\034\034\034\070\070\070\070\070\070\ \064\106\106\106\106\142\142\142\142\136\136\178\178\172\172\172\ \214\208\034\034\034\034\034\034\076\070\070\070\070\070\070\106\ \106\106\106\106\142\142\142\142\136\178\178\178\178\172\214\214\ \034\034\034\034\034\034\076\076\070\070\070\070\070\070\106\106\ \106\106\142\142\142\142\142\178\178\178\178\178\214\214\034\034\ \034\034\034\034\076\076\076\070\070\070\070\070\106\106\106\106\ \106\142\142\142\142\178\178\178\178\178\214\214\034\034\034\034\ \034\034\076\076\076\076\070\070\070\070\112\106\106\106\106\106\ \142\142\142\184\178\178\178\178\220\214\040\040\040\040\040\040\ \076\076\076\076\076\076\076\070\112\112\112\106\148\148\148\148\ \184\184\184\184\178\178\220\214\040\040\040\040\040\040\040\076\ \076\076\076\076\076\076\112\112\112\112\148\148\148\148\148\184\ \184\184\184\178\220\220\040\040\040\040\040\040\040\076\076\076\ \076\076\076\076\112\112\112\112\112\148\148\148\148\184\184\184\ \184\184\220\220\040\040\040\040\040\040\040\082\076\076\076\076\ \076\076\112\112\112\112\112\148\148\148\148\148\184\184\184\184\ \220\220\040\040\040\040\040\040\040\082\082\082\076\076\076\076\ \076\112\112\112\112\112\148\148\148\148\148\184\184\184\226\220\ \046\046\046\046\046\046\046\082\082\082\082\082\082\076\118\118\ \118\118\154\154\154\154\190\190\190\190\190\226\226\226\046\046\ \046\046\046\046\046\082\082\082\082\082\082\082\118\118\118\118\ \118\154\154\154\154\154\190\190\190\190\226\226\017\017\054\053\ \053\089\089\089\052\052\052\052\052\088\088\088\088\088\124\124\ \124\124\124\160\160\160\160\160\196\196\017\017\054\053\053\089\ \052\052\052\052\052\052\052\088\088\088\088\088\124\124\124\124\ \124\160\160\160\160\160\196\196\024\024\234\234\096\095\052\052\ \052\052\052\052\052\088\088\088\088\088\124\124\124\124\124\160\ \160\160\160\160\196\196\023\023\234\234\235\095\095\095\052\052\ \052\052\052\088\088\088\088\088\124\124\124\124\124\160\160\160\ \160\160\196\196\023\023\066\235\235\101\095\095\052\052\052\052\ \052\088\088\088\088\088\124\124\124\124\124\160\160\160\160\160\ \196\196\029\029\065\065\065\101\101\137\137\137\052\052\052\088\ \088\088\088\088\124\124\124\124\124\160\160\160\160\160\196\196\ \029\022\022\065\065\101\101\101\137\094\137\137\137\130\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\029\022\ \022\065\065\107\101\101\058\094\094\094\094\130\130\130\130\130\ \130\166\166\166\166\166\166\160\160\202\202\196\022\022\022\022\ \022\107\107\058\058\058\094\094\094\094\130\130\130\130\130\130\ \166\166\166\166\166\166\166\202\202\202\022\022\022\022\022\107\ \064\064\058\058\058\058\094\094\094\094\130\130\130\130\130\130\ \166\166\166\166\166\202\202\202\022\022\022\022\022\022\107\064\ \064\058\058\058\058\094\094\094\094\130\130\130\130\130\166\166\ \166\166\166\202\202\202\022\022\022\022\022\022\107\064\064\058\ \058\058\058\094\094\094\094\130\130\130\130\130\166\166\166\166\ \166\166\202\202\022\022\022\022\022\022\107\064\064\064\058\058\ \058\100\094\094\094\094\130\130\130\130\130\166\166\166\166\166\ \202\202\028\028\028\028\028\028\070\070\064\064\064\064\100\100\ \100\094\094\094\094\130\130\130\130\130\166\166\166\166\202\202\ \028\028\028\028\028\028\028\070\070\064\064\064\064\100\100\100\ \100\136\136\136\136\136\130\172\172\166\166\166\208\202\028\028\ \028\028\028\028\028\070\070\064\064\064\064\064\100\100\100\100\ \136\136\136\136\136\172\172\172\172\172\208\208\028\028\028\028\ \028\028\028\070\070\070\064\064\064\064\100\100\100\100\136\136\ \136\136\136\172\172\172\172\172\208\208\028\028\028\028\028\028\ \028\070\070\070\070\070\064\064\106\100\100\100\142\136\136\136\ \136\172\172\172\172\172\208\208\034\034\034\034\034\034\034\070\ \070\070\070\070\070\064\106\106\106\142\142\142\136\136\136\178\ \178\172\172\172\172\208\034\034\034\034\034\034\034\076\070\070\ \070\070\070\070\106\106\106\106\142\142\142\142\136\178\178\178\ \178\172\214\214\034\034\034\034\034\034\034\076\076\070\070\070\ \070\070\106\106\106\106\106\142\142\142\142\178\178\178\178\178\ \214\214\034\034\034\034\034\034\034\076\076\070\070\070\070\070\ \106\106\106\106\106\142\142\142\142\178\178\178\178\178\214\214\ \034\034\034\034\034\034\034\076\076\076\076\076\070\070\070\106\ \106\106\106\106\142\142\142\184\178\178\178\178\214\214\040\040\ \040\040\040\040\040\076\076\076\076\076\076\070\112\112\112\112\ \148\148\148\148\184\184\184\184\178\178\220\214\040\040\040\040\ \040\040\040\076\076\076\076\076\076\076\112\112\112\112\148\148\ \148\148\148\184\184\184\184\178\220\220\040\040\040\040\040\040\ \040\040\076\076\076\076\076\076\076\112\112\112\112\148\148\148\ \148\184\184\184\184\184\220\220\040\040\040\040\040\040\040\040\ \076\076\076\076\076\076\076\112\112\112\112\148\148\148\148\148\ \184\184\184\184\220\220\040\040\040\040\040\040\040\082\082\082\ \082\076\076\076\076\112\112\112\112\112\148\148\148\148\148\184\ \184\184\226\220\046\046\046\046\046\046\046\082\082\082\082\082\ \082\082\118\118\118\118\112\154\154\154\154\190\190\190\190\226\ \226\226\046\046\046\046\046\046\046\046\082\082\082\082\082\082\ \082\118\118\118\118\154\154\154\154\154\190\190\190\190\226\226\ \017\017\054\053\053\053\089\089\089\089\125\125\125\125\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\017\017\ \017\053\053\053\089\089\089\052\052\052\052\088\088\088\088\088\ \124\124\124\124\124\160\160\160\160\160\196\196\024\017\060\096\ \096\096\089\052\052\052\052\052\052\088\088\088\088\088\124\124\ \124\124\124\160\160\160\160\160\196\196\023\023\060\235\235\096\ \095\095\052\052\052\052\052\088\088\088\088\088\124\124\124\124\ \124\160\160\160\160\160\196\196\023\023\066\235\235\236\095\095\ \095\095\095\131\131\131\088\088\088\088\124\124\124\124\124\160\ \160\160\160\160\196\196\023\023\066\066\236\236\237\095\095\095\ \095\131\131\131\088\088\088\088\124\124\124\124\124\160\160\160\ \160\160\196\196\029\029\029\065\065\237\101\101\095\137\137\137\ \137\137\131\131\131\088\124\124\124\124\124\160\160\160\160\160\ \196\196\029\029\022\065\065\065\101\101\101\137\137\137\137\137\ \137\137\137\173\173\173\173\173\173\160\160\160\160\160\196\196\ \029\029\022\022\065\065\065\101\101\101\137\137\137\137\137\137\ \137\137\173\173\173\173\173\173\209\209\209\209\209\209\029\022\ \022\022\065\065\107\107\101\101\101\143\137\137\137\137\137\130\ \130\130\130\166\166\166\166\166\166\202\202\202\035\022\022\022\ \065\065\107\107\107\101\101\143\143\094\094\094\094\130\130\130\ \130\130\166\166\166\166\166\202\202\202\035\022\022\022\071\071\ \107\107\107\143\143\143\143\094\094\094\094\130\130\130\130\130\ \166\166\166\166\166\202\202\202\035\022\022\022\071\071\107\107\ \107\107\143\143\143\143\094\094\094\094\130\130\130\130\130\166\ \166\166\166\166\202\202\035\028\028\028\071\071\071\107\107\107\ \064\064\143\143\100\094\094\094\094\130\130\130\130\166\166\166\ \166\166\202\202\028\028\028\028\028\028\071\107\107\107\064\064\ \064\100\100\100\100\136\136\136\130\130\130\172\166\166\166\166\ \166\202\028\028\028\028\028\028\071\107\107\107\064\064\064\064\ \100\100\100\100\136\136\136\136\172\172\172\172\172\166\208\202\ \028\028\028\028\028\028\071\107\107\107\064\064\064\064\100\100\ \100\100\136\136\136\136\136\172\172\172\172\166\208\208\028\028\ \028\028\028\028\028\113\107\070\070\070\064\064\106\100\100\100\ \142\136\136\136\136\172\172\172\172\172\208\208\034\034\034\034\ \034\034\034\113\113\070\070\070\070\064\106\106\106\142\142\142\ \136\136\136\178\172\172\172\172\172\208\034\034\034\034\034\034\ \034\113\113\070\070\070\070\070\106\106\106\106\142\142\142\142\ \136\178\178\178\178\172\214\208\034\034\034\034\034\034\034\113\ \113\070\070\070\070\070\070\106\106\106\106\142\142\142\142\178\ \178\178\178\178\214\214\034\034\034\034\034\034\034\113\113\076\ \070\070\070\070\070\106\106\106\106\142\142\142\142\178\178\178\ \178\178\214\214\034\034\034\034\034\034\034\113\113\076\076\076\ \070\070\070\112\106\106\106\106\142\142\142\184\178\178\178\178\ \214\214\040\040\040\040\040\040\040\040\113\076\076\076\076\076\ \112\112\112\112\148\148\148\148\184\184\184\178\178\178\220\214\ \040\040\040\040\040\040\040\040\119\076\076\076\076\076\076\112\ \112\112\112\148\148\148\148\184\184\184\184\178\220\220\040\040\ \040\040\040\040\040\040\119\076\076\076\076\076\076\112\112\112\ \112\148\148\148\148\148\184\184\184\184\220\220\040\040\040\040\ \040\040\040\040\119\076\076\076\076\076\076\112\112\112\112\148\ \148\148\148\148\184\184\184\184\220\220\040\040\040\040\040\040\ \040\040\119\082\082\082\076\076\076\076\076\112\112\112\148\148\ \148\148\148\184\184\184\226\220\046\046\046\046\046\046\046\046\ \119\082\082\082\082\082\076\118\118\118\112\154\154\154\154\190\ \190\190\190\226\226\226\046\046\046\046\046\046\046\046\119\082\ \082\082\082\082\082\082\118\118\118\118\154\154\154\154\190\190\ \190\190\226\226\017\017\017\054\053\053\053\089\089\089\089\089\ \125\125\125\125\125\125\125\161\161\161\161\161\161\197\197\197\ \197\197\017\017\017\054\053\053\053\089\089\089\089\089\125\125\ \125\125\125\125\124\124\124\124\124\160\160\160\160\160\196\196\ \017\017\017\060\096\053\053\089\089\089\089\125\052\088\088\088\ \088\088\124\124\124\124\124\160\160\160\160\160\196\196\024\024\ \060\060\096\096\096\132\132\132\052\052\052\088\088\088\088\088\ \124\124\124\124\124\160\160\160\160\160\196\196\023\023\066\060\ \236\236\237\095\095\095\095\131\131\131\088\088\088\088\124\124\ \124\124\124\160\160\160\160\160\196\196\023\023\023\066\236\236\ \237\095\095\095\095\095\095\131\131\131\131\131\131\167\167\167\ \167\167\167\203\203\203\203\203\023\023\023\066\237\237\237\238\ \095\095\095\095\095\131\131\131\131\131\131\167\167\167\167\167\ \167\203\203\203\203\203\029\029\029\072\065\065\238\101\101\095\ \095\095\137\137\137\131\131\131\131\173\167\167\167\167\167\203\ \203\203\203\203\029\029\029\072\065\065\065\101\101\101\101\101\ \137\137\137\137\137\137\173\173\173\173\173\173\173\209\209\209\ \209\209\029\029\029\072\065\065\065\065\101\101\101\101\137\137\ \137\137\137\137\137\173\173\173\173\173\173\209\209\209\209\209\ \029\029\029\022\065\065\065\065\101\101\101\101\101\137\137\137\ \137\137\137\173\173\173\173\173\173\209\209\209\209\209\029\029\ \035\022\071\065\065\065\101\101\101\101\101\137\137\137\137\137\ \137\173\173\173\173\173\173\209\209\209\209\209\035\035\022\022\ \071\065\065\107\107\107\101\101\101\143\143\137\137\137\137\137\ \173\173\173\173\173\173\173\209\209\209\035\035\028\028\071\071\ \071\107\107\107\107\107\143\143\143\143\143\137\137\179\179\179\ \173\173\173\166\215\215\209\202\035\035\028\028\028\071\071\071\ \107\107\107\107\107\143\143\143\143\143\179\179\179\179\179\179\ \215\215\215\215\215\202\035\035\028\028\028\071\071\071\107\107\ \107\107\107\143\143\143\143\143\179\179\179\179\179\179\179\215\ \215\215\215\202\035\035\028\028\028\071\071\071\107\107\107\107\ \107\143\143\143\143\143\143\179\179\179\179\179\179\215\215\215\ \215\215\035\035\028\028\028\071\071\071\107\107\107\107\107\107\ \143\143\143\143\143\185\179\179\179\179\179\179\215\215\215\215\ \035\034\034\034\034\071\071\071\113\107\107\107\107\107\149\149\ \143\143\143\185\185\185\179\179\179\179\172\215\215\215\041\034\ \034\034\034\077\077\077\113\113\113\113\107\149\149\149\149\185\ \185\185\185\185\185\179\179\221\221\221\221\215\041\034\034\034\ \034\077\077\077\113\113\113\113\113\149\149\149\149\149\185\185\ \185\185\185\185\179\221\221\221\221\214\041\034\034\034\034\077\ \077\077\113\113\113\113\113\149\149\149\149\149\185\185\185\185\ \185\185\178\221\221\221\221\214\041\034\034\034\034\077\077\077\ \113\113\113\113\113\149\149\149\149\149\149\185\185\185\185\185\ \185\178\221\221\221\214\041\040\040\040\040\077\077\077\113\113\ \113\113\113\113\149\149\149\149\149\149\185\185\185\185\185\227\ \227\221\221\221\041\040\040\040\040\077\077\077\113\113\113\113\ \113\113\155\149\149\149\149\149\149\148\185\185\185\227\227\227\ \221\221\047\040\040\040\040\083\083\083\119\119\119\119\113\076\ \155\155\155\149\149\191\191\191\148\227\227\227\227\227\227\221\ \047\040\040\040\040\083\083\083\119\119\119\119\113\155\155\155\ \155\155\112\191\191\191\191\227\227\227\227\227\227\220\047\040\ \040\040\040\083\083\083\119\119\119\119\119\155\155\155\155\155\ \155\191\191\191\191\191\227\227\227\227\227\220\047\046\046\046\ \046\083\083\083\119\119\119\119\119\119\155\155\155\155\155\191\ \191\191\191\191\191\227\227\227\227\227\047\046\046\046\046\083\ \083\083\119\119\119\119\119\082\082\082\155\155\155\155\154\154\ \154\191\191\191\190\190\227\227\017\017\017\054\054\053\053\053\ \089\089\089\089\089\125\125\125\125\125\125\125\161\161\161\161\ \161\161\197\197\197\197\017\017\017\017\054\053\053\053\089\089\ \089\089\089\125\125\125\125\125\125\161\161\161\161\161\161\161\ \197\197\197\197\017\017\017\017\054\053\053\053\089\089\089\089\ \089\125\125\125\125\125\125\161\161\161\161\161\160\160\160\160\ \196\196\024\017\017\060\060\096\096\096\132\089\132\132\132\125\ \088\088\088\088\124\124\124\124\124\160\160\160\160\160\196\196\ \024\024\024\060\060\237\096\096\096\132\132\132\132\131\131\131\ \131\088\124\124\124\124\124\160\160\160\160\160\196\196\023\023\ \023\066\237\237\237\238\095\095\095\095\095\131\131\131\131\131\ \131\167\167\167\167\167\167\203\203\203\203\203\023\023\023\066\ \066\237\237\238\095\095\095\095\095\095\131\131\131\131\131\131\ \167\167\167\167\167\167\167\203\203\203\023\023\023\066\066\238\ \238\238\239\095\095\095\095\095\131\131\131\131\131\131\167\167\ \167\167\167\167\167\203\203\203\029\029\029\072\066\065\065\239\ \101\101\101\101\095\137\137\137\137\131\131\131\173\173\167\167\ \167\167\167\203\203\203\029\029\029\029\072\065\065\065\101\101\ \101\101\101\137\137\137\137\137\137\173\173\173\173\173\173\209\ \209\209\209\209\029\029\029\072\072\065\065\065\101\101\101\101\ \101\137\137\137\137\137\137\173\173\173\173\173\173\173\209\209\ \209\209\029\029\029\072\072\065\065\065\065\101\101\101\101\137\ \137\137\137\137\137\173\173\173\173\173\173\173\209\209\209\209\ \029\029\029\072\072\065\065\065\065\101\101\101\101\101\137\137\ \137\137\137\137\173\173\173\173\173\173\173\209\209\209\035\035\ \035\035\072\071\065\065\107\107\107\107\101\101\143\143\137\137\ \137\137\137\173\173\173\173\173\173\209\209\209\035\035\035\028\ \071\071\071\071\107\107\107\107\107\143\143\143\143\143\137\179\ \179\179\179\173\173\173\215\215\215\209\035\035\035\028\071\071\ \071\071\107\107\107\107\107\143\143\143\143\143\143\179\179\179\ \179\179\179\215\215\215\215\215\035\035\035\028\071\071\071\071\ \071\107\107\107\107\107\143\143\143\143\143\179\179\179\179\179\ \179\215\215\215\215\215\035\035\035\028\028\071\071\071\071\107\ \107\107\107\107\143\143\143\143\143\143\179\179\179\179\179\179\ \215\215\215\215\035\035\035\034\034\071\071\071\071\107\107\107\ \107\107\107\143\143\143\143\143\185\185\179\179\179\179\179\215\ \215\215\035\041\041\034\034\077\071\071\071\113\113\113\107\107\ \149\149\149\143\143\143\185\185\185\179\179\179\179\221\215\215\ \041\041\041\034\034\077\077\077\113\113\113\113\113\107\149\149\ \149\149\185\185\185\185\185\185\179\179\221\221\221\215\041\041\ \041\034\034\077\077\077\077\113\113\113\113\149\149\149\149\149\ \185\185\185\185\185\185\179\179\221\221\221\215\041\041\041\034\ \034\077\077\077\077\113\113\113\113\113\149\149\149\149\149\185\ \185\185\185\185\185\221\221\221\221\221\041\041\041\040\040\077\ \077\077\077\113\113\113\113\113\149\149\149\149\149\149\185\185\ \185\185\185\185\185\221\221\221\041\041\040\040\040\077\077\077\ \077\113\113\113\113\113\113\149\149\149\149\149\149\149\185\185\ \185\185\185\227\221\221\041\041\040\040\040\083\077\077\077\119\ \113\113\113\113\113\155\155\149\149\149\149\149\191\185\185\185\ \185\227\221\221\047\047\040\040\040\083\077\077\077\119\119\119\ \113\113\155\155\155\155\149\149\191\191\191\185\185\185\185\227\ \227\221\047\047\040\040\040\083\083\083\083\119\119\119\119\119\ \155\155\155\155\155\191\191\191\191\191\227\227\227\227\227\221\ \047\047\046\046\046\083\083\083\083\119\119\119\119\119\155\155\ \155\155\155\155\191\191\191\191\191\191\227\227\227\227\047\047\ \046\046\046\083\083\083\083\119\119\119\119\119\119\155\155\155\ \155\155\155\155\191\191\191\191\191\191\227\227\017\017\017\054\ \054\054\053\053\053\089\089\089\089\089\089\125\125\125\125\125\ \125\161\161\161\161\161\161\197\197\197\017\017\017\017\054\054\ \053\053\053\089\089\089\089\089\125\125\125\125\125\125\161\161\ \161\161\161\161\161\197\197\197\017\017\017\017\017\054\053\053\ \053\089\089\089\089\089\125\125\125\125\125\125\161\161\161\161\ \161\161\197\197\197\197\024\017\017\060\060\097\096\096\053\089\ \089\089\089\125\125\125\125\125\125\161\161\161\161\161\161\160\ \160\197\197\196\024\024\017\060\060\060\096\096\096\132\132\132\ \132\132\132\132\132\168\168\168\168\168\168\160\160\160\160\160\ \196\196\024\024\024\067\060\060\238\096\096\096\095\095\132\132\ \131\131\131\131\131\168\167\167\167\167\167\203\203\203\203\203\ \023\023\023\066\066\238\238\238\239\095\095\095\095\095\131\131\ \131\131\131\131\167\167\167\167\167\167\167\203\203\203\023\023\ \023\066\066\066\238\238\239\095\095\095\095\095\095\131\131\131\ \131\131\131\167\167\167\167\167\167\203\203\203\023\023\023\023\ \066\066\239\239\239\240\095\095\095\095\095\131\131\131\131\131\ \131\167\167\167\167\167\167\203\203\203\029\029\029\029\072\066\ \065\065\240\101\101\101\101\095\137\137\137\137\131\131\131\173\ \173\167\167\167\167\209\203\203\029\029\029\029\072\065\065\065\ \065\101\101\101\101\101\137\137\137\137\137\137\173\173\173\173\ \173\173\173\209\209\209\029\029\029\029\072\065\065\065\065\101\ \101\101\101\101\137\137\137\137\137\137\173\173\173\173\173\173\ \173\209\209\209\029\029\029\029\072\072\065\065\065\065\101\101\ \101\101\137\137\137\137\137\137\173\173\173\173\173\173\173\209\ \209\209\029\029\029\035\072\072\065\065\065\065\101\101\101\101\ \101\137\137\137\137\137\137\137\173\173\173\173\173\209\209\209\ \029\035\035\035\072\072\071\065\065\107\107\107\107\101\101\143\ \143\143\137\137\137\137\173\173\173\173\173\173\209\209\035\035\ \035\035\072\071\071\071\071\107\107\107\107\107\143\143\143\143\ \137\137\179\179\179\179\173\173\173\215\215\209\035\035\035\035\ \072\071\071\071\071\107\107\107\107\107\143\143\143\143\143\137\ \179\179\179\179\173\173\173\215\215\209\035\035\035\035\078\071\ \071\071\071\071\107\107\107\107\107\143\143\143\143\143\179\179\ \179\179\179\179\179\215\215\215\035\035\035\035\078\071\071\071\ \071\071\107\107\107\107\107\107\143\143\143\143\143\179\179\179\ \179\179\179\215\215\215\035\035\035\041\078\078\071\071\071\071\ \107\107\107\107\107\107\107\143\143\143\143\185\185\179\179\179\ \179\179\215\215\035\041\041\041\078\077\077\071\071\071\113\113\ \113\107\107\149\149\149\143\143\143\185\185\179\179\179\179\221\ \221\215\041\041\041\041\078\077\077\077\077\113\113\113\113\107\ \107\149\149\149\149\185\185\185\185\185\179\179\179\221\221\215\ \041\041\041\041\078\077\077\077\077\077\113\113\113\113\149\149\ \149\149\149\185\185\185\185\185\185\179\179\221\221\221\041\041\ \041\041\040\077\077\077\077\077\113\113\113\113\113\149\149\149\ \149\149\149\185\185\185\185\185\185\221\221\221\041\041\041\041\ \040\077\077\077\077\077\113\113\113\113\113\113\149\149\149\149\ \149\149\185\185\185\185\185\227\221\221\041\041\041\040\040\083\ \077\077\077\077\113\113\113\113\113\113\113\149\149\149\149\149\ \149\185\185\185\185\227\221\221\041\041\047\040\040\083\077\077\ \077\077\113\113\113\113\113\113\113\149\149\149\149\149\149\185\ \185\185\185\227\227\221\047\047\047\047\040\083\083\083\083\119\ \119\119\119\119\113\155\155\155\155\149\191\191\191\191\227\227\ \227\227\227\221\047\047\047\047\046\083\083\083\083\083\119\119\ \119\119\119\155\155\155\155\155\191\191\191\191\191\191\227\227\ \227\227\047\047\047\046\046\083\083\083\083\083\119\119\119\119\ \119\119\119\155\155\155\155\155\191\191\191\191\191\191\227\227\ \017\017\017\017\054\054\054\053\053\053\053\089\089\089\089\089\ \089\125\125\125\125\125\161\161\161\161\161\197\197\197\017\017\ \017\017\054\054\054\053\053\053\089\089\089\089\089\089\125\125\ \125\125\125\125\161\161\161\161\161\197\197\197\017\017\017\017\ \017\054\054\053\053\053\089\089\089\089\089\125\125\125\125\125\ \125\161\161\161\161\161\161\197\197\197\017\017\017\017\017\097\ \097\053\053\053\089\089\089\089\125\125\125\125\125\125\161\161\ \161\161\161\161\161\197\197\197\024\024\017\017\060\060\096\096\ \096\096\132\132\132\132\132\132\132\132\168\168\168\168\168\168\ \204\204\204\204\204\204\024\024\024\067\060\060\060\096\096\096\ \096\096\132\132\132\132\132\132\168\168\168\168\168\168\168\204\ \204\204\204\204\024\024\024\067\060\060\060\239\096\096\096\096\ \095\132\132\132\131\131\131\131\168\168\167\167\167\167\167\203\ \203\203\023\023\023\023\066\066\239\239\239\240\095\095\095\095\ \095\131\131\131\131\131\131\167\167\167\167\167\167\203\203\203\ \023\023\023\023\066\066\066\239\239\240\059\095\095\095\095\095\ \095\131\131\131\131\131\167\167\167\167\167\203\203\203\023\023\ \023\023\066\066\066\240\240\240\059\241\095\095\095\095\095\131\ \131\131\131\131\167\167\167\167\167\203\203\203\023\029\029\029\ \072\066\066\065\059\059\059\101\101\095\095\095\095\131\131\131\ \131\131\167\167\167\167\167\167\203\203\029\029\029\029\072\066\ \066\065\065\241\101\101\101\095\095\137\137\137\137\131\131\131\ \173\173\167\167\167\209\209\203\029\029\029\029\072\072\065\065\ \065\065\101\101\101\101\101\137\137\137\137\137\137\173\173\173\ \173\173\173\209\209\209\029\029\029\029\072\072\072\065\065\065\ \065\065\101\101\101\101\137\137\137\137\137\137\173\173\173\173\ \173\209\209\209\029\029\029\035\072\072\072\065\065\065\065\065\ \101\101\101\101\101\137\137\137\137\137\173\173\173\173\173\173\ \209\209\029\029\035\035\072\072\072\071\065\065\065\107\107\101\ \101\101\101\143\137\137\137\137\137\173\173\173\173\173\209\209\ \029\035\035\035\072\072\071\071\065\065\065\107\107\107\101\101\ \101\143\143\137\137\137\179\173\173\173\173\173\215\209\035\035\ \035\035\072\072\071\071\071\071\071\107\107\107\107\143\143\143\ \143\143\137\179\179\179\179\179\173\215\215\215\035\035\035\035\ \078\078\071\071\071\071\071\071\107\107\107\107\107\143\143\143\ \143\143\179\179\179\179\179\215\215\215\035\035\035\035\078\078\ \071\071\071\071\071\071\107\107\107\107\107\143\143\143\143\143\ \179\179\179\179\179\179\215\215\035\035\035\041\078\078\078\071\ \071\071\071\071\107\107\107\107\107\107\143\143\143\143\185\179\ \179\179\179\179\215\215\035\035\041\041\078\078\078\077\071\071\ \071\071\113\107\107\107\107\149\143\143\143\143\185\185\179\179\ \179\179\221\215\041\041\041\041\078\078\077\077\077\077\077\113\ \113\113\113\107\149\149\149\149\185\185\185\185\185\179\179\221\ \221\215\041\041\041\041\078\078\077\077\077\077\077\077\113\113\ \113\113\149\149\149\149\149\149\185\185\185\185\185\221\221\221\ \041\041\041\041\084\078\077\077\077\077\077\077\113\113\113\113\ \113\149\149\149\149\149\185\185\185\185\185\221\221\221\041\041\ \041\041\084\084\077\077\077\077\077\077\113\113\113\113\113\149\ \149\149\149\149\149\185\185\185\185\227\221\221\041\041\041\041\ \084\084\077\077\077\077\077\077\113\113\113\113\113\149\149\149\ \149\149\149\185\185\185\185\227\227\221\047\047\047\047\084\084\ \083\083\083\083\077\119\119\119\113\113\113\155\155\149\149\149\ \191\191\191\227\227\227\227\221\047\047\047\047\084\084\083\083\ \083\083\083\083\119\119\119\119\155\155\155\155\155\191\191\191\ \191\191\227\227\227\227\047\047\047\047\084\084\083\083\083\083\ \083\083\119\119\119\119\119\155\155\155\155\155\155\191\191\191\ \191\191\227\227\017\017\017\017\054\054\054\054\053\053\053\053\ \089\089\089\089\089\125\125\125\125\125\125\161\161\161\161\161\ \197\197\017\017\017\017\017\054\054\054\053\053\053\053\089\089\ \089\089\089\125\125\125\125\125\161\161\161\161\161\161\197\197\ \017\017\017\017\017\054\054\054\053\053\053\053\089\089\089\089\ \089\125\125\125\125\125\161\161\161\161\161\197\197\197\017\017\ \017\017\017\097\054\054\053\053\053\053\089\089\089\089\125\125\ \125\125\125\125\161\161\161\161\161\197\197\197\024\017\017\017\ \060\060\097\097\096\096\096\133\132\132\132\132\132\125\125\125\ \125\161\161\161\161\161\161\197\197\197\024\024\024\067\060\060\ \060\096\096\096\096\096\132\132\132\132\132\132\132\168\168\168\ \168\168\168\204\204\204\204\204\024\024\024\024\067\060\060\060\ \096\096\096\096\096\132\132\132\132\132\132\168\168\168\168\168\ \168\204\204\204\204\204\024\024\024\024\067\060\060\060\240\096\ \096\096\096\095\132\132\132\131\131\131\131\168\168\167\167\167\ \167\204\203\203\023\023\023\023\066\066\066\240\240\240\059\241\ \095\095\095\095\095\131\131\131\131\131\167\167\167\167\167\203\ \203\203\023\023\023\023\066\066\066\066\240\240\059\241\095\095\ \095\095\095\131\131\131\131\131\131\167\167\167\167\167\203\203\ \023\023\023\023\066\066\066\066\059\059\059\241\095\095\095\095\ \095\095\131\131\131\131\131\167\167\167\167\167\203\203\023\023\ \023\023\073\066\066\066\241\241\241\241\242\095\095\095\095\095\ \131\131\131\131\131\167\167\167\167\167\203\203\029\029\029\029\ \072\072\066\066\065\065\065\242\101\101\095\095\095\137\137\137\ \131\131\173\173\173\167\167\167\209\203\029\029\029\029\072\072\ \072\065\065\065\065\065\101\101\101\101\101\137\137\137\137\137\ \173\173\173\173\173\173\209\209\029\029\029\029\072\072\072\072\ \065\065\065\065\065\101\101\101\101\137\137\137\137\137\137\173\ \173\173\173\173\209\209\029\029\029\029\072\072\072\072\065\065\ \065\065\065\101\101\101\101\101\137\137\137\137\137\173\173\173\ \173\173\209\209\029\029\029\035\072\072\072\072\065\065\065\065\ \065\101\101\101\101\101\137\137\137\137\137\173\173\173\173\173\ \209\209\035\035\035\035\035\072\072\072\071\071\065\065\107\107\ \107\101\101\143\143\143\137\137\137\179\173\173\173\173\215\209\ \035\035\035\035\035\072\072\071\071\071\071\071\107\107\107\107\ \107\143\143\143\143\143\179\179\179\179\179\215\215\215\035\035\ \035\035\035\078\078\071\071\071\071\071\071\107\107\107\107\107\ \143\143\143\143\179\179\179\179\179\179\215\215\035\035\035\035\ \035\078\078\071\071\071\071\071\071\107\107\107\107\107\143\143\ \143\143\143\179\179\179\179\179\215\215\035\035\035\035\041\078\ \078\078\071\071\071\071\071\107\107\107\107\107\143\143\143\143\ \143\179\179\179\179\179\215\215\035\041\041\041\041\078\078\078\ \077\071\071\071\113\113\107\107\107\107\149\149\143\143\143\185\ \185\179\179\179\221\215\041\041\041\041\041\078\078\077\077\077\ \077\077\113\113\113\113\113\149\149\149\149\149\185\185\185\185\ \185\179\221\221\041\041\041\041\041\078\078\077\077\077\077\077\ \077\113\113\113\113\149\149\149\149\149\185\185\185\185\185\185\ \221\221\041\041\041\041\041\084\084\077\077\077\077\077\077\113\ \113\113\113\113\149\149\149\149\149\185\185\185\185\185\221\221\ \041\041\041\041\041\084\084\077\077\077\077\077\077\113\113\113\ \113\113\149\149\149\149\149\185\185\185\185\185\221\221\041\041\ \047\047\047\084\084\084\083\077\077\077\077\113\113\113\113\113\ \155\149\149\149\149\149\185\185\185\185\227\221\047\047\047\047\ \047\084\084\083\083\083\083\083\119\119\119\119\119\155\155\155\ \155\155\191\191\191\191\191\227\227\227\047\047\047\047\047\084\ \084\083\083\083\083\083\083\119\119\119\119\119\155\155\155\155\ \155\191\191\191\191\191\227\227\017\017\017\017\055\054\054\054\ \053\053\053\053\053\089\089\089\089\089\125\125\125\125\125\161\ \161\161\161\161\197\197\017\017\017\017\017\054\054\054\054\053\ \053\053\053\089\089\089\089\089\125\125\125\125\125\161\161\161\ \161\161\197\197\017\017\017\017\017\054\054\054\054\053\053\053\ \053\089\089\089\089\125\125\125\125\125\125\161\161\161\161\161\ \197\197\017\017\017\017\017\017\097\054\054\053\053\053\053\089\ \089\089\089\125\125\125\125\125\161\161\161\161\161\197\197\197\ \025\017\017\017\060\060\097\097\097\096\096\133\133\089\089\089\ \089\125\125\125\125\125\161\161\161\161\161\197\197\197\024\024\ \024\017\060\060\060\060\096\096\096\096\096\132\132\132\132\132\ \132\168\168\168\168\168\168\204\204\204\204\204\024\024\024\067\ \067\060\060\060\096\096\096\096\096\132\132\132\132\132\132\168\ \168\168\168\168\168\168\204\204\204\204\024\024\024\024\067\060\ \060\060\060\096\096\096\096\096\132\132\132\132\132\132\168\168\ \168\168\168\168\168\204\204\204\023\024\024\024\067\066\066\060\ \059\059\059\096\096\095\095\095\095\131\131\131\131\131\167\167\ \167\167\167\167\203\203\023\023\023\023\066\066\066\066\059\059\ \059\241\095\095\095\095\095\095\131\131\131\131\131\167\167\167\ \167\167\203\203\023\023\023\023\066\066\066\066\059\059\059\241\ \242\095\095\095\095\095\131\131\131\131\131\167\167\167\167\167\ \203\203\023\023\023\023\073\066\066\066\066\241\241\241\242\095\ \095\095\095\095\131\131\131\131\131\167\167\167\167\167\203\203\ \023\023\023\023\073\066\066\066\066\065\242\242\242\101\095\095\ \095\095\131\131\131\131\131\167\167\167\167\167\203\203\029\029\ \029\029\029\072\072\066\065\065\065\065\101\101\101\101\101\137\ \137\137\137\137\173\173\173\173\173\173\209\209\029\029\029\029\ \029\072\072\072\065\065\065\065\065\101\101\101\101\101\137\137\ \137\137\137\173\173\173\173\173\209\209\029\029\029\029\029\072\ \072\072\065\065\065\065\065\101\101\101\101\101\137\137\137\137\ \137\173\173\173\173\173\209\209\029\029\029\029\029\072\072\072\ \065\065\065\065\065\101\101\101\101\101\137\137\137\137\137\173\ \173\173\173\173\209\209\029\029\035\035\035\072\072\072\071\065\ \065\065\065\107\101\101\101\101\143\137\137\137\137\137\173\173\ \173\173\173\209\035\035\035\035\035\072\072\072\071\071\071\071\ \071\107\107\107\107\143\143\143\143\143\137\179\179\179\179\173\ \215\215\035\035\035\035\035\078\078\072\071\071\071\071\071\107\ \107\107\107\107\143\143\143\143\143\179\179\179\179\179\215\215\ \035\035\035\035\035\078\078\078\071\071\071\071\071\107\107\107\ \107\107\143\143\143\143\143\179\179\179\179\179\215\215\035\035\ \035\035\035\078\078\078\071\071\071\071\071\107\107\107\107\107\ \143\143\143\143\143\179\179\179\179\179\215\215\035\035\035\041\ \041\078\078\078\077\071\071\071\071\113\107\107\107\107\107\143\ \143\143\143\185\179\179\179\179\221\215\041\041\041\041\041\078\ \078\078\077\077\077\077\077\113\113\113\113\107\149\149\149\149\ \185\185\185\185\185\179\221\221\041\041\041\041\041\078\078\078\ \077\077\077\077\077\113\113\113\113\113\149\149\149\149\149\185\ \185\185\185\185\221\221\041\041\041\041\041\084\078\078\077\077\ \077\077\077\113\113\113\113\113\149\149\149\149\149\185\185\185\ \185\185\221\221\041\041\041\041\041\084\084\078\077\077\077\077\ \077\113\113\113\113\113\149\149\149\149\149\185\185\185\185\185\ \221\221\041\041\041\047\047\084\084\084\077\077\077\077\077\113\ \113\113\113\113\113\149\149\149\149\149\185\185\185\185\227\221\ \047\047\047\047\047\084\084\084\083\083\083\083\083\119\119\119\ \119\113\155\155\155\155\191\191\191\191\191\227\227\227\047\047\ \047\047\047\084\084\084\083\083\083\083\083\119\119\119\119\119\ \155\155\155\155\155\191\191\191\191\191\227\227\017\017\017\017\ \055\054\054\054\054\053\053\053\053\089\089\089\089\089\125\125\ \125\125\125\161\161\161\161\161\197\197\017\017\017\017\017\054\ \054\054\054\053\053\053\053\089\089\089\089\089\125\125\125\125\ \125\161\161\161\161\161\197\197\017\017\017\017\017\055\054\054\ \054\053\053\053\053\089\089\089\089\089\125\125\125\125\125\161\ \161\161\161\161\197\197\017\017\017\017\017\017\097\054\054\053\ \053\053\053\089\089\089\089\125\125\125\125\125\161\161\161\161\ \161\161\197\197\025\017\017\017\061\061\097\097\097\133\133\133\ \133\089\089\089\089\125\125\125\125\125\161\161\161\161\161\197\ \197\197\024\024\025\017\061\060\060\060\096\096\096\096\096\132\ \132\132\132\132\132\168\168\168\168\168\168\204\204\204\204\204\ \024\024\024\067\067\060\060\060\096\096\096\096\096\132\132\132\ \132\132\132\168\168\168\168\168\168\168\204\204\204\204\024\024\ \024\024\067\060\060\060\060\096\096\096\096\096\132\132\132\132\ \132\132\168\168\168\168\168\168\168\204\204\204\024\024\024\024\ \067\066\060\060\060\241\096\096\096\096\095\132\132\132\131\131\ \131\131\168\168\167\167\167\204\204\203\023\023\023\023\073\066\ \066\066\241\241\241\241\242\095\095\095\095\095\131\131\131\131\ \131\167\167\167\167\167\203\203\023\023\023\023\073\066\066\066\ \066\241\241\241\242\095\095\095\095\095\131\131\131\131\131\167\ \167\167\167\167\203\203\023\023\023\023\073\066\066\066\066\241\ \241\241\242\095\095\095\095\095\131\131\131\131\131\167\167\167\ \167\167\203\203\023\023\023\023\073\066\066\066\066\242\242\242\ \242\243\095\095\095\095\131\131\131\131\131\167\167\167\167\167\ \203\203\029\029\029\029\029\072\072\066\066\065\065\065\243\101\ \101\101\095\095\137\137\137\137\131\173\173\173\173\167\209\209\ \029\029\029\029\029\072\072\072\065\065\065\065\065\101\101\101\ \101\101\137\137\137\137\137\173\173\173\173\173\209\209\029\029\ \029\029\029\072\072\072\072\065\065\065\065\101\101\101\101\101\ \137\137\137\137\137\173\173\173\173\173\209\209\029\029\029\029\ \029\072\072\072\072\065\065\065\065\101\101\101\101\101\137\137\ \137\137\137\173\173\173\173\173\209\209\029\029\029\035\035\072\ \072\072\072\065\065\065\065\065\101\101\101\101\143\137\137\137\ \137\137\173\173\173\173\173\209\035\035\035\035\035\072\072\072\ \072\071\071\071\071\107\107\107\107\143\143\143\143\143\137\179\ \179\179\173\173\215\215\035\035\035\035\035\078\078\072\071\071\ \071\071\071\107\107\107\107\107\143\143\143\143\143\179\179\179\ \179\179\215\215\035\035\035\035\035\078\078\078\071\071\071\071\ \071\107\107\107\107\107\143\143\143\143\143\179\179\179\179\179\ \215\215\035\035\035\035\035\078\078\078\071\071\071\071\071\071\ \107\107\107\107\107\143\143\143\143\179\179\179\179\179\215\215\ \035\035\035\041\041\078\078\078\078\071\071\071\071\071\107\107\ \107\107\107\143\143\143\143\185\179\179\179\179\179\215\041\041\ \041\041\041\078\078\078\078\077\077\077\077\113\113\113\113\107\ \149\149\149\149\185\185\185\185\185\179\221\221\041\041\041\041\ \041\078\078\078\077\077\077\077\077\113\113\113\113\113\149\149\ \149\149\149\185\185\185\185\185\221\221\041\041\041\041\041\084\ \078\078\077\077\077\077\077\113\113\113\113\113\149\149\149\149\ \149\185\185\185\185\185\221\221\041\041\041\041\041\084\084\078\ \077\077\077\077\077\077\113\113\113\113\113\149\149\149\149\185\ \185\185\185\185\221\221\041\041\041\041\047\084\084\084\084\077\ \077\077\077\077\113\113\113\113\113\149\149\149\149\149\185\185\ \185\185\227\221\047\047\047\047\047\084\084\084\084\083\083\083\ \083\119\119\119\119\113\155\155\155\155\149\191\191\191\191\227\ \227\227\047\047\047\047\047\084\084\084\083\083\083\083\083\119\ \119\119\119\119\155\155\155\155\155\191\191\191\191\191\227\227\ \017\017\017\017\055\055\054\054\054\054\053\053\053\090\089\089\ \089\089\089\125\125\125\125\125\161\161\161\161\161\197\017\017\ \017\017\017\055\054\054\054\054\053\053\053\090\089\089\089\089\ \089\125\125\125\125\125\161\161\161\161\161\197\017\017\017\017\ \017\017\054\054\054\054\053\053\053\090\089\089\089\089\089\125\ \125\125\125\161\161\161\161\161\197\197\017\017\017\017\017\017\ \097\054\054\054\053\053\053\090\089\089\089\089\125\125\125\125\ \125\161\161\161\161\161\197\197\025\017\017\017\061\061\097\097\ \097\097\133\133\133\133\089\089\089\089\125\125\125\125\125\161\ \161\161\161\161\197\197\025\025\017\017\061\060\060\097\097\097\ \096\096\096\133\133\132\132\132\132\132\168\168\168\168\168\168\ \168\204\204\204\024\024\024\067\067\060\060\060\060\096\096\096\ \096\096\132\132\132\132\132\132\168\168\168\168\168\168\168\204\ \204\204\024\024\024\024\067\067\060\060\060\096\096\096\096\096\ \132\132\132\132\132\132\168\168\168\168\168\168\168\204\204\204\ \024\024\024\024\067\067\060\060\060\060\096\096\096\096\096\132\ \132\132\132\132\132\168\168\168\168\168\168\204\204\204\024\024\ \024\024\067\067\066\060\060\060\060\242\096\096\096\095\095\132\ \132\131\131\131\168\168\168\167\167\167\204\203\023\023\023\023\ \073\066\066\066\066\060\242\242\242\096\095\095\095\095\131\131\ \131\131\131\167\167\167\167\167\203\203\023\023\023\023\073\066\ \066\066\066\242\242\242\242\243\095\095\095\095\131\131\131\131\ \131\167\167\167\167\167\203\203\023\023\023\023\073\066\066\066\ \066\066\242\242\242\243\095\095\095\095\095\131\131\131\131\131\ \167\167\167\167\167\203\030\030\030\030\073\073\066\066\066\066\ \066\243\243\243\244\095\095\095\095\131\131\131\131\131\167\167\ \167\167\167\203\029\029\029\029\029\072\072\072\066\066\065\065\ \065\244\101\101\101\095\138\137\137\137\137\173\173\173\173\173\ \209\209\029\029\029\029\029\072\072\072\072\065\065\065\065\065\ \101\101\101\101\137\137\137\137\137\173\173\173\173\173\209\209\ \029\029\029\029\029\072\072\072\072\065\065\065\065\065\101\101\ \101\101\144\137\137\137\137\137\173\173\173\173\209\209\029\029\ \029\029\029\072\072\072\072\072\065\065\065\065\065\101\101\101\ \101\137\137\137\137\137\173\173\173\173\173\209\029\029\029\035\ \035\072\072\072\072\072\071\071\065\065\108\107\144\101\101\143\ \137\137\137\137\180\173\173\173\173\209\035\035\035\035\035\072\ \072\072\072\072\071\071\071\071\107\107\107\107\143\143\143\143\ \143\137\179\179\179\179\215\215\035\035\035\035\035\078\078\078\ \072\071\071\071\071\071\107\107\107\107\107\143\143\143\143\179\ \179\179\179\179\215\215\035\035\035\035\035\078\078\078\078\071\ \071\071\071\071\107\107\107\107\107\143\143\143\143\179\179\179\ \179\179\215\215\035\035\035\035\035\078\078\078\078\078\071\071\ \071\071\071\107\107\107\107\107\143\143\143\143\179\179\179\179\ \179\215\035\035\041\041\041\078\078\078\078\078\077\077\071\071\ \113\113\107\107\107\107\149\149\143\143\185\185\179\179\179\215\ \041\041\041\041\041\078\078\078\078\078\077\077\077\077\113\113\ \113\113\150\149\149\149\149\185\185\185\185\185\221\221\041\041\ \041\041\041\078\078\078\078\077\077\077\077\077\113\113\113\113\ \113\149\149\149\149\185\185\185\185\185\221\221\041\041\041\041\ \041\078\078\078\078\077\077\077\077\077\113\113\113\113\113\149\ \149\149\149\149\185\185\185\185\221\221\041\041\041\041\041\084\ \084\084\084\077\077\077\077\077\077\113\113\113\113\113\149\149\ \149\149\185\185\185\185\185\221\041\041\047\047\047\084\084\084\ \084\084\083\083\077\077\119\119\119\113\113\155\155\155\149\149\ \191\191\191\185\185\227\047\047\047\047\047\084\084\084\084\083\ \083\083\083\083\119\119\119\119\119\155\155\155\155\155\191\191\ \191\191\227\227\018\018\018\018\055\055\055\054\054\054\054\054\ \090\090\090\090\090\126\126\126\126\126\125\162\162\162\162\161\ \198\198\018\018\018\018\018\055\055\054\054\054\054\054\090\090\ \090\090\089\089\126\126\126\125\125\162\162\161\161\161\198\197\ \018\018\018\018\018\018\055\054\054\054\054\054\090\090\090\090\ \089\089\126\126\125\125\125\125\161\161\161\161\161\197\018\018\ \018\018\018\018\055\055\054\054\054\054\090\090\090\089\089\089\ \089\125\125\125\125\125\161\161\161\161\197\197\025\018\018\018\ \061\061\097\097\097\097\054\054\133\133\090\089\089\089\089\125\ \125\125\125\161\161\161\161\161\197\197\025\025\018\018\061\061\ \061\097\097\097\097\097\133\133\133\133\133\132\132\169\169\169\ \169\168\168\161\205\205\204\197\025\025\025\025\067\061\060\060\ \097\097\097\097\096\096\133\133\133\132\132\132\132\169\168\168\ \168\168\168\204\204\204\024\024\024\025\067\067\060\060\060\060\ \096\096\096\096\096\132\132\132\132\132\132\132\168\168\168\168\ \168\204\204\204\024\024\024\024\067\067\067\060\060\060\060\096\ \096\096\096\096\132\132\132\132\132\132\168\168\168\168\168\204\ \204\204\024\024\024\024\067\067\067\060\060\060\060\060\096\096\ \096\096\096\132\132\132\132\132\168\168\168\168\168\168\204\204\ \024\024\024\024\024\067\067\066\060\060\060\060\096\096\096\096\ \096\132\132\132\132\132\168\168\168\168\168\168\204\204\024\024\ \024\024\024\067\067\066\060\060\060\060\243\096\096\096\096\095\ \132\132\132\131\131\168\168\168\168\167\204\204\030\030\030\030\ \073\073\066\066\066\066\066\243\243\243\244\095\095\095\095\131\ \131\131\131\131\167\167\167\167\167\203\030\030\030\030\073\073\ \066\066\066\066\066\066\243\243\244\102\245\095\138\138\138\138\ \131\174\174\174\174\167\210\210\030\030\030\030\030\073\073\066\ \066\066\066\066\244\244\244\102\245\138\138\138\138\138\131\174\ \174\174\174\167\210\210\030\030\030\029\029\073\073\072\066\066\ \066\066\065\102\102\102\245\144\138\138\138\138\174\174\174\174\ \174\167\210\210\030\029\029\029\029\073\072\072\072\066\066\066\ \065\245\245\245\245\144\138\138\138\137\180\174\174\174\173\173\ \216\210\036\029\029\029\029\072\072\072\072\072\072\065\065\065\ \108\144\144\101\144\144\137\137\137\180\180\173\173\173\216\216\ \036\036\036\029\029\072\072\072\072\072\072\072\065\108\108\108\ \108\144\144\144\144\137\137\180\180\180\180\173\216\216\036\036\ \036\035\035\079\072\072\072\072\072\072\071\108\108\108\108\144\ \144\144\144\144\180\180\180\180\180\173\216\216\036\036\035\035\ \035\079\072\072\072\072\072\072\071\108\108\108\108\107\144\144\ \144\144\143\180\180\180\180\179\216\216\036\035\035\035\035\079\ \079\072\072\072\072\071\071\108\108\108\107\107\107\144\144\144\ \143\180\180\180\180\179\216\216\035\035\035\035\035\079\078\078\ \078\078\078\071\071\071\071\114\150\107\107\150\143\143\143\186\ \186\179\179\179\222\215\042\042\035\035\041\078\078\078\078\078\ \078\078\071\114\114\114\114\150\150\150\150\150\186\186\186\186\ \179\179\222\222\042\042\041\041\041\078\078\078\078\078\078\078\ \077\114\114\114\114\150\150\150\150\150\186\186\186\186\186\179\ \222\222\042\041\041\041\041\041\078\078\078\078\078\078\077\114\ \114\114\114\113\150\150\150\150\149\186\186\186\186\185\222\222\ \042\041\041\041\041\085\078\078\078\078\078\078\077\114\114\114\ \113\113\150\150\150\150\149\149\186\186\186\185\228\222\041\041\ \041\041\041\085\084\084\084\078\078\077\077\077\077\077\113\113\ \113\113\149\149\149\149\149\185\185\185\228\221\048\048\041\047\ \047\084\084\084\084\084\084\084\077\120\120\120\120\156\156\156\ \156\192\192\192\192\192\192\228\228\228\048\047\047\047\047\047\ \084\084\084\084\084\084\083\120\120\120\120\156\156\156\156\156\ \155\192\192\192\192\191\228\228\018\018\018\018\018\055\055\054\ \054\054\054\054\054\090\090\090\090\126\126\126\126\126\126\162\ \162\162\162\162\198\198\018\018\018\018\018\055\055\055\054\054\ \054\054\054\090\090\090\090\126\126\126\126\126\162\162\162\162\ \162\162\198\198\018\018\018\018\018\018\055\055\054\054\054\054\ \054\090\090\090\090\126\126\126\126\126\162\162\162\162\162\161\ \198\198\018\018\018\018\018\018\018\055\055\054\054\054\054\090\ \090\090\090\126\126\126\126\126\125\162\162\161\161\161\198\197\ \018\018\018\018\018\018\061\097\097\097\054\054\054\090\090\090\ \090\126\126\126\125\125\125\162\161\161\161\161\161\197\025\025\ \018\018\018\061\061\097\097\097\097\097\133\133\133\133\133\133\ \169\169\169\169\169\169\205\205\205\205\205\197\025\025\025\018\ \061\061\061\061\097\097\097\097\097\133\133\133\133\133\132\169\ \169\169\169\169\168\168\205\205\205\204\024\025\025\025\067\067\ \061\060\060\097\097\097\097\096\096\133\133\133\132\132\132\132\ \169\168\168\168\168\168\204\204\024\024\024\025\067\067\067\060\ \060\060\060\060\096\096\096\096\096\132\132\132\132\132\168\168\ \168\168\168\168\204\204\024\024\024\024\067\067\067\067\060\060\ \060\060\096\096\096\096\096\132\132\132\132\132\132\168\168\168\ \168\168\204\204\024\024\024\024\024\067\067\067\060\060\060\060\ \060\096\096\096\096\096\132\132\132\132\132\168\168\168\168\168\ \204\204\024\024\024\024\024\067\067\067\060\060\060\060\060\096\ \096\096\096\096\132\132\132\132\132\168\168\168\168\168\204\204\ \024\024\024\024\024\073\067\067\066\060\060\060\060\244\096\096\ \096\096\138\132\132\132\131\168\168\168\168\168\204\204\030\030\ \030\030\030\073\073\066\066\066\066\066\244\244\244\102\245\138\ \138\138\138\138\131\174\174\174\174\167\210\210\030\030\030\030\ \030\073\073\066\066\066\066\066\066\244\244\102\245\246\138\138\ \138\138\138\174\174\174\174\174\210\210\030\030\030\030\030\073\ \073\073\066\066\066\066\066\102\102\102\245\246\138\138\138\138\ \138\174\174\174\174\174\210\210\030\030\030\030\030\073\073\073\ \066\066\066\066\066\245\245\245\245\246\138\138\138\138\138\174\ \174\174\174\174\210\210\036\036\036\036\036\073\073\072\072\072\ \066\066\066\108\246\246\246\246\144\144\138\138\180\180\174\174\ \174\174\216\210\036\036\036\036\036\079\072\072\072\072\072\072\ \108\108\108\108\108\144\144\144\144\144\180\180\180\180\180\216\ \216\216\036\036\036\036\036\079\079\072\072\072\072\072\072\108\ \108\108\108\144\144\144\144\144\180\180\180\180\180\180\216\216\ \036\036\036\036\035\079\079\072\072\072\072\072\072\108\108\108\ \108\108\144\144\144\144\144\180\180\180\180\180\216\216\036\036\ \036\036\035\079\079\072\072\072\072\072\072\108\108\108\108\108\ \144\144\144\144\144\180\180\180\180\180\216\216\036\042\042\035\ \035\079\079\079\078\072\072\072\071\071\108\108\108\150\150\150\ \144\144\144\186\180\180\180\180\222\216\042\042\042\042\042\079\ \079\078\078\078\078\078\078\114\114\114\114\150\150\150\150\150\ \186\186\186\186\186\222\222\222\042\042\042\042\041\085\078\078\ \078\078\078\078\078\114\114\114\114\150\150\150\150\150\150\186\ \186\186\186\186\222\222\042\042\042\041\041\085\078\078\078\078\ \078\078\078\114\114\114\114\114\150\150\150\150\150\186\186\186\ \186\186\222\222\042\042\042\041\041\085\085\078\078\078\078\078\ \078\114\114\114\114\114\150\150\150\150\150\186\186\186\186\186\ \222\222\042\042\041\041\041\085\085\078\078\078\078\078\078\077\ \114\114\114\114\156\150\150\150\150\192\186\186\186\186\228\222\ \048\048\048\048\041\085\085\084\084\084\084\084\084\120\120\120\ \120\156\156\156\156\156\192\192\192\192\192\228\228\228\048\048\ \048\047\047\047\084\084\084\084\084\084\084\120\120\120\120\120\ \156\156\156\156\156\192\192\192\192\192\228\228\018\018\018\018\ \018\055\055\055\054\054\054\054\054\090\090\090\090\090\126\126\ \126\126\126\162\162\162\162\162\198\198\018\018\018\018\018\055\ \055\055\054\054\054\054\054\090\090\090\090\090\126\126\126\126\ \126\162\162\162\162\162\198\198\018\018\018\018\018\018\055\055\ \055\054\054\054\054\090\090\090\090\090\126\126\126\126\126\162\ \162\162\162\162\198\198\018\018\018\018\018\018\018\055\055\054\ \054\054\054\054\090\090\090\090\126\126\126\126\126\162\162\162\ \162\162\198\198\018\018\018\018\018\018\061\097\097\097\054\054\ \054\054\090\090\090\090\126\126\126\126\162\162\162\162\162\161\ \198\197\025\025\018\018\018\061\061\061\097\097\097\097\097\133\ \133\133\133\133\169\169\169\169\169\169\169\205\205\205\205\197\ \025\025\025\018\061\061\061\061\097\097\097\097\097\133\133\133\ \133\133\133\169\169\169\169\169\169\205\205\205\205\205\025\025\ \025\025\067\061\061\061\061\097\097\097\097\097\133\133\133\133\ \132\132\169\169\169\169\168\168\168\205\205\204\024\024\025\025\ \067\067\067\061\060\060\060\097\097\096\096\096\096\133\132\132\ \132\132\132\168\168\168\168\168\204\204\024\024\024\024\067\067\ \067\067\060\060\060\060\060\096\096\096\096\096\132\132\132\132\ \132\168\168\168\168\168\204\204\024\024\024\024\024\067\067\067\ \060\060\060\060\060\096\096\096\096\096\132\132\132\132\132\168\ \168\168\168\168\204\204\024\024\024\024\024\067\067\067\067\060\ \060\060\060\096\096\096\096\096\132\132\132\132\132\168\168\168\ \168\168\204\204\024\024\024\024\024\067\067\067\067\060\060\060\ \060\060\096\096\096\096\132\132\132\132\132\168\168\168\168\168\ \204\204\030\030\030\024\024\073\073\067\066\066\066\066\060\102\ \102\102\245\139\138\138\138\138\174\174\174\174\174\167\210\210\ \030\030\030\030\030\073\073\073\066\066\066\066\066\102\102\102\ \245\246\138\138\138\138\138\174\174\174\174\174\210\210\030\030\ \030\030\030\073\073\073\066\066\066\066\066\102\102\102\245\246\ \138\138\138\138\138\174\174\174\174\174\210\210\030\030\030\030\ \030\073\073\073\066\066\066\066\066\245\245\245\245\246\138\138\ \138\138\138\174\174\174\174\174\210\210\030\030\030\030\030\073\ \073\073\073\066\066\066\066\109\246\246\246\246\144\138\138\138\ \138\174\174\174\174\174\210\210\036\036\036\036\036\079\073\072\ \072\072\072\072\072\108\108\108\108\144\144\144\144\144\138\180\ \180\180\180\174\216\216\036\036\036\036\036\079\079\072\072\072\ \072\072\072\108\108\108\108\108\144\144\144\144\144\180\180\180\ \180\180\216\216\036\036\036\036\036\079\079\079\072\072\072\072\ \072\108\108\108\108\108\144\144\144\144\144\180\180\180\180\180\ \216\216\036\036\036\036\036\079\079\079\072\072\072\072\072\108\ \108\108\108\108\144\144\144\144\144\180\180\180\180\180\216\216\ \036\036\036\036\042\079\079\079\072\072\072\072\072\114\108\108\ \108\108\108\144\144\144\144\186\180\180\180\180\222\216\042\042\ \042\042\042\079\079\079\078\078\078\078\078\114\114\114\114\114\ \150\150\150\150\186\186\186\186\186\180\222\222\042\042\042\042\ \042\079\079\078\078\078\078\078\078\114\114\114\114\114\150\150\ \150\150\150\186\186\186\186\186\222\222\042\042\042\042\042\085\ \085\078\078\078\078\078\078\114\114\114\114\114\150\150\150\150\ \150\186\186\186\186\186\222\222\042\042\042\042\042\085\085\078\ \078\078\078\078\078\114\114\114\114\114\150\150\150\150\150\186\ \186\186\186\186\222\222\042\042\042\042\041\085\085\085\078\078\ \078\078\078\077\114\114\114\114\114\150\150\150\150\150\186\186\ \186\186\228\222\048\048\048\048\048\085\085\085\084\084\084\084\ \084\120\120\120\120\120\156\156\156\156\192\192\192\192\192\228\ \228\228\048\048\048\048\047\047\085\084\084\084\084\084\084\120\ \120\120\120\120\156\156\156\156\156\192\192\192\192\192\228\228\ \018\018\018\018\018\055\055\055\054\054\054\054\054\090\090\090\ \090\090\126\126\126\126\126\162\162\162\162\162\198\198\018\018\ \018\018\018\055\055\055\055\054\054\054\054\054\090\090\090\090\ \126\126\126\126\126\162\162\162\162\162\198\198\018\018\018\018\ \018\018\055\055\055\054\054\054\054\054\090\090\090\090\126\126\ \126\126\126\162\162\162\162\162\198\198\018\018\018\018\018\018\ \018\055\055\055\054\054\054\054\090\090\090\090\126\126\126\126\ \126\162\162\162\162\162\198\198\018\018\018\018\018\018\061\097\ \097\097\054\054\054\054\090\090\090\090\126\126\126\126\126\162\ \162\162\162\161\198\198\025\025\018\018\018\061\061\061\097\097\ \097\097\097\133\133\133\133\133\133\169\169\169\169\169\169\205\ \205\205\205\205\025\025\025\018\061\061\061\061\097\097\097\097\ \097\133\133\133\133\133\133\169\169\169\169\169\169\205\205\205\ \205\205\025\025\025\025\067\061\061\061\061\097\097\097\097\097\ \133\133\133\133\133\132\169\169\169\169\169\168\168\205\205\204\ \024\025\025\025\067\067\067\061\060\060\060\097\097\097\096\096\ \096\133\133\132\132\132\169\169\168\168\168\168\204\204\024\024\ \024\025\067\067\067\067\060\060\060\060\060\096\096\096\096\096\ \132\132\132\132\132\168\168\168\168\168\204\204\024\024\024\024\ \024\067\067\067\060\060\060\060\060\096\096\096\096\096\132\132\ \132\132\132\168\168\168\168\168\204\204\024\024\024\024\024\067\ \067\067\067\060\060\060\060\096\096\096\096\096\132\132\132\132\ \132\168\168\168\168\168\204\204\024\024\024\024\024\067\067\067\ \067\060\060\060\060\060\096\096\096\096\139\132\132\132\132\132\ \168\168\168\168\204\204\030\024\024\024\024\073\073\067\067\066\ \066\060\060\245\245\245\245\139\139\138\138\132\175\174\174\174\ \168\168\211\210\030\030\030\030\030\073\073\073\066\066\066\066\ \066\245\245\245\245\246\138\138\138\138\138\174\174\174\174\174\ \210\210\030\030\030\030\030\073\073\073\066\066\066\066\066\245\ \245\245\245\246\138\138\138\138\138\174\174\174\174\174\210\210\ \030\030\030\030\030\073\073\073\066\066\066\066\066\245\245\245\ \245\246\138\138\138\138\138\174\174\174\174\174\210\210\030\030\ \030\030\030\073\073\073\073\066\066\066\066\109\246\246\246\246\ \247\138\138\138\138\174\174\174\174\174\210\210\036\036\036\036\ \036\073\073\073\072\072\072\072\109\108\108\108\108\247\144\144\ \144\138\138\180\180\180\180\174\216\216\036\036\036\036\036\079\ \079\072\072\072\072\072\072\108\108\108\108\108\144\144\144\144\ \144\180\180\180\180\180\216\216\036\036\036\036\036\079\079\079\ \072\072\072\072\072\108\108\108\108\108\144\144\144\144\144\180\ \180\180\180\180\216\216\036\036\036\036\036\079\079\079\072\072\ \072\072\072\072\108\108\108\108\144\144\144\144\144\180\180\180\ \180\180\216\216\036\036\036\036\036\079\079\079\079\072\072\072\ \072\115\108\108\108\108\108\144\144\144\144\186\180\180\180\180\ \180\216\042\042\042\042\042\079\079\079\079\078\078\078\072\114\ \114\114\114\114\150\150\150\150\186\186\186\186\180\180\222\222\ \042\042\042\042\042\079\079\079\078\078\078\078\078\114\114\114\ \114\114\150\150\150\150\150\186\186\186\186\186\222\222\042\042\ \042\042\042\085\085\078\078\078\078\078\078\114\114\114\114\114\ \150\150\150\150\150\186\186\186\186\186\222\222\042\042\042\042\ \042\085\085\078\078\078\078\078\078\078\114\114\114\114\150\150\ \150\150\150\150\186\186\186\186\222\222\042\042\042\042\041\085\ \085\085\078\078\078\078\078\078\114\114\114\114\114\150\150\150\ \150\150\186\186\186\186\228\222\048\048\048\048\048\085\085\085\ \085\084\084\084\084\121\120\120\120\120\156\156\156\156\150\192\ \192\192\192\228\228\228\048\048\048\048\048\085\085\084\084\084\ \084\084\084\120\120\120\120\120\156\156\156\156\156\192\192\192\ \192\192\228\228\018\018\018\018\018\055\055\055\055\055\054\054\ \054\091\091\090\090\090\127\126\126\126\126\126\162\162\162\162\ \162\198\018\018\018\018\018\055\055\055\055\055\054\054\054\054\ \091\090\090\090\127\126\126\126\126\126\162\162\162\162\162\198\ \018\018\018\018\018\018\055\055\055\055\055\054\054\054\091\090\ \090\090\127\126\126\126\126\126\162\162\162\162\198\198\018\018\ \018\018\018\018\018\055\055\055\055\055\054\054\091\090\090\090\ \127\126\126\126\126\162\162\162\162\162\198\198\018\018\018\018\ \018\018\018\098\097\055\055\055\054\054\091\090\090\090\127\126\ \126\126\126\162\162\162\162\162\198\198\025\025\018\018\018\061\ \061\061\097\097\097\097\097\097\133\133\133\133\133\170\169\169\ \169\169\169\169\205\205\205\205\025\025\025\018\018\061\061\061\ \061\097\097\097\097\097\133\133\133\133\133\133\169\169\169\169\ \169\169\205\205\205\205\025\025\025\025\068\061\061\061\061\097\ \097\097\097\097\133\133\133\133\133\133\169\169\169\169\169\169\ \169\205\205\205\025\025\025\025\067\067\061\061\061\061\061\097\ \097\097\097\133\133\133\133\133\132\169\169\169\169\169\169\205\ \205\205\025\025\025\025\025\067\067\061\061\061\060\060\097\097\ \097\096\096\133\133\133\132\132\132\169\169\168\168\168\205\204\ \024\024\025\025\025\067\067\067\061\060\060\060\060\097\096\096\ \096\096\133\132\132\132\132\132\168\168\168\168\168\204\024\024\ \024\025\025\067\067\067\067\060\060\060\060\060\096\096\096\096\ \133\132\132\132\132\132\168\168\168\168\168\204\024\024\024\024\ \024\067\067\067\067\067\060\060\060\060\096\096\096\096\096\132\ \132\132\132\132\168\168\168\168\168\204\031\024\024\024\024\067\ \067\067\067\067\067\060\060\060\103\139\139\096\139\139\132\132\ \132\175\175\168\168\168\211\211\031\031\031\031\031\073\073\073\ \067\067\066\066\060\103\246\246\246\246\139\139\138\138\175\175\ \174\174\174\174\211\210\030\030\030\030\030\073\073\073\073\066\ \066\066\066\109\246\246\246\246\139\138\138\138\138\174\174\174\ \174\174\210\210\030\030\030\030\030\073\073\073\073\066\066\066\ \066\109\246\246\246\246\247\138\138\138\138\174\174\174\174\174\ \210\210\030\030\030\030\030\073\073\073\073\073\066\066\066\066\ \246\246\246\246\247\138\138\138\138\138\174\174\174\174\174\210\ \037\037\037\037\037\073\073\073\073\073\073\073\066\109\109\109\ \247\247\247\248\138\138\138\181\174\174\174\174\174\210\036\036\ \036\036\036\080\073\073\073\072\072\072\072\109\109\108\108\108\ \248\144\144\144\138\181\180\180\180\180\217\216\036\036\036\036\ \036\079\079\079\072\072\072\072\072\072\108\108\108\108\108\144\ \144\144\144\180\180\180\180\180\216\216\036\036\036\036\036\079\ \079\079\079\072\072\072\072\072\108\108\108\108\108\144\144\144\ \144\187\180\180\180\180\223\216\036\036\036\036\036\079\079\079\ \079\072\072\072\072\072\115\108\108\108\108\108\144\144\144\187\ \180\180\180\180\180\216\036\036\036\042\042\079\079\079\079\079\ \072\072\072\115\115\114\114\108\151\151\150\187\187\144\186\180\ \180\180\180\216\042\042\042\042\042\079\079\079\079\079\078\078\ \078\115\114\114\114\114\114\150\150\150\150\186\186\186\186\186\ \223\222\042\042\042\042\042\079\079\079\079\078\078\078\078\078\ \114\114\114\114\114\150\150\150\150\150\186\186\186\186\222\222\ \042\042\042\042\042\085\085\079\079\078\078\078\078\078\114\114\ \114\114\114\150\150\150\150\150\186\186\186\186\229\222\042\042\ \042\042\042\085\085\085\085\078\078\078\078\078\114\114\114\114\ \114\114\150\150\150\150\150\186\186\186\186\222\042\042\048\048\ \048\085\085\085\085\085\078\078\078\121\121\120\120\114\114\157\ \156\193\150\150\193\192\229\186\186\228\048\048\048\048\048\085\ \085\085\085\084\084\084\084\121\120\120\120\120\120\156\156\156\ \156\156\192\192\192\192\228\228\019\019\019\019\019\055\055\055\ \055\055\055\055\054\091\091\091\091\127\127\127\127\127\126\163\ \163\163\163\162\199\199\019\019\019\019\019\019\055\055\055\055\ \055\055\054\091\091\091\091\127\127\127\127\126\126\163\163\163\ \162\162\199\198\019\019\019\019\019\019\055\055\055\055\055\055\ \054\091\091\091\091\127\127\127\127\126\126\163\163\162\162\162\ \199\198\019\019\019\019\019\019\019\055\055\055\055\055\055\054\ \091\091\091\127\127\127\126\126\126\163\163\162\162\162\162\198\ \019\019\019\019\019\019\019\098\098\055\055\055\055\054\091\091\ \091\127\127\127\126\126\126\163\162\162\162\162\162\198\025\019\ \019\019\019\061\061\061\098\097\097\097\097\097\134\134\133\133\ \133\170\170\170\169\169\169\169\162\205\205\205\025\025\025\019\ \019\061\061\061\061\097\097\097\097\097\097\133\133\133\133\133\ \170\170\169\169\169\169\169\205\205\205\025\025\025\025\068\061\ \061\061\061\061\097\097\097\097\097\097\133\133\133\133\133\169\ \169\169\169\169\169\205\205\205\025\025\025\025\068\068\061\061\ \061\061\061\097\097\097\097\097\133\133\133\133\133\133\169\169\ \169\169\169\205\205\205\025\025\025\025\025\067\067\061\061\061\ \061\061\097\097\097\097\097\133\133\133\133\133\169\169\169\169\ \169\205\205\205\025\025\025\025\025\067\067\067\061\061\061\061\ \061\097\097\097\097\133\133\133\133\133\132\169\169\169\169\168\ \205\205\025\025\025\025\025\067\067\067\061\061\061\061\061\097\ \097\097\097\133\133\133\133\133\132\169\169\169\169\168\205\205\ \024\024\024\025\025\067\067\067\067\067\061\061\060\060\103\097\ \139\096\096\133\132\132\132\132\175\168\168\168\168\204\031\031\ \031\024\024\067\067\067\067\067\067\067\060\103\103\103\139\139\ \139\139\139\132\132\175\175\175\175\168\211\211\031\031\031\031\ \031\074\067\067\067\067\067\067\103\103\103\103\103\139\139\139\ \139\139\175\175\175\175\175\211\211\211\031\031\031\031\031\074\ \073\067\067\067\067\067\067\103\103\103\103\139\139\139\139\139\ \138\175\175\175\175\174\211\211\031\031\031\031\031\073\073\073\ \073\067\067\067\109\103\103\103\103\247\139\139\139\139\138\175\ \175\175\174\174\211\211\037\037\037\037\037\073\073\073\073\073\ \073\073\066\109\109\109\247\247\247\248\138\138\138\181\174\174\ \174\174\174\210\037\037\037\037\037\073\073\073\073\073\073\073\ \066\109\109\109\109\247\247\248\145\249\138\181\181\181\181\174\ \217\217\037\037\037\037\037\080\073\073\073\073\073\073\073\109\ \109\109\109\248\248\248\145\249\138\181\181\181\181\174\217\217\ \037\037\037\036\036\080\080\073\073\073\073\073\072\109\109\109\ \109\108\145\145\145\249\144\181\181\181\181\174\217\217\037\036\ \036\036\036\080\080\079\073\073\073\072\072\072\109\109\109\108\ \249\249\249\249\144\181\181\181\180\180\223\217\036\036\036\036\ \036\079\079\079\079\079\072\072\072\072\115\108\108\108\108\108\ \144\144\144\187\187\180\180\180\223\216\043\043\043\043\043\079\ \079\079\079\079\079\079\072\115\115\115\115\151\151\151\151\151\ \187\187\187\187\180\180\223\223\043\043\043\043\042\079\079\079\ \079\079\079\079\115\115\115\115\115\114\151\151\151\151\187\187\ \187\187\187\180\223\223\043\043\042\042\042\079\079\079\079\079\ \079\079\078\115\115\115\115\114\151\151\151\151\150\187\187\187\ \187\186\223\223\043\042\042\042\042\042\079\079\079\079\079\079\ \078\115\115\115\114\114\151\151\151\150\150\150\187\187\187\186\ \223\223\042\042\042\042\042\085\085\085\085\085\078\078\078\078\ \121\114\114\114\114\114\114\150\150\150\150\186\186\186\229\222\ \049\049\049\042\042\085\085\085\085\085\085\085\078\121\121\121\ \121\114\157\157\157\157\193\193\193\193\193\229\229\229\049\048\ \048\048\048\085\085\085\085\085\085\085\084\121\121\121\121\120\ \157\157\157\157\156\193\193\193\193\192\229\229\019\019\019\019\ \019\056\055\055\055\055\055\055\055\091\091\091\091\091\127\127\ \127\127\127\163\163\163\163\163\199\199\019\019\019\019\019\019\ \056\055\055\055\055\055\055\091\091\091\091\091\127\127\127\127\ \127\163\163\163\163\163\199\199\019\019\019\019\019\019\056\055\ \055\055\055\055\055\091\091\091\091\091\127\127\127\127\126\163\ \163\163\163\162\199\199\019\019\019\019\019\019\019\056\055\055\ \055\055\055\055\091\091\091\091\127\127\127\127\126\163\163\163\ \163\162\199\199\019\019\019\019\019\019\019\098\098\055\055\055\ \055\055\091\091\091\091\127\127\127\127\126\163\163\163\163\162\ \199\198\026\019\019\019\019\062\062\062\098\098\098\098\097\134\ \134\134\134\134\170\170\170\170\170\169\169\206\206\206\206\205\ \025\026\026\019\019\062\061\061\061\098\098\098\097\097\134\134\ \134\133\133\133\170\170\170\169\169\169\169\206\205\205\025\025\ \025\026\068\062\061\061\061\061\097\097\097\097\097\097\097\133\ \133\133\133\170\169\169\169\169\169\169\205\205\025\025\025\025\ \068\068\061\061\061\061\061\061\097\097\097\097\097\133\133\133\ \133\133\169\169\169\169\169\169\205\205\025\025\025\025\025\068\ \068\061\061\061\061\061\097\097\097\097\097\133\133\133\133\133\ \169\169\169\169\169\169\205\205\025\025\025\025\025\068\068\067\ \061\061\061\061\061\097\097\097\097\097\133\133\133\133\133\169\ \169\169\169\169\205\205\025\025\025\025\025\068\068\067\061\061\ \061\061\061\097\097\097\097\097\133\133\133\133\133\169\169\169\ \169\169\205\205\025\025\025\025\025\067\067\067\067\061\061\061\ \061\061\097\097\097\097\133\133\133\133\132\132\169\169\169\169\ \205\205\031\031\031\025\025\074\067\067\067\067\067\067\061\103\ \103\103\103\139\139\139\139\139\175\175\175\175\175\168\211\211\ \031\031\031\031\031\074\074\067\067\067\067\067\067\103\103\103\ \103\139\139\139\139\139\175\175\175\175\175\175\211\211\031\031\ \031\031\031\074\074\067\067\067\067\067\067\103\103\103\103\103\ \139\139\139\139\139\175\175\175\175\175\211\211\031\031\031\031\ \031\074\074\067\067\067\067\067\067\103\103\103\103\103\139\139\ \139\139\139\175\175\175\175\175\211\211\031\031\031\031\031\074\ \073\073\073\073\067\067\067\109\109\103\103\103\248\139\139\139\ \139\181\175\175\175\174\217\211\037\037\037\037\037\080\073\073\ \073\073\073\073\073\109\109\109\109\248\248\248\145\249\138\181\ \181\181\181\174\217\217\037\037\037\037\037\080\073\073\073\073\ \073\073\073\109\109\109\109\109\248\248\145\249\250\181\181\181\ \181\181\217\217\037\037\037\037\037\080\080\073\073\073\073\073\ \073\109\109\109\109\109\145\145\145\249\250\181\181\181\181\181\ \217\217\037\037\037\037\037\080\080\080\073\073\073\073\073\109\ \109\109\109\109\249\249\249\249\250\181\181\181\181\181\217\217\ \037\037\036\036\036\080\080\080\079\079\073\073\072\115\115\109\ \109\108\108\250\250\250\250\187\181\181\181\181\223\217\043\043\ \043\043\043\079\079\079\079\079\079\079\072\115\115\115\115\151\ \151\151\151\151\187\187\187\187\187\223\223\223\043\043\043\043\ \043\079\079\079\079\079\079\079\079\115\115\115\115\115\151\151\ \151\151\187\187\187\187\187\187\223\223\043\043\043\043\043\086\ \079\079\079\079\079\079\079\115\115\115\115\115\151\151\151\151\ \151\187\187\187\187\187\223\223\043\043\043\043\043\086\079\079\ \079\079\079\079\079\115\115\115\115\115\151\151\151\151\151\187\ \187\187\187\187\223\223\043\043\042\042\042\086\086\079\079\079\ \079\079\079\078\115\115\115\115\114\151\151\151\151\193\187\187\ \187\187\229\223\049\049\049\049\049\086\085\085\085\085\085\085\ \085\121\121\121\121\157\157\157\157\157\193\193\193\193\193\229\ \229\229\049\049\049\049\048\085\085\085\085\085\085\085\085\121\ \121\121\121\121\157\157\157\157\157\193\193\193\193\193\229\229\ \019\019\019\019\019\056\056\055\055\055\055\055\055\091\091\091\ \091\091\127\127\127\127\127\163\163\163\163\163\199\199\019\019\ \019\019\019\019\056\056\055\055\055\055\055\091\091\091\091\091\ \127\127\127\127\127\163\163\163\163\163\199\199\019\019\019\019\ \019\019\056\056\055\055\055\055\055\055\091\091\091\091\127\127\ \127\127\127\163\163\163\163\163\199\199\019\019\019\019\019\019\ \019\056\056\055\055\055\055\055\091\091\091\091\091\127\127\127\ \127\163\163\163\163\163\199\199\019\019\019\019\019\019\019\098\ \098\055\055\055\055\055\055\091\091\091\091\127\127\127\127\163\ \163\163\163\163\199\199\026\019\019\019\019\062\062\062\098\098\ \098\098\098\134\134\134\134\134\170\170\170\170\170\170\169\206\ \206\206\206\199\026\026\026\019\019\062\062\062\098\098\098\098\ \098\097\134\134\134\134\170\170\170\170\170\170\169\169\206\206\ \206\205\025\026\026\026\068\062\062\061\061\061\098\098\098\097\ \097\134\134\134\133\133\133\170\170\169\169\169\169\206\206\205\ \025\025\025\026\068\068\068\061\061\061\061\061\097\097\097\097\ \097\097\133\133\133\133\170\169\169\169\169\169\205\205\025\025\ \025\025\025\068\068\061\061\061\061\061\061\097\097\097\097\097\ \133\133\133\133\133\169\169\169\169\169\205\205\025\025\025\025\ \025\068\068\068\061\061\061\061\061\097\097\097\097\097\133\133\ \133\133\133\169\169\169\169\169\205\205\025\025\025\025\025\068\ \068\068\061\061\061\061\061\097\097\097\097\097\133\133\133\133\ \133\169\169\169\169\169\205\205\025\025\025\025\025\068\068\068\ \067\061\061\061\061\061\097\097\097\097\097\133\133\133\133\169\ \169\169\169\169\205\205\031\031\025\025\025\074\067\067\067\067\ \067\067\061\103\103\103\103\097\139\139\139\139\133\175\175\175\ \175\169\211\211\031\031\031\031\025\074\074\067\067\067\067\067\ \067\103\103\103\103\103\139\139\139\139\139\175\175\175\175\175\ \211\211\031\031\031\031\031\074\074\074\067\067\067\067\067\103\ \103\103\103\103\139\139\139\139\139\175\175\175\175\175\211\211\ \031\031\031\031\031\074\074\074\067\067\067\067\067\103\103\103\ \103\103\139\139\139\139\139\175\175\175\175\175\211\211\031\031\ \031\031\031\074\074\074\067\067\067\067\067\067\103\103\103\103\ \103\139\139\139\139\175\175\175\175\175\211\211\037\037\037\031\ \031\080\080\073\073\073\073\073\067\109\109\109\109\103\145\145\ \145\249\139\181\181\181\181\174\217\217\037\037\037\037\037\080\ \080\073\073\073\073\073\073\109\109\109\109\109\145\145\145\249\ \250\181\181\181\181\181\217\217\037\037\037\037\037\080\080\073\ \073\073\073\073\073\109\109\109\109\109\145\145\145\249\250\181\ \181\181\181\181\217\217\037\037\037\037\037\080\080\080\073\073\ \073\073\073\109\109\109\109\109\249\249\249\249\250\181\181\181\ \181\181\217\217\037\037\037\037\037\080\080\080\080\073\073\073\ \073\073\109\109\109\109\109\250\250\250\250\251\181\181\181\181\ \217\217\043\043\043\043\043\080\080\079\079\079\079\079\079\115\ \115\115\115\115\151\151\151\151\251\187\187\187\187\181\223\223\ \043\043\043\043\043\079\079\079\079\079\079\079\079\115\115\115\ \115\115\151\151\151\151\151\187\187\187\187\187\223\223\043\043\ \043\043\043\086\079\079\079\079\079\079\079\115\115\115\115\115\ \151\151\151\151\151\187\187\187\187\187\223\223\043\043\043\043\ \043\086\086\079\079\079\079\079\079\115\115\115\115\115\151\151\ \151\151\151\187\187\187\187\187\223\223\043\043\043\043\043\086\ \086\086\079\079\079\079\079\079\115\115\115\115\114\151\151\151\ \151\151\187\187\187\187\229\223\049\049\049\049\049\086\086\086\ \085\085\085\085\085\121\121\121\121\121\157\157\157\157\157\193\ \193\193\193\229\229\229\049\049\049\049\049\049\085\085\085\085\ \085\085\085\121\121\121\121\121\157\157\157\157\157\193\193\193\ \193\193\229\229\019\019\019\019\019\056\056\056\055\055\055\055\ \055\091\091\091\091\091\127\127\127\127\127\163\163\163\163\163\ \199\199\019\019\019\019\019\019\056\056\055\055\055\055\055\055\ \091\091\091\091\091\127\127\127\127\163\163\163\163\163\199\199\ \019\019\019\019\019\019\056\056\056\055\055\055\055\055\091\091\ \091\091\091\127\127\127\127\163\163\163\163\163\199\199\019\019\ \019\019\019\019\019\056\056\055\055\055\055\055\091\091\091\091\ \091\127\127\127\127\163\163\163\163\163\199\199\019\019\019\019\ \019\019\019\098\098\056\055\055\055\055\055\091\091\091\091\127\ \127\127\127\163\163\163\163\163\199\199\026\019\019\019\019\062\ \062\062\098\098\098\098\098\134\134\134\134\134\170\170\170\170\ \170\170\163\206\206\206\206\199\026\026\026\019\019\062\062\062\ \062\098\098\098\098\134\134\134\134\134\134\170\170\170\170\170\ \169\169\206\206\206\205\026\026\026\026\068\062\062\062\062\098\ \098\098\098\097\097\134\134\134\134\170\170\170\170\170\169\169\ \169\206\206\205\025\025\026\026\068\068\062\062\061\061\061\061\ \098\097\097\097\097\134\133\133\133\133\170\170\169\169\169\169\ \205\205\025\025\025\025\026\068\068\068\061\061\061\061\061\097\ \097\097\097\097\133\133\133\133\133\169\169\169\169\169\205\205\ \025\025\025\025\025\068\068\068\061\061\061\061\061\097\097\097\ \097\097\133\133\133\133\133\169\169\169\169\169\205\205\025\025\ \025\025\025\068\068\068\061\061\061\061\061\097\097\097\097\097\ \133\133\133\133\133\169\169\169\169\169\205\205\025\025\025\025\ \025\068\068\068\068\061\061\061\061\061\097\097\097\097\097\133\ \133\133\133\169\169\169\169\169\205\205\031\025\025\025\025\074\ \068\067\067\067\067\061\061\103\103\103\097\097\097\139\139\139\ \133\176\175\175\175\169\212\211\031\031\031\031\025\074\074\067\ \067\067\067\067\067\103\103\103\103\103\139\139\139\139\139\175\ \175\175\175\175\211\211\031\031\031\031\031\074\074\074\067\067\ \067\067\067\103\103\103\103\103\139\139\139\139\139\175\175\175\ \175\175\211\211\031\031\031\031\031\074\074\074\067\067\067\067\ \067\067\103\103\103\103\139\139\139\139\139\175\175\175\175\175\ \211\211\031\031\031\031\031\074\074\074\074\067\067\067\067\067\ \103\103\103\103\103\139\139\139\139\182\175\175\175\175\218\211\ \037\031\031\031\031\080\074\074\073\073\073\073\067\067\109\109\ \109\103\249\249\249\249\139\182\181\181\175\175\217\217\037\037\ \037\037\037\080\080\080\073\073\073\073\073\109\109\109\109\109\ \249\249\249\249\250\181\181\181\181\181\217\217\037\037\037\037\ \037\080\080\080\073\073\073\073\073\109\109\109\109\109\249\249\ \249\249\250\181\181\181\181\181\217\217\037\037\037\037\037\080\ \080\080\073\073\073\073\073\109\109\109\109\109\249\249\249\249\ \250\251\181\181\181\181\217\217\037\037\037\037\037\080\080\080\ \080\073\073\073\073\073\109\109\109\109\109\250\250\250\250\251\ \181\181\181\181\217\217\043\043\043\043\043\080\080\080\080\079\ \079\079\079\115\115\115\115\152\151\151\151\251\251\251\187\187\ \181\181\223\223\043\043\043\043\043\043\079\079\079\079\079\079\ \079\115\115\115\115\115\151\151\151\151\151\187\187\187\187\187\ \223\223\043\043\043\043\043\086\079\079\079\079\079\079\079\115\ \115\115\115\115\151\151\151\151\151\187\187\187\187\187\223\223\ \043\043\043\043\043\086\086\079\079\079\079\079\079\115\115\115\ \115\115\115\151\151\151\151\187\187\187\187\187\223\223\043\043\ \043\043\043\086\086\086\079\079\079\079\079\079\115\115\115\115\ \115\151\151\151\151\151\187\187\187\187\229\223\049\049\049\049\ \049\086\086\086\085\085\085\085\085\122\121\121\121\158\157\157\ \157\157\157\193\193\193\193\229\229\229\049\049\049\049\049\049\ \085\085\085\085\085\085\085\121\121\121\121\121\157\157\157\157\ \157\193\193\193\193\193\229\229\019\019\019\019\019\056\056\056\ \056\055\055\055\055\055\091\091\091\091\091\127\127\127\127\164\ \163\163\163\163\200\199\019\019\019\019\019\019\056\056\056\056\ \055\055\055\055\092\091\091\091\091\127\127\127\127\164\163\163\ \163\163\200\199\019\019\019\019\019\019\056\056\056\056\055\055\ \055\055\092\091\091\091\091\091\127\127\127\164\163\163\163\163\ \200\199\019\019\019\019\019\019\019\056\056\056\056\056\055\055\ \055\091\091\091\091\091\127\127\127\164\163\163\163\163\199\199\ \019\019\019\019\019\019\019\098\098\056\056\056\055\055\055\092\ \091\091\091\091\127\127\127\164\163\163\163\163\199\199\026\019\ \019\019\019\062\062\062\098\098\098\098\098\134\134\134\134\134\ \134\170\170\170\170\170\170\163\206\206\206\199\026\026\026\019\ \019\062\062\062\062\098\098\098\098\098\134\134\134\134\134\170\ \170\170\170\170\170\206\206\206\206\206\026\026\026\026\068\062\ \062\062\062\062\098\098\098\098\134\134\134\134\134\134\170\170\ \170\170\170\169\169\206\206\206\026\026\026\026\068\068\062\062\ \062\062\062\098\098\098\098\097\134\134\134\134\170\170\170\170\ \170\169\169\206\206\205\025\026\026\026\026\068\068\062\062\061\ \061\061\098\098\097\097\097\097\134\134\133\133\133\170\169\169\ \169\169\206\205\025\025\025\026\026\068\068\068\062\061\061\061\ \061\098\097\097\097\097\097\133\133\133\133\170\169\169\169\169\ \206\205\025\025\025\026\026\068\068\068\068\061\061\061\061\061\ \097\097\097\097\097\133\133\133\133\170\169\169\169\169\169\205\ \025\025\025\025\025\068\068\068\068\068\061\061\061\061\097\097\ \097\097\097\133\133\133\133\133\169\169\169\169\169\205\025\025\ \025\025\025\068\068\068\068\068\068\061\061\061\061\104\140\097\ \097\140\133\133\133\176\176\169\169\169\212\205\031\032\032\025\ \025\074\074\068\068\067\067\067\061\061\103\103\103\140\140\140\ \139\139\139\176\175\175\175\175\212\211\031\031\031\031\032\074\ \074\074\067\067\067\067\067\104\103\103\103\103\103\139\139\139\ \139\176\175\175\175\175\212\211\031\031\031\031\031\074\074\074\ \074\067\067\067\067\110\103\103\103\103\103\139\139\139\139\176\ \175\175\175\175\175\211\031\031\031\031\031\074\074\074\074\067\ \067\067\067\067\110\103\103\103\103\139\139\139\139\182\175\175\ \175\175\175\211\031\031\031\031\031\074\074\074\074\074\067\067\ \067\067\110\103\103\103\103\103\139\139\139\182\182\175\175\175\ \218\211\037\037\031\031\031\080\080\074\074\074\073\073\073\110\ \110\109\109\103\103\250\250\250\250\182\182\181\181\181\218\217\ \037\037\037\037\037\080\080\080\080\073\073\073\073\073\109\109\ \109\109\109\250\250\250\250\251\181\181\181\181\217\217\037\037\ \037\037\037\080\080\080\080\073\073\073\073\073\109\109\109\109\ \109\250\250\250\250\251\181\181\181\181\217\217\037\037\037\037\ \037\080\080\080\080\073\073\073\073\073\109\109\109\109\109\250\ \250\250\250\251\181\181\181\181\224\217\044\044\044\044\044\080\ \080\080\080\080\080\080\073\116\116\116\116\152\152\152\251\251\ \251\251\252\181\181\181\224\217\043\043\043\043\043\080\080\080\ \080\080\079\079\079\116\115\115\115\115\152\152\151\151\151\252\ \187\187\187\181\224\223\043\043\043\043\043\043\086\079\079\079\ \079\079\079\079\115\115\115\115\115\151\151\151\151\151\187\187\ \187\187\230\223\043\043\043\043\043\086\086\079\079\079\079\079\ \079\079\115\115\115\115\115\151\151\151\151\151\187\187\187\187\ \230\223\043\043\043\043\043\086\086\086\086\079\079\079\079\079\ \115\115\115\115\115\151\151\151\151\151\151\187\187\187\230\223\ \050\050\050\049\049\086\086\086\086\086\086\079\079\122\122\122\ \115\115\158\158\157\157\194\194\194\230\230\230\230\223\049\049\ \049\049\049\049\086\086\085\085\085\085\085\085\121\121\121\121\ \121\157\157\157\157\157\193\193\193\193\193\229\020\020\020\020\ \020\056\056\056\056\056\056\056\055\092\092\092\092\091\128\128\ \128\128\164\164\164\164\164\163\200\200\020\020\020\020\020\020\ \056\056\056\056\056\056\055\092\092\092\092\091\128\128\128\128\ \164\164\164\164\163\163\200\200\020\020\020\020\020\020\056\056\ \056\056\056\056\056\055\092\092\092\091\128\128\128\128\164\164\ \164\164\163\163\200\199\020\020\020\020\020\020\020\056\056\056\ \056\056\056\055\092\092\092\092\128\128\128\128\164\164\164\164\ \163\163\200\199\020\020\020\020\020\020\020\020\098\056\056\056\ \056\056\092\092\092\092\128\128\128\128\164\164\164\163\163\163\ \200\199\026\020\020\020\020\062\062\062\098\098\098\098\098\098\ \134\134\134\134\134\134\170\170\170\170\170\207\207\206\206\206\ \026\026\026\020\020\062\062\062\062\098\098\098\098\098\134\134\ \134\134\134\134\170\170\170\170\170\170\170\206\206\206\026\026\ \026\026\020\062\062\062\062\062\098\098\098\098\098\134\134\134\ \134\134\134\170\170\170\170\170\170\206\206\206\026\026\026\026\ \068\068\062\062\062\062\062\062\098\098\098\098\134\134\134\134\ \134\134\170\170\170\170\170\206\206\206\026\026\026\026\026\068\ \068\062\062\062\062\062\098\098\098\098\098\134\134\134\134\134\ \170\170\170\170\170\169\206\206\026\026\026\026\026\068\068\068\ \062\062\062\062\062\098\098\098\098\097\134\134\134\134\170\170\ \170\170\170\169\206\206\026\026\026\026\026\068\068\068\062\062\ \062\062\062\098\098\098\098\097\134\134\134\134\170\170\170\170\ \169\169\206\206\025\025\026\026\026\068\068\068\068\068\062\062\ \061\061\098\098\097\097\097\097\134\134\133\133\170\170\169\169\ \169\205\032\032\025\025\026\068\068\068\068\068\068\068\061\104\ \104\104\140\140\140\140\140\176\176\176\176\176\169\169\212\212\ \032\032\032\032\032\074\068\068\068\068\068\068\068\104\104\104\ \104\140\140\140\140\140\176\176\176\176\176\212\212\212\032\032\ \032\032\032\074\074\074\068\068\068\068\068\104\104\104\104\104\ \140\140\140\140\176\176\176\176\176\175\212\212\032\032\032\032\ \032\074\074\074\068\068\068\068\067\104\104\104\104\104\140\140\ \140\140\176\176\176\176\175\175\212\212\031\031\031\032\032\074\ \074\074\074\074\067\067\067\110\110\104\104\103\146\146\140\182\ \182\139\176\175\175\175\175\211\038\038\038\038\038\074\074\074\ \074\074\074\074\067\110\110\110\110\146\146\146\146\182\182\182\ \182\182\175\175\218\218\038\038\038\038\038\074\074\074\074\074\ \074\074\067\110\110\110\110\146\146\146\146\146\182\182\182\182\ \182\218\218\218\038\038\038\038\038\080\080\074\074\074\074\074\ \074\110\110\110\110\110\146\146\146\146\251\182\182\182\182\181\ \218\218\038\038\038\038\038\080\080\080\074\074\074\074\074\116\ \110\110\110\152\146\146\146\251\251\251\182\182\182\181\218\218\ \044\044\044\044\044\080\080\080\080\080\080\080\073\116\116\116\ \116\152\152\152\251\251\251\251\252\181\181\181\224\217\044\044\ \044\044\044\080\080\080\080\080\080\080\073\116\116\116\116\109\ \152\152\152\251\251\251\252\188\253\181\224\224\044\044\044\044\ \044\080\080\080\080\080\080\080\080\116\116\116\116\116\152\152\ \152\152\252\252\252\188\253\181\224\224\044\044\044\044\043\087\ \080\080\080\080\080\080\080\116\116\116\116\115\152\152\152\152\ \151\188\188\188\253\187\224\224\044\043\043\043\043\087\080\080\ \080\080\080\080\079\079\116\116\115\115\115\152\152\152\151\253\ \253\253\253\187\224\224\043\043\043\043\043\086\086\086\086\079\ \079\079\079\079\122\115\115\115\115\158\151\151\151\151\151\187\ \187\187\230\223\050\050\050\050\050\086\086\086\086\086\086\086\ \079\122\122\122\122\115\158\158\158\158\194\194\194\194\194\230\ \230\230\050\050\049\049\049\086\086\086\086\086\086\086\085\122\ \122\122\122\121\158\158\158\158\157\194\194\194\194\193\230\230\ \020\020\020\020\020\056\056\056\056\056\056\056\056\092\092\092\ \092\092\128\128\128\128\128\164\164\164\164\164\200\200\020\020\ \020\020\020\020\056\056\056\056\056\056\056\092\092\092\092\092\ \128\128\128\128\128\164\164\164\164\164\200\200\020\020\020\020\ \020\020\020\056\056\056\056\056\056\056\092\092\092\092\128\128\ \128\128\128\164\164\164\164\163\200\200\020\020\020\020\020\020\ \020\056\056\056\056\056\056\056\092\092\092\092\128\128\128\128\ \128\164\164\164\164\163\200\200\020\020\020\020\020\020\020\020\ \099\056\056\056\056\056\056\092\092\092\092\128\128\128\128\164\ \164\164\164\163\200\200\026\020\020\020\020\062\062\062\098\098\ \098\098\098\098\135\134\134\134\134\134\134\128\170\170\170\207\ \207\207\206\206\026\026\020\020\020\062\062\062\062\098\098\098\ \098\098\098\134\134\134\134\134\134\134\170\170\170\170\170\207\ \206\206\026\026\026\026\020\062\062\062\062\062\098\098\098\098\ \098\098\134\134\134\134\134\134\170\170\170\170\170\207\206\206\ \026\026\026\026\069\068\062\062\062\062\062\062\098\098\098\098\ \098\134\134\134\134\134\170\170\170\170\170\206\206\206\026\026\ \026\026\026\068\068\062\062\062\062\062\062\098\098\098\098\134\ \134\134\134\134\134\170\170\170\170\170\206\206\026\026\026\026\ \026\068\068\068\062\062\062\062\062\098\098\098\098\098\134\134\ \134\134\134\170\170\170\170\170\206\206\026\026\026\026\026\068\ \068\068\062\062\062\062\062\098\098\098\098\098\134\134\134\134\ \134\170\170\170\170\170\206\206\026\026\026\026\026\068\068\068\ \068\062\062\062\062\062\098\098\098\098\140\134\134\134\134\170\ \170\170\170\169\206\206\032\032\026\026\026\068\068\068\068\068\ \068\068\062\104\104\104\104\140\140\140\140\140\176\176\176\176\ \176\169\212\212\032\032\032\032\026\075\068\068\068\068\068\068\ \068\104\104\104\104\140\140\140\140\140\176\176\176\176\176\176\ \212\212\032\032\032\032\032\074\074\068\068\068\068\068\068\104\ \104\104\104\104\140\140\140\140\140\176\176\176\176\176\212\212\ \032\032\032\032\032\074\074\068\068\068\068\068\068\104\104\104\ \104\104\140\140\140\140\140\176\176\176\176\176\212\212\032\032\ \032\032\032\074\074\074\074\068\068\068\068\110\104\104\104\104\ \104\140\140\140\140\176\176\176\176\175\218\212\038\038\038\038\ \032\074\074\074\074\074\074\074\110\110\110\110\110\104\146\146\ \146\146\182\182\182\182\182\175\218\218\038\038\038\038\038\074\ \074\074\074\074\074\074\074\110\110\110\110\110\146\146\146\146\ \182\182\182\182\182\182\218\218\038\038\038\038\038\074\074\074\ \074\074\074\074\074\110\110\110\110\110\146\146\146\146\146\182\ \182\182\182\182\218\218\038\038\038\038\038\038\074\074\074\074\ \074\074\074\110\110\110\110\110\146\146\146\146\146\182\182\182\ \182\182\218\218\038\038\038\038\038\080\080\080\080\074\074\074\ \074\116\116\110\110\110\152\152\146\146\146\252\182\182\182\182\ \224\218\044\044\044\044\044\080\080\080\080\080\080\080\080\116\ \116\116\116\116\152\152\152\152\252\252\252\188\253\181\224\224\ \044\044\044\044\044\080\080\080\080\080\080\080\080\116\116\116\ \116\116\152\152\152\152\152\252\252\188\253\254\224\224\044\044\ \044\044\044\087\080\080\080\080\080\080\080\116\116\116\116\116\ \152\152\152\152\152\188\188\188\253\254\224\224\044\044\044\044\ \044\087\080\080\080\080\080\080\080\116\116\116\116\116\152\152\ \152\152\152\253\253\253\253\254\224\224\044\044\043\043\043\087\ \087\087\086\080\080\080\080\079\116\116\116\115\115\152\152\152\ \151\151\254\254\254\254\230\224\050\050\050\050\050\086\086\086\ \086\086\086\086\086\122\122\122\122\158\158\158\158\158\194\194\ \194\194\194\230\230\230\050\050\050\050\050\086\086\086\086\086\ \086\086\086\122\122\122\122\122\158\158\158\158\158\194\194\194\ \194\194\230\230\020\020\020\020\020\057\056\056\056\056\056\056\ \056\092\092\092\092\092\128\128\128\128\128\164\164\164\164\164\ \200\200\020\020\020\020\020\020\056\056\056\056\056\056\056\056\ \092\092\092\092\128\128\128\128\128\164\164\164\164\164\200\200\ \020\020\020\020\020\020\020\056\056\056\056\056\056\056\092\092\ \092\092\092\128\128\128\128\164\164\164\164\164\200\200\020\020\ \020\020\020\020\020\020\056\056\056\056\056\056\056\092\092\092\ \092\128\128\128\128\164\164\164\164\164\200\200\020\020\020\020\ \020\020\020\020\099\056\056\056\056\056\056\092\092\092\092\128\ \128\128\128\128\164\164\164\164\200\200\027\020\020\020\020\063\ \063\063\099\099\099\099\098\056\135\135\135\134\134\171\171\171\ \128\207\207\207\207\207\207\206\026\026\020\020\020\063\062\062\ \062\099\098\098\098\098\098\135\135\134\134\134\134\134\171\170\ \170\170\170\207\206\206\026\026\026\020\020\063\062\062\062\062\ \098\098\098\098\098\098\098\134\134\134\134\134\134\170\170\170\ \170\207\206\206\026\026\026\026\069\069\062\062\062\062\062\062\ \098\098\098\098\098\134\134\134\134\134\134\170\170\170\170\207\ \206\206\026\026\026\026\026\069\069\062\062\062\062\062\062\098\ \098\098\098\098\134\134\134\134\134\170\170\170\170\170\206\206\ \026\026\026\026\026\069\068\068\062\062\062\062\062\098\098\098\ \098\098\134\134\134\134\134\170\170\170\170\170\206\206\026\026\ \026\026\026\069\068\068\062\062\062\062\062\098\098\098\098\098\ \134\134\134\134\134\170\170\170\170\170\206\206\026\026\026\026\ \026\068\068\068\068\062\062\062\062\062\098\098\098\098\098\134\ \134\134\134\170\170\170\170\170\206\206\032\026\026\026\026\026\ \068\068\068\068\068\068\062\104\104\104\104\098\140\140\140\140\ \134\176\176\176\176\170\212\212\032\032\032\026\026\075\068\068\ \068\068\068\068\068\104\104\104\104\104\140\140\140\140\140\176\ \176\176\176\176\212\212\032\032\032\032\032\075\075\068\068\068\ \068\068\068\104\104\104\104\104\140\140\140\140\140\176\176\176\ \176\176\212\212\032\032\032\032\032\075\075\068\068\068\068\068\ \068\104\104\104\104\104\140\140\140\140\140\176\176\176\176\176\ \212\212\032\032\032\032\032\074\074\074\074\068\068\068\068\068\ \104\104\104\104\104\140\140\140\140\140\176\176\176\176\212\212\ \038\038\032\032\032\074\074\074\074\074\074\074\068\110\110\110\ \110\104\146\146\146\146\140\182\182\182\182\176\218\218\038\038\ \038\038\038\081\074\074\074\074\074\074\074\110\110\110\110\110\ \146\146\146\146\146\182\182\182\182\182\218\218\038\038\038\038\ \038\081\074\074\074\074\074\074\074\110\110\110\110\110\146\146\ \146\146\146\182\182\182\182\182\218\218\038\038\038\038\038\081\ \074\074\074\074\074\074\074\110\110\110\110\110\146\146\146\146\ \146\182\182\182\182\182\218\218\038\038\038\038\038\038\081\074\ \074\074\074\074\074\074\110\110\110\110\110\146\146\146\146\146\ \182\182\182\182\225\218\044\044\044\044\038\087\080\080\080\080\ \080\080\080\116\116\116\116\110\152\152\152\152\146\188\188\188\ \253\182\224\224\044\044\044\044\044\087\080\080\080\080\080\080\ \080\116\116\116\116\116\152\152\152\152\152\188\188\188\253\254\ \224\224\044\044\044\044\044\087\080\080\080\080\080\080\080\116\ \116\116\116\116\152\152\152\152\152\188\188\188\253\254\224\224\ \044\044\044\044\044\087\080\080\080\080\080\080\080\116\116\116\ \116\116\152\152\152\152\152\253\253\253\253\254\224\224\044\044\ \044\044\044\087\087\087\087\080\080\080\080\080\116\116\116\116\ \116\152\152\152\152\152\254\254\254\254\255\224\050\050\050\050\ \050\087\086\086\086\086\086\086\086\122\122\122\122\122\158\158\ \158\158\195\194\194\194\194\255\230\230\050\050\050\050\050\086\ \086\086\086\086\086\086\086\122\122\122\122\122\158\158\158\158\ \158\194\194\194\194\194\230\230\020\020\020\020\020\057\057\056\ \056\056\056\056\056\092\092\092\092\092\128\128\128\128\128\164\ \164\164\164\164\200\200\020\020\020\020\020\020\057\056\056\056\ \056\056\056\056\092\092\092\092\092\128\128\128\128\128\164\164\ \164\164\200\200\020\020\020\020\020\020\020\057\056\056\056\056\ \056\056\092\092\092\092\092\128\128\128\128\128\164\164\164\164\ \200\200\020\020\020\020\020\020\020\020\056\056\056\056\056\056\ \056\092\092\092\092\128\128\128\128\128\164\164\164\164\200\200\ \020\020\020\020\020\020\020\020\099\056\056\056\056\056\056\092\ \092\092\092\128\128\128\128\128\164\164\164\164\200\200\027\020\ \020\020\020\063\063\063\099\099\099\099\098\135\135\135\135\135\ \092\171\171\171\171\207\207\207\207\207\207\200\027\027\020\020\ \020\063\062\062\062\099\099\099\098\098\135\135\135\135\134\134\ \171\171\171\170\170\170\170\207\207\206\026\026\027\020\020\063\ \062\062\062\062\098\098\098\098\098\098\098\134\134\134\134\134\ \134\170\170\170\170\207\207\206\026\026\026\026\069\069\062\062\ \062\062\062\062\098\098\098\098\098\134\134\134\134\134\134\170\ \170\170\170\207\207\206\026\026\026\026\026\069\069\062\062\062\ \062\062\062\098\098\098\098\098\134\134\134\134\134\170\170\170\ \170\170\206\206\026\026\026\026\026\069\069\068\062\062\062\062\ \062\098\098\098\098\098\134\134\134\134\134\170\170\170\170\170\ \206\206\026\026\026\026\026\069\069\068\062\062\062\062\062\062\ \098\098\098\098\134\134\134\134\134\134\170\170\170\170\206\206\ \026\026\026\026\026\068\068\068\068\062\062\062\062\062\098\098\ \098\098\098\134\134\134\134\134\170\170\170\170\206\206\032\026\ \026\026\026\075\068\068\068\068\068\062\062\104\104\104\098\098\ \140\140\140\140\134\134\176\176\176\170\213\212\032\032\032\026\ \026\075\075\068\068\068\068\068\068\104\104\104\104\104\140\140\ \140\140\140\176\176\176\176\176\212\212\032\032\032\032\032\075\ \075\068\068\068\068\068\068\104\104\104\104\104\140\140\140\140\ \140\176\176\176\176\176\212\212\032\032\032\032\032\075\075\068\ \068\068\068\068\068\068\104\104\104\104\140\140\140\140\140\176\ \176\176\176\176\212\212\032\032\032\032\032\075\075\074\068\068\ \068\068\068\068\104\104\104\104\104\140\140\140\140\140\176\176\ \176\176\219\212\038\032\032\032\032\032\074\074\074\074\074\068\ \068\110\110\110\104\104\146\146\146\140\140\140\182\182\182\176\ \219\218\038\038\038\038\038\081\074\074\074\074\074\074\074\110\ \110\110\110\110\146\146\146\146\146\182\182\182\182\182\218\218\ \038\038\038\038\038\081\081\074\074\074\074\074\074\110\110\110\ \110\110\146\146\146\146\146\182\182\182\182\182\218\218\038\038\ \038\038\038\081\081\074\074\074\074\074\074\110\110\110\110\110\ \110\146\146\146\146\182\182\182\182\182\218\218\038\038\038\038\ \038\081\081\074\074\074\074\074\074\074\110\110\110\110\110\146\ \146\146\146\146\182\182\182\182\225\218\044\038\038\038\038\087\ \080\080\080\080\080\074\074\074\116\116\116\110\110\152\152\152\ \146\253\253\253\253\182\225\224\044\044\044\044\044\087\080\080\ \080\080\080\080\080\116\116\116\116\116\152\152\152\152\152\253\ \253\253\253\254\224\224\044\044\044\044\044\087\080\080\080\080\ \080\080\080\116\116\116\116\116\152\152\152\152\152\253\253\253\ \253\254\224\224\044\044\044\044\044\087\080\080\080\080\080\080\ \080\116\116\116\116\116\152\152\152\152\152\253\253\253\253\254\ \255\224\044\044\044\044\044\087\087\087\087\080\080\080\080\080\ \116\116\116\116\116\152\152\152\152\152\254\254\254\254\255\224\ \050\050\050\050\050\087\087\087\087\086\086\086\086\123\122\122\ \122\159\158\158\158\158\195\194\194\194\255\255\255\230\050\050\ \050\050\050\050\086\086\086\086\086\086\086\122\122\122\122\122\ \158\158\158\158\158\194\194\194\194\194\230\230\020\020\020\020\ \020\057\057\057\057\056\056\056\056\056\092\092\092\092\092\128\ \128\128\128\128\164\164\164\164\201\200\020\020\020\020\020\020\ \057\057\057\056\056\056\056\056\092\092\092\092\092\128\128\128\ \128\128\164\164\164\164\201\200\020\020\020\020\020\020\020\057\ \057\057\056\056\056\056\056\092\092\092\092\092\128\128\128\128\ \128\164\164\164\201\200\020\020\020\020\020\020\020\057\057\057\ \057\056\056\056\056\092\092\092\092\092\128\128\128\128\128\164\ \164\164\201\200\020\020\020\020\020\020\020\020\099\057\057\057\ \056\056\056\056\056\092\092\092\128\128\128\128\128\164\164\164\ \201\200\027\020\020\020\020\063\063\063\099\099\099\099\099\135\ \135\135\135\135\135\171\171\171\171\171\207\207\207\207\207\200\ \027\027\020\020\020\063\063\063\063\099\099\099\099\099\135\135\ \135\135\135\171\171\171\171\171\207\207\207\207\207\206\027\027\ \027\027\020\063\063\063\063\099\099\099\099\099\098\135\135\135\ \135\134\171\171\171\171\207\207\207\207\207\206\027\027\027\027\ \069\069\063\063\063\063\062\099\099\099\098\098\098\135\135\134\ \134\134\171\171\171\207\207\207\207\206\026\026\027\027\027\069\ \069\069\063\062\062\062\062\098\098\098\098\098\135\134\134\134\ \134\134\170\170\170\170\207\206\026\026\026\027\027\069\069\069\ \062\062\062\062\062\098\098\098\098\098\098\134\134\134\134\134\ \170\170\170\170\207\206\026\026\026\026\027\069\069\069\069\062\ \062\062\062\062\098\098\098\098\098\134\134\134\134\134\170\170\ \170\170\207\206\026\026\026\026\026\069\069\069\069\062\062\062\ \062\062\062\098\098\098\098\098\134\134\134\134\134\170\170\170\ \170\206\026\026\026\026\026\075\069\069\069\068\068\062\062\062\ \062\062\098\098\098\098\134\134\134\134\134\170\170\170\213\206\ \032\032\026\026\026\075\075\068\068\068\068\068\062\062\104\104\ \104\104\141\140\140\140\140\177\176\176\176\176\213\212\032\032\ \032\032\026\075\075\075\068\068\068\068\068\062\104\104\104\104\ \104\140\140\140\140\140\176\176\176\176\213\212\032\032\032\032\ \026\075\075\075\068\068\068\068\068\068\104\104\104\104\104\140\ \140\140\140\140\176\176\176\176\213\212\032\032\032\032\032\075\ \075\075\075\068\068\068\068\068\104\104\104\104\104\140\140\140\ \140\140\176\176\176\176\176\212\032\032\032\032\032\075\075\075\ \075\075\068\068\068\068\111\104\104\104\104\104\104\140\140\140\ \140\176\176\176\219\212\038\038\032\032\032\081\081\074\074\074\ \074\074\068\068\110\110\110\104\104\146\146\146\146\183\182\182\ \182\182\219\218\038\038\038\038\038\081\081\081\074\074\074\074\ \074\074\110\110\110\110\104\146\146\146\146\146\182\182\182\182\ \219\218\038\038\038\038\038\081\081\081\074\074\074\074\074\074\ \110\110\110\110\110\146\146\146\146\146\182\182\182\182\219\218\ \038\038\038\038\038\081\081\081\081\074\074\074\074\074\110\110\ \110\110\110\146\146\146\146\146\182\182\182\182\225\218\038\038\ \038\038\038\081\081\081\081\074\074\074\074\074\117\110\110\110\ \110\153\146\146\146\146\146\182\182\182\225\218\044\044\038\038\ \038\087\087\087\081\080\080\080\074\074\116\116\116\116\110\152\ \152\152\146\146\254\254\254\254\225\224\044\044\044\044\044\087\ \087\087\087\080\080\080\080\080\116\116\116\116\116\152\152\152\ \152\152\254\254\254\254\255\224\044\044\044\044\044\087\087\087\ \087\080\080\080\080\080\116\116\116\116\116\152\152\152\152\152\ \254\254\254\254\255\224\044\044\044\044\044\087\087\087\087\080\ \080\080\080\080\116\116\116\116\116\152\152\152\152\152\254\254\ \254\254\255\224\051\051\051\051\051\087\087\087\087\087\087\087\ \080\123\123\123\123\116\159\159\159\159\195\195\195\255\255\255\ \255\224\050\050\050\050\050\050\086\086\086\086\086\086\086\086\ \122\122\122\122\122\158\158\158\158\158\194\194\194\194\194\230\ \021\021\021\021\021\057\057\057\057\057\057\057\056\093\093\093\ \093\092\129\129\129\129\165\165\165\165\165\201\201\201\021\021\ \021\021\021\021\057\057\057\057\057\057\056\093\093\093\093\092\ \129\129\129\129\165\165\165\165\165\201\201\201\021\021\021\021\ \021\021\021\057\057\057\057\057\057\056\093\093\093\093\129\129\ \129\129\165\165\165\165\165\201\201\201\021\021\021\021\021\021\ \021\057\057\057\057\057\057\057\093\093\093\093\092\129\129\129\ \129\165\165\165\165\201\201\201\021\021\021\021\021\021\021\021\ \099\057\057\057\057\057\056\093\093\093\092\129\129\129\129\165\ \165\165\165\201\201\201\027\021\021\021\021\063\063\063\099\099\ \099\099\099\099\135\135\135\135\135\171\171\171\171\171\171\207\ \207\207\207\207\027\027\021\021\021\063\063\063\063\099\099\099\ \099\099\135\135\135\135\135\135\171\171\171\171\171\171\207\207\ \207\207\027\027\027\027\021\063\063\063\063\063\099\099\099\099\ \099\135\135\135\135\135\171\171\171\171\171\171\207\207\207\207\ \027\027\027\027\069\069\063\063\063\063\063\099\099\099\099\099\ \099\135\135\135\135\171\171\171\171\171\207\207\207\207\027\027\ \027\027\027\069\069\063\063\063\063\063\099\099\099\099\099\135\ \135\135\135\135\171\171\171\171\171\207\207\207\027\027\027\027\ \027\069\069\069\063\063\063\063\063\099\099\099\099\098\135\135\ \135\135\171\171\171\171\171\207\207\207\027\027\027\027\027\069\ \069\069\063\063\063\063\063\099\099\099\099\098\135\135\135\135\ \134\171\171\171\171\207\207\207\026\026\027\027\027\069\069\069\ \069\069\063\063\062\062\099\099\099\098\098\135\135\135\134\134\ \171\171\171\170\170\207\033\033\026\027\027\069\069\069\069\069\ \069\069\062\105\105\105\105\141\141\141\141\141\177\177\177\177\ \177\213\213\213\033\033\033\033\026\075\075\069\069\069\069\069\ \069\105\105\105\105\141\141\141\141\141\177\177\177\177\177\213\ \213\213\033\033\033\033\033\075\075\075\069\069\069\069\069\105\ \105\105\105\105\141\141\141\141\177\177\177\177\177\213\213\213\ \033\033\033\033\033\075\075\075\069\069\069\069\069\105\105\105\ \105\105\141\141\141\141\140\177\177\177\177\213\213\213\032\032\ \033\033\033\075\075\075\075\075\068\068\068\111\111\105\105\104\ \104\147\141\183\140\140\183\177\219\176\176\213\039\039\039\032\ \032\075\075\075\075\075\075\075\068\111\111\111\111\104\147\147\ \147\183\183\183\183\183\219\219\219\219\039\039\039\039\039\081\ \075\075\075\075\075\075\075\111\111\111\111\147\147\147\147\147\ \183\183\183\183\183\219\219\219\039\039\039\039\039\081\081\081\ \075\075\075\075\075\111\111\111\111\111\147\147\147\147\147\183\ \183\183\183\219\219\219\039\039\039\039\039\081\081\081\081\075\ \075\075\075\111\111\111\111\153\147\147\147\147\147\183\183\183\ \183\219\219\219\045\045\045\039\039\081\081\081\081\081\081\074\ \074\117\117\117\110\110\153\153\147\147\189\189\189\225\225\225\ \225\218\045\045\045\045\045\081\081\081\081\081\081\081\074\117\ \117\117\117\110\153\153\153\153\189\189\189\189\225\225\225\225\ \045\045\045\045\045\081\081\081\081\081\081\081\081\117\117\117\ \117\153\153\153\153\153\189\189\189\189\189\225\225\225\045\045\ \045\045\045\087\081\081\081\081\081\081\081\117\117\117\117\117\ \153\153\153\153\195\189\189\189\189\255\225\225\045\045\045\045\ \045\087\087\087\087\081\081\081\081\117\117\117\117\159\159\153\ \153\153\195\189\189\189\255\255\255\225\051\051\051\051\051\087\ \087\087\087\087\087\087\080\123\123\123\123\116\159\159\159\159\ \195\195\195\255\255\255\255\224\051\051\051\051\051\087\087\087\ \087\087\087\087\080\123\123\123\123\116\159\159\159\159\195\195\ \195\195\255\255\255\231\051\051\051\051\051\087\087\087\087\087\ \087\087\087\123\123\123\123\123\159\159\159\159\158\195\195\195\ \195\194\231\231\021\021\021\021\021\057\057\057\057\057\057\057\ \057\093\093\093\093\093\129\129\129\129\129\165\165\165\165\165\ \201\201\021\021\021\021\021\021\057\057\057\057\057\057\057\057\ \093\093\093\093\093\129\129\129\129\165\165\165\165\165\201\201\ \021\021\021\021\021\021\021\057\057\057\057\057\057\057\093\093\ \093\093\093\129\129\129\129\129\165\165\165\165\201\201\021\021\ \021\021\021\021\021\021\057\057\057\057\057\057\057\093\093\093\ \093\129\129\129\129\129\165\165\165\165\201\201\021\021\021\021\ \021\021\021\021\099\057\057\057\057\057\057\057\093\093\093\093\ \129\129\129\129\165\165\165\165\201\201\027\021\021\021\021\063\ \063\063\099\099\099\099\099\057\057\057\135\135\135\135\129\129\ \129\171\171\171\165\165\207\207\027\027\021\021\021\063\063\063\ \063\099\099\099\099\099\099\135\135\135\135\135\135\135\171\171\ \171\171\171\171\207\207\027\027\027\021\021\063\063\063\063\063\ \099\099\099\099\099\099\099\135\135\135\135\135\171\171\171\171\ \171\171\207\207\027\027\027\027\069\069\063\063\063\063\063\063\ \099\099\099\099\099\135\135\135\135\135\135\171\171\171\171\171\ \207\207\027\027\027\027\027\069\069\063\063\063\063\063\063\099\ \099\099\099\099\135\135\135\135\135\171\171\171\171\171\207\207\ \027\027\027\027\027\069\069\069\063\063\063\063\063\099\099\099\ \099\099\135\135\135\135\135\171\171\171\171\171\207\207\027\027\ \027\027\027\069\069\069\063\063\063\063\063\099\099\099\099\099\ \135\135\135\135\135\171\171\171\171\171\207\207\027\027\027\027\ \027\069\069\069\069\063\063\063\063\063\099\099\099\099\099\135\ \135\135\135\135\171\171\171\171\207\207\033\027\027\027\027\027\ \069\069\069\069\069\069\063\105\105\105\105\141\141\141\141\141\ \135\177\177\177\177\171\213\213\033\033\033\027\027\027\069\069\ \069\069\069\069\069\105\105\105\105\105\141\141\141\141\141\177\ \177\177\177\177\213\213\033\033\033\033\027\027\075\069\069\069\ \069\069\069\105\105\105\105\105\141\141\141\141\141\177\177\177\ \177\177\213\213\033\033\033\033\033\075\075\069\069\069\069\069\ \069\105\105\105\105\105\141\141\141\141\141\177\177\177\177\177\ \213\213\033\033\033\033\033\075\075\075\075\069\069\069\069\111\ \105\105\105\105\105\141\141\141\141\141\177\177\177\177\213\213\ \039\033\033\033\033\075\075\075\075\075\075\075\069\111\111\111\ \111\105\147\147\147\147\141\183\183\183\183\177\219\219\039\039\ \039\039\033\075\075\075\075\075\075\075\075\111\111\111\111\111\ \147\147\147\147\147\183\183\183\183\183\219\219\039\039\039\039\ \039\039\075\075\075\075\075\075\075\111\111\111\111\111\147\147\ \147\147\147\183\183\183\183\183\219\219\039\039\039\039\039\039\ \075\075\075\075\075\075\075\111\111\111\111\111\147\147\147\147\ \147\183\183\183\183\183\219\219\039\039\039\039\039\039\081\081\ \075\075\075\075\075\075\111\111\111\111\111\147\147\147\147\147\ \183\183\183\183\183\219\045\045\039\039\039\081\081\081\081\081\ \081\081\075\117\117\117\117\111\153\153\153\153\147\189\189\189\ \189\183\225\225\045\045\045\045\045\081\081\081\081\081\081\081\ \081\117\117\117\117\117\153\153\153\153\153\189\189\189\189\189\ \225\225\045\045\045\045\045\081\081\081\081\081\081\081\081\117\ \117\117\117\117\153\153\153\153\153\189\189\189\189\189\225\225\ \045\045\045\045\045\045\081\081\081\081\081\081\081\117\117\117\ \117\117\153\153\153\153\153\189\189\189\189\189\225\225\045\045\ \045\045\045\045\081\081\081\081\081\081\081\081\117\117\117\117\ \117\153\153\153\153\153\189\189\189\189\189\225\051\051\051\051\ \051\087\087\087\087\087\087\087\087\123\123\123\123\123\159\159\ \159\159\153\195\195\195\195\189\231\231\051\051\051\051\051\087\ \087\087\087\087\087\087\087\123\123\123\123\123\159\159\159\159\ \159\195\195\195\195\195\231\231" type map = { count_r : int; count_g : int; count_b : int; index_r : string; index_g : string; index_b : string; map : string; } let colors_16 = { count_r = 6; count_g = 6; count_b = 6; index_r = data0; index_g = data0; index_b = data1; map = data2; } let colors_88 = { count_r = 11; count_g = 11; count_b = 11; index_r = data3; index_g = data3; index_b = data3; map = data4; } let colors_256 = { count_r = 30; count_g = 30; count_b = 30; index_r = data5; index_g = data5; index_b = data5; map = data6; } lambda-term-3.1.0/src/lTerm_containers_impl.ml000066400000000000000000000375401366433625400213770ustar00rootroot00000000000000module Make (LiteralIntf: LiteralIntf.Type) = struct open LTerm_geom class t = LTerm_widget_base_impl.t exception Out_of_range let rec insert x l n = if n < 0 then raise Out_of_range else if n = 0 then x :: l else match l with | [] -> raise Out_of_range | y :: l -> y :: insert x l (n - 1) type box_child = { widget : t; expand : bool; mutable length : int; } class type box = object inherit t method add : ?position : int -> ?expand : bool -> #t -> unit method remove : #t -> unit end class virtual abox rc = object(self) inherit t rc as super val mutable children = [] method! children = List.map (fun child -> child.widget) children val mutable size_request = { rows = 0; cols = 0 } method! size_request = size_request method private virtual compute_allocations : unit (* Compute sizes of children. *) method private virtual compute_size_request : unit (* Compute the size request. *) method! set_allocation rect = super#set_allocation rect; self#compute_allocations method add : 'a. ?position : int -> ?expand : bool -> (#t as 'a) -> unit = fun ?position ?(expand = true) widget -> let child = { widget = (widget :> t); expand = expand; length = 0; } in (match position with | Some n -> children <- insert child children n | None -> children <- children @ [child]); widget#set_parent (Some (self :> t)); self#compute_size_request; self#compute_allocations; self#queue_draw method remove : 'a. (#t as 'a) -> unit = fun widget -> children <- List.filter (fun child -> if child.widget = (widget :> t) then (child.widget#set_parent None; false) else true) children; self#compute_size_request; self#compute_allocations; self#queue_draw end class hbox = object(self) inherit abox "hbox" method private compute_size_request = size_request <- ( List.fold_left (fun acc child -> let size = child.widget#size_request in { rows = max acc.rows size.rows; cols = acc.cols + size.cols }) { rows = 0; cols = 0 } children ) method private compute_allocations = let rect = self#allocation in let cols = rect.col2 - rect.col1 in let total_requested_cols = List.fold_left (fun acc child -> acc + child.widget#size_request.cols) 0 children in if total_requested_cols <= cols then begin (* There is enough space for everybody, we split free space between children that can expand. *) (* Count the number of children that can expand. *) let count_can_expand = List.fold_left (fun acc child -> if child.expand then acc + 1 else acc) 0 children in (* Divide free space between these children. *) let widthf = if count_can_expand = 0 then 0. else float (cols - total_requested_cols) /. float count_can_expand in let rec loop colf = function | [] -> () | [child] -> let width = cols - truncate colf in child.length <- width | child :: rest -> let req_cols = child.widget#size_request.cols in if child.expand then begin let col = truncate colf in let width = req_cols + truncate (colf +. widthf) - col in child.length <- width; loop (colf +. float req_cols +. widthf) rest end else begin child.length <- req_cols; loop (colf +. float req_cols) rest end in loop 0. children end else begin (* There is not enough space for everybody. *) if total_requested_cols = 0 then List.iter (fun child -> child.length <- 0) children else let rec loop col = function | [] -> () | [child] -> let width = cols - col in child.length <- width | child :: rest -> let width = child.widget#size_request.cols * cols / total_requested_cols in child.length <- width; loop (col + width) rest in loop 0 children end; ignore ( List.fold_left (fun col child -> child.widget#set_allocation { row1 = rect.row1; col1 = col; row2 = rect.row2; col2 = col + child.length; }; col + child.length) rect.col1 children ) method! draw ctx focused = let rect = self#allocation in let rec loop col children = match children with | [] -> () | child :: rest -> child.widget#draw (LTerm_draw.sub ctx { row1 = 0; col1 = col; row2 = rect.row2 - rect.row1; col2 = col + child.length; }) focused; loop (col + child.length) rest in loop 0 children end class vbox = object(self) inherit abox "vbox" method private compute_size_request = size_request <- ( List.fold_left (fun acc child -> let size = child.widget#size_request in { rows = acc.rows + size.rows; cols = max acc.cols size.cols }) { rows = 0; cols = 0 } children ) method private compute_allocations = let rect = self#allocation in let rows = rect.row2 - rect.row1 in let total_requested_rows = List.fold_left (fun acc child -> acc + child.widget#size_request.rows) 0 children in if total_requested_rows <= rows then begin (* There is enough space for everybody, we split free space between children that can expand. *) (* Count the number of children that can expand. *) let count_can_expand = List.fold_left (fun acc child -> if child.expand then acc + 1 else acc) 0 children in (* Divide free space between these children. *) let heightf = if count_can_expand = 0 then 0. else float (rows - total_requested_rows) /. float count_can_expand in let rec loop rowf = function | [] -> () | [child] -> let height = rows - truncate rowf in child.length <- height | child :: rest -> let req_rows = child.widget#size_request.rows in if child.expand then begin let row = truncate rowf in let height = req_rows + truncate (rowf +. heightf) - row in child.length <- height; loop (rowf +. float req_rows +. heightf) rest end else begin child.length <- req_rows; loop (rowf +. float req_rows) rest end in loop 0. children end else begin (* There is not enough space for everybody. *) if total_requested_rows = 0 then List.iter (fun child -> child.length <- 0) children else let rec loop row = function | [] -> () | [child] -> let height = rows - row in child.length <- height | child :: rest -> let height = child.widget#size_request.rows * rows / total_requested_rows in child.length <- height; loop (row + height) rest in loop 0 children end; ignore ( List.fold_left (fun row child -> child.widget#set_allocation { row1 = row; col1 = rect.col1; row2 = row + child.length; col2 = rect.col2; }; row + child.length) rect.row1 children ) method! draw ctx focused = let rect = self#allocation in let rec loop row children = match children with | [] -> () | child :: rest -> child.widget#draw (LTerm_draw.sub ctx { row1 = row; col1 = 0; row2 = row + child.length; col2 = rect.col2 - rect.col1; }) focused; loop (row + child.length) rest in loop 0 children end class frame = object(self) inherit t "frame" as super val mutable child = None method! children = match child with | Some widget -> [widget] | None -> [] val mutable size_request = { rows = 2; cols = 2 } method! size_request = size_request val mutable style = LTerm_style.none val mutable connection = LTerm_draw.Light method! update_resources = let rc = self#resource_class and resources = self#resources in style <- LTerm_resources.get_style rc resources; connection <- LTerm_resources.get_connection (rc ^ ".connection") resources method private compute_size_request = match child with | Some widget -> let size = widget#size_request in size_request <- { rows = size.rows + 2; cols = size.cols + 2 } | None -> size_request <- { rows = 2; cols = 2 } method private compute_allocation = match child with | Some widget -> let rect = self#allocation in let row1 = min rect.row2 (rect.row1 + 1) and col1 = min rect.col2 (rect.col1 + 1) in widget#set_allocation { row1 = row1; col1 = col1; row2 = max row1 (rect.row2 - 1); col2 = max col1 (rect.col2 - 1); } | None -> () method! set_allocation rect = super#set_allocation rect; self#compute_allocation method set : 'a. (#t as 'a) -> unit = fun widget -> child <- Some(widget :> t); widget#set_parent (Some (self :> t)); self#compute_size_request; self#compute_allocation; self#queue_draw method empty = match child with | Some widget -> widget#set_parent None; child <- None; self#compute_size_request; self#queue_draw | None -> () val mutable label = Zed_string.empty () val mutable align = H_align_left method set_label ?(alignment=H_align_left) l = label <- LiteralIntf.to_string_exn l; align <- alignment method! draw ctx focused = let size = LTerm_draw.size ctx in LTerm_draw.fill_style ctx style; if size.rows >= 1 && size.cols >= 1 then begin let rect = { row1 = 0; col1 = 0; row2 = size.rows; col2 = size.cols } in (if Zed_string.bytes label = 0 then LTerm_draw.draw_frame ctx rect connection else LTerm_draw.draw_frame_labelled ctx rect ~alignment:align label connection); if size.rows > 2 && size.cols > 2 then match child with | Some widget -> widget#draw (LTerm_draw.sub ctx { row1 = 1; col1 = 1; row2 = size.rows - 1; col2 = size.cols - 1 }) focused | None -> () end end class modal_frame = object(self) inherit frame val mutable work_area = None method! private compute_allocation = match child with | Some widget -> (* The desired layout is as following: * * .............................. * . . * . --------------------- . * . || || . * . || child widget is || . * . || centered || . * . || || . * . --------------------- . * . . * .............................. *) let rect = self#allocation in (* First find out how much space we have *) let alloc_height = rect.row2 - rect.row1 in let alloc_width = rect.col2 - rect.col1 in (* Then how much child widget wants *) let request = widget#size_request in (* Now we calculate how big margins could be, taking into account: * - for vertical margin two lines of the frame and two empty lines * between it and the child widget * - for horizontal margin four lines of the frame and two empty lines * between it and the child widget *) let margin_height = max 0 (alloc_height - request.rows - 4) / 2 in let margin_width = max 0 (alloc_width - request.cols - 6) / 2 in (* the child widget would like to be here (again taking into account * frame lines and emty lines between frame and the child widget *) let desired_row1 = rect.row1 + margin_height + 2 in let desired_row2 = desired_row1 + request.rows in let desired_col1 = rect.col1 + margin_width + 3 in let desired_col2 = desired_col1 + request.cols in (* make sure we stay inside the modal_frame *) (* Remember that right and left margins for the widget inside the frame * are 3, and top and bottom margins are 2 *) let row1 = min desired_row1 (rect.row2 - 2) in let row2 = min desired_row2 (rect.row2 - 2) in let col1 = min desired_col1 (rect.col2 - 3) in let col2 = min desired_col2 (rect.col2 - 3) in (* now inform the child widget about its area *) widget#set_allocation { row1 = row1; col1 = col1; row2 = row2; col2 = col2; }; (* modal_frame is not going to touch anything outside of the child * widget and frame around *) work_area <- Some { row1 = max rect.row1 (row1 - 2); row2 = min rect.row2 (row2 + 2); col1 = max rect.col1 (col1 - 3); col2 = min rect.col2 (col2 + 3) }; | None -> () method! draw ctx focused = match work_area with | None -> () | Some area -> let work_ctx = LTerm_draw.sub ctx area in (* modal_frame is drawing only inside centered area (the child widget * and frame around) so create appropriate drawing context *) let size = LTerm_draw.size work_ctx in if size.rows >= 1 && size.cols >= 1 then begin LTerm_draw.fill_style work_ctx style; LTerm_draw.clear work_ctx; let width = area.col2 - area.col1 in let height = area.row2 - area.row1 in (* outer part of the frame *) LTerm_draw.draw_frame work_ctx { row1 = 0; col1 = 0; row2 = height; col2 = width } connection; (* inner part of the frame *) LTerm_draw.draw_frame work_ctx { row1 = 0; col1 = 1; row2 = height; col2 = width - 1 } connection; if size.rows > 4 && size.cols > 6 then match child with | Some widget -> (* decorations around the child widget take 4 columns and 6 * rows *) let widget_ctx = LTerm_draw.sub work_ctx { row1 = 2; row2 = height - 2; col1 = 3; col2 = width - 3} in widget#draw widget_ctx focused | None -> () end initializer self#set_resource_class "modal_frame" end end lambda-term-3.1.0/src/lTerm_dlist.ml000066400000000000000000000034621366433625400173240ustar00rootroot00000000000000(* * lTerm_dlist.ml * -------------- * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) type 'a t = { mutable prev : 'a t; mutable next : 'a t; } type 'a node = { mutable node_prev : 'a t; mutable node_next : 'a t; mutable node_data : 'a; mutable node_active : bool; } external seq_of_node : 'a node -> 'a t = "%identity" external node_of_seq : 'a t -> 'a node = "%identity" (* +-----------------------------------------------------------------+ | Operations on nodes | +-----------------------------------------------------------------+ *) let remove node = if node.node_active then begin node.node_active <- false; let seq = seq_of_node node in seq.prev.next <- seq.next; seq.next.prev <- seq.prev end (* +-----------------------------------------------------------------+ | Operations on sequences | +-----------------------------------------------------------------+ *) let create () = let rec seq = { prev = seq; next = seq } in seq let add_l data seq = let node = { node_prev = seq; node_next = seq.next; node_data = data; node_active = true } in seq.next.prev <- seq_of_node node; seq.next <- seq_of_node node; node let iter_l f seq = let rec loop curr = if curr != seq then begin let node = node_of_seq curr in if node.node_active then f node.node_data; loop node.node_next end in loop seq.next let fold_l f seq acc = let rec loop curr acc = if curr == seq then acc else let node = node_of_seq curr in if node.node_active then loop node.node_next (f node.node_data acc) else loop node.node_next acc in loop seq.next acc lambda-term-3.1.0/src/lTerm_dlist.mli000066400000000000000000000034011366433625400174660ustar00rootroot00000000000000(* * lTerm_dlist.mli * --------------- * Copyright : (c) 2009, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Mutable sequence of elements (deprecated) *) (** A sequence is an object holding a list of elements which support the following operations: - adding an element to the left or the right in time and space O(1) - taking an element from the left or the right in time and space O(1) - removing a previously added element from a sequence in time and space O(1) - removing an element while the sequence is being transversed. @deprecated This module should be an internal implementation detail of Lwt, and may be removed from the API at some point in the future. Use any other doubly-linked list library as an alternative. *) type 'a t (** Type of a sequence holding values of type ['a] *) type 'a node (** Type of a node holding one value of type ['a] in a sequence *) (** {2 Operation on nodes} *) val remove : 'a node -> unit (** Removes a node from the sequence it is part of. It does nothing if the node has already been removed. *) (** {2 Operations on sequence} *) val create : unit -> 'a t (** [create ()] creates a new empty sequence *) val add_l : 'a -> 'a t -> 'a node (** [add_l x s] adds [x] to the left of the sequence [s] *) (** {2 Sequence iterators} *) (** Note: it is OK to remove a node while traversing a sequence *) val iter_l : ('a -> unit) -> 'a t -> unit (** [iter_l f s] applies [f] on all elements of [s] starting from the left *) val fold_l : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** [fold_l f s] is: {[ fold_l f s x = f en (... (f e2 (f e1 x))) ]} where [e1], [e2], ..., [en] are the elements of [s] *) lambda-term-3.1.0/src/lTerm_draw.ml000066400000000000000000000740061366433625400171440ustar00rootroot00000000000000(* * lTerm_draw.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile open LTerm_geom open Result let unsafe_get matrix line column = Array.unsafe_get (Array.unsafe_get matrix line) column type elem = { char : Zed_char.t; bold : bool; underline : bool; blink : bool; reverse : bool; foreground : LTerm_style.color; background : LTerm_style.color; } let space = Zed_char.unsafe_of_char ' ' let newline = Zed_char.unsafe_of_char '\n' let elem_empty= { char= space; bold= false; underline= false; blink= false; reverse= false; foreground= LTerm_style.default; background= LTerm_style.default; } type point'= | Elem of elem | WidthHolder of int type point= point' ref type matrix = point array array let make_matrix size = Array.init size.rows (fun _ -> Array.init size.cols (fun _ -> ref @@ Elem { char = Zed_char.unsafe_of_char ' '; bold = false; underline = false; blink = false; reverse = false; foreground = LTerm_style.default; background = LTerm_style.default; })) let set_style_elem elem style= let bold= match LTerm_style.bold style with | Some x-> x | None-> elem.bold and underline= match LTerm_style.underline style with | Some x-> x | None-> elem.underline and blink= match LTerm_style.blink style with | Some x-> x | None-> elem.blink and reverse= match LTerm_style.reverse style with | Some x-> x | None-> elem.reverse and foreground= match LTerm_style.foreground style with | Some x-> x | None-> elem.foreground and background= match LTerm_style.background style with | Some x-> x | None-> elem.background in { elem with bold; underline; blink; reverse; foreground; background } let set_style point style= match !point with | Elem elem-> point:= Elem (set_style_elem elem style) | WidthHolder _-> () let maybe_set_style point style= match !point, style with | Elem _, Some style-> set_style point style | _-> () type context= { ctx_matrix : matrix; ctx_matrix_size : size; ctx_row1 : int; ctx_col1 : int; ctx_row2 : int; ctx_col2 : int; } let context m s = if Array.length m <> s.rows then invalid_arg "LTerm_draw.context"; Array.iter (fun l -> if Array.length l <> s.cols then invalid_arg "LTerm_draw.context") m; { ctx_matrix = m; ctx_matrix_size = s; ctx_row1 = 0; ctx_col1 = 0; ctx_row2 = s.rows; ctx_col2 = s.cols; } let size ctx = { rows = ctx.ctx_row2 - ctx.ctx_row1; cols = ctx.ctx_col2 - ctx.ctx_col1; } exception Out_of_bounds let sub_opt ctx rect = if rect.row1 < 0 || rect.col1 < 0 || rect.row1 > rect.row2 || rect.col1 > rect.col2 then None else let row1 = ctx.ctx_row1 + rect.row1 and col1 = ctx.ctx_col1 + rect.col1 and row2 = ctx.ctx_row1 + rect.row2 and col2 = ctx.ctx_col1 + rect.col2 in if row2 > ctx.ctx_row2 || col2 > ctx.ctx_col2 then None else Some { ctx with ctx_row1 = row1; ctx_col1 = col1; ctx_row2 = row2; ctx_col2 = col2 } let sub ctx rect = match sub_opt ctx rect with | None -> raise Out_of_bounds | Some(ctx) -> ctx let clear ctx = for row = ctx.ctx_row1 to ctx.ctx_row2 - 1 do for col = ctx.ctx_col1 to ctx.ctx_col2 - 1 do let point = unsafe_get ctx.ctx_matrix row col in point:= Elem elem_empty done done let get_elem matrix row col= let point = unsafe_get matrix row col in match !point with | Elem elem-> elem | WidthHolder _-> elem_empty let fill ctx ?style ch = let get_elem= get_elem ctx.ctx_matrix in match style with | Some style -> for row = ctx.ctx_row1 to ctx.ctx_row2 - 1 do for col = ctx.ctx_col1 to ctx.ctx_col2 - 1 do let point = unsafe_get ctx.ctx_matrix row col in let elem= match !point with | Elem elem-> { elem with char= ch} | WidthHolder n-> let elem= get_elem row (col-n) in { elem with char= ch } in point:= Elem elem; set_style point style done done | None -> for row = ctx.ctx_row1 to ctx.ctx_row2 - 1 do for col = ctx.ctx_col1 to ctx.ctx_col2 - 1 do let point = unsafe_get ctx.ctx_matrix row col in let elem= match !point with | Elem elem-> { elem with char= ch} | WidthHolder n-> let elem= get_elem row (col-n) in { elem with char= ch } in point:= Elem elem; done done let fill_style ctx style = for row = ctx.ctx_row1 to ctx.ctx_row2 - 1 do for col = ctx.ctx_col1 to ctx.ctx_col2 - 1 do set_style (unsafe_get ctx.ctx_matrix row col) style done done let point ctx row col = if row < 0 || col < 0 then raise Out_of_bounds; let row = ctx.ctx_row1 + row and col = ctx.ctx_col1 + col in if row >= ctx.ctx_row2 || col >= ctx.ctx_col2 then raise Out_of_bounds; unsafe_get ctx.ctx_matrix row col let unsafe_del matrix row col len= let pos_end= col + len in let rec fill elem col n= if n > 0 then let point= unsafe_get matrix row col in point:= Elem elem; fill elem (col+1) (n-1) in let rec find col= let point= unsafe_get matrix row col in match !point with | Elem elem-> let width= Zed_char.width elem.char in let elem= { elem with char= space } in point:= Elem elem; if width > 1 then fill elem (col + 1) (width - 1); col + (max width 1) | WidthHolder n-> find (col-n) in let rec del pos= if pos < pos_end then del (find col) in del col let draw_char_matrix matrix row col ?style ch= let size= let rows= Array.length matrix in let cols= if rows > 0 then Array.length matrix.(0) else 0 in { rows; cols } in let unsafe_get matrix row col = Array.unsafe_get (Array.unsafe_get matrix row) col in let width= Zed_char.width ch in if row >= 0 && col >= 0 && col + width <= size.cols then begin let point= unsafe_get matrix row col in (match !point with | Elem elem-> point:= Elem { elem with char= ch }; if width > 1 then for i = 1 to width - 1 do let point= unsafe_get matrix row (col+i) in point:= WidthHolder i done | WidthHolder n-> unsafe_del matrix row (col-n) 1; let elem= get_elem matrix row (col-n) in point:= Elem { elem with char= ch }; if width > 1 then for i = 1 to width - 1 do let point= unsafe_get matrix row (col+i) in point:= WidthHolder i done ); maybe_set_style point style end let unsafe_draw_char_raw ctx row col ?style ch= let width= Zed_char.width ch in if row >= 0 && col >= 0 then begin let point= unsafe_get ctx.ctx_matrix row col in (match !point with | Elem elem-> point:= Elem { elem with char= ch }; if width > 1 then for i = 1 to width - 1 do let point= unsafe_get ctx.ctx_matrix row (col+i) in point:= WidthHolder i done | WidthHolder n-> unsafe_del ctx.ctx_matrix row (col-n) 1; let elem= get_elem ctx.ctx_matrix row (col-n) in point:= Elem { elem with char= ch }; if width > 1 then for i = 1 to width - 1 do let point= unsafe_get ctx.ctx_matrix row (col+i) in point:= WidthHolder i done ); maybe_set_style point style end let draw_char_raw ctx row col ?style ch= let width= Zed_char.width ch in if row >= ctx.ctx_row1 && row < ctx.ctx_row2 && col >= ctx.ctx_col1 && col + width <= ctx.ctx_col2 then unsafe_draw_char_raw ctx row col ?style ch let draw_char ctx row col ?style ch= let row= ctx.ctx_row1 + row and col = ctx.ctx_col1 + col in draw_char_raw ctx row col ?style ch let draw_string ctx row col ?style str= let len= Zed_string.bytes str in let rec loop row col ofs= if ofs < len then let ch, ofs= Zed_string.extract_next str ofs in if ch = newline then loop (row + 1) ctx.ctx_col1 ofs else begin let width= Zed_char.width ch in draw_char_raw ctx row col ?style ch; loop row (col + max 0 width) ofs end in loop (ctx.ctx_row1 + row) (ctx.ctx_col1 + col) 0 let draw_styled ctx row col ?style str= let rec loop row col idx= if idx < Array.length str then begin let ch, ch_style= Array.unsafe_get str idx in if ch = newline then loop (row + 1) ctx.ctx_col1 (idx + 1) else begin let width= Zed_char.width ch in if row >= ctx.ctx_row1 && row < ctx.ctx_row2 && col >= ctx.ctx_col1 && col + width <= ctx.ctx_col2 then begin let point= unsafe_get ctx.ctx_matrix row col in draw_char_raw ctx row col ?style ch; set_style point ch_style; end; loop row (col + max 0 width) (idx + 1); end end in loop (ctx.ctx_row1 + row) (ctx.ctx_col1 + col) 0 let draw_string_aligned ctx row alignment ?style str= let actual_width= function | Ok {Zed_string.len=_;width}-> width | Error {Zed_string.start=_;len=_;width}-> width in let line_width start= actual_width (Zed_string.width_ofs ~start str) in let rec loop row col ofs= if ofs < Zed_string.bytes str then begin let ch, ofs= Zed_string.extract_next str ofs in if ch = newline then ofs else begin let width= Zed_char.width ch in draw_char_raw ctx row col ?style ch; loop row (col + max 0 width) ofs; end end else ofs in let rec loop_lines row ofs= if ofs < Zed_string.bytes str then begin let ofs= loop row (match alignment with | H_align_left -> ctx.ctx_col1 | H_align_center -> ctx.ctx_col1 + (ctx.ctx_col2 - ctx.ctx_col1 - line_width ofs) / 2 | H_align_right -> ctx.ctx_col2 - line_width ofs) ofs in loop_lines (row + 1) ofs end in loop_lines (ctx.ctx_row1 + row) 0 let draw_styled_aligned ctx row alignment ?style str= let str, styles= let len= Array.length str in Zed_string.implode (Array.to_list (Array.init len (fun i-> fst (Array.get str i)))) , (Array.init len (fun i-> snd (Array.get str i))) in let actual_width= function | Ok {Zed_string.len=_;width}-> width | Error {Zed_string.start=_;len=_;width}-> width in let line_width start= actual_width (Zed_string.width_ofs ~start str) in let rec loop row col idx ofs= if ofs < Zed_string.bytes str then begin let (ch, ofs), ch_style= Zed_string.extract_next str ofs, Array.unsafe_get styles idx and idx= idx + 1 in if ch = newline then (idx, ofs) else begin let point= unsafe_get ctx.ctx_matrix row col in draw_char_raw ctx row col ?style ch; set_style point ch_style; loop row (col + Zed_char.width ch) idx ofs; end end else (idx, ofs) in let rec loop_lines row idx ofs= if ofs < Zed_string.bytes str then begin let idx, ofs= loop row (match alignment with | H_align_left -> ctx.ctx_col1 | H_align_center -> ctx.ctx_col1 + (ctx.ctx_col2 - ctx.ctx_col1 - line_width ofs) / 2 | H_align_right -> ctx.ctx_col2 - line_width idx) idx ofs in loop_lines (row + 1) idx ofs end in loop_lines (ctx.ctx_row1 + row) 0 0 type connection = | Blank | Light | Heavy type piece = { top : connection; bottom : connection; left : connection; right : connection } let piece_of_char char = match UChar.code char with | 0x2500 -> Some { top = Blank; bottom = Blank; left = Light; right = Light } | 0x2501 -> Some { top = Blank; bottom = Blank; left = Heavy; right = Heavy } | 0x2502 -> Some { top = Light; bottom = Light; left = Blank; right = Blank } | 0x2503 -> Some { top = Heavy; bottom = Heavy; left = Blank; right = Blank } | 0x250c -> Some { top = Blank; bottom = Light; left = Blank; right = Light } | 0x250d -> Some { top = Blank; bottom = Light; left = Blank; right = Heavy } | 0x250e -> Some { top = Blank; bottom = Heavy; left = Blank; right = Light } | 0x250f -> Some { top = Blank; bottom = Heavy; left = Blank; right = Heavy } | 0x2510 -> Some { top = Blank; bottom = Light; left = Light; right = Blank } | 0x2511 -> Some { top = Blank; bottom = Light; left = Heavy; right = Blank } | 0x2512 -> Some { top = Blank; bottom = Heavy; left = Light; right = Blank } | 0x2513 -> Some { top = Blank; bottom = Heavy; left = Heavy; right = Blank } | 0x2514 -> Some { top = Light; bottom = Blank; left = Blank; right = Light } | 0x2515 -> Some { top = Light; bottom = Blank; left = Blank; right = Heavy } | 0x2516 -> Some { top = Heavy; bottom = Blank; left = Blank; right = Light } | 0x2517 -> Some { top = Heavy; bottom = Blank; left = Blank; right = Heavy } | 0x2518 -> Some { top = Light; bottom = Blank; left = Light; right = Blank } | 0x2519 -> Some { top = Light; bottom = Blank; left = Heavy; right = Blank } | 0x251a -> Some { top = Heavy; bottom = Blank; left = Light; right = Blank } | 0x251b -> Some { top = Heavy; bottom = Blank; left = Heavy; right = Blank } | 0x251c -> Some { top = Light; bottom = Light; left = Blank; right = Light } | 0x251d -> Some { top = Light; bottom = Light; left = Blank; right = Heavy } | 0x251e -> Some { top = Heavy; bottom = Light; left = Blank; right = Light } | 0x251f -> Some { top = Light; bottom = Heavy; left = Blank; right = Light } | 0x2520 -> Some { top = Heavy; bottom = Heavy; left = Blank; right = Light } | 0x2521 -> Some { top = Heavy; bottom = Light; left = Blank; right = Heavy } | 0x2522 -> Some { top = Light; bottom = Heavy; left = Blank; right = Heavy } | 0x2523 -> Some { top = Heavy; bottom = Heavy; left = Blank; right = Heavy } | 0x2524 -> Some { top = Light; bottom = Light; left = Light; right = Blank } | 0x2525 -> Some { top = Light; bottom = Light; left = Heavy; right = Blank } | 0x2526 -> Some { top = Heavy; bottom = Light; left = Light; right = Blank } | 0x2527 -> Some { top = Light; bottom = Heavy; left = Light; right = Blank } | 0x2528 -> Some { top = Heavy; bottom = Heavy; left = Light; right = Blank } | 0x2529 -> Some { top = Heavy; bottom = Light; left = Heavy; right = Blank } | 0x252a -> Some { top = Light; bottom = Heavy; left = Heavy; right = Blank } | 0x252b -> Some { top = Heavy; bottom = Heavy; left = Heavy; right = Blank } | 0x252c -> Some { top = Blank; bottom = Light; left = Light; right = Light } | 0x252d -> Some { top = Blank; bottom = Light; left = Heavy; right = Light } | 0x252e -> Some { top = Blank; bottom = Light; left = Light; right = Heavy } | 0x252f -> Some { top = Blank; bottom = Light; left = Heavy; right = Heavy } | 0x2530 -> Some { top = Blank; bottom = Heavy; left = Light; right = Light } | 0x2531 -> Some { top = Blank; bottom = Heavy; left = Heavy; right = Light } | 0x2532 -> Some { top = Blank; bottom = Heavy; left = Light; right = Heavy } | 0x2533 -> Some { top = Blank; bottom = Heavy; left = Heavy; right = Heavy } | 0x2534 -> Some { top = Light; bottom = Blank; left = Light; right = Light } | 0x2535 -> Some { top = Light; bottom = Blank; left = Heavy; right = Light } | 0x2536 -> Some { top = Light; bottom = Blank; left = Light; right = Heavy } | 0x2537 -> Some { top = Light; bottom = Blank; left = Heavy; right = Heavy } | 0x2538 -> Some { top = Heavy; bottom = Blank; left = Light; right = Light } | 0x2539 -> Some { top = Heavy; bottom = Blank; left = Heavy; right = Light } | 0x253a -> Some { top = Heavy; bottom = Blank; left = Light; right = Heavy } | 0x253b -> Some { top = Heavy; bottom = Blank; left = Heavy; right = Heavy } | 0x253c -> Some { top = Light; bottom = Light; left = Light; right = Light } | 0x253d -> Some { top = Light; bottom = Light; left = Heavy; right = Light } | 0x253e -> Some { top = Light; bottom = Light; left = Light; right = Heavy } | 0x253f -> Some { top = Light; bottom = Light; left = Heavy; right = Heavy } | 0x2540 -> Some { top = Heavy; bottom = Light; left = Light; right = Light } | 0x2541 -> Some { top = Light; bottom = Heavy; left = Light; right = Light } | 0x2542 -> Some { top = Heavy; bottom = Heavy; left = Light; right = Light } | 0x2543 -> Some { top = Heavy; bottom = Light; left = Heavy; right = Light } | 0x2544 -> Some { top = Heavy; bottom = Light; left = Light; right = Heavy } | 0x2545 -> Some { top = Light; bottom = Heavy; left = Heavy; right = Light } | 0x2546 -> Some { top = Light; bottom = Heavy; left = Light; right = Heavy } | 0x2547 -> Some { top = Heavy; bottom = Light; left = Heavy; right = Heavy } | 0x2548 -> Some { top = Light; bottom = Heavy; left = Heavy; right = Heavy } | 0x2549 -> Some { top = Heavy; bottom = Heavy; left = Heavy; right = Light } | 0x254a -> Some { top = Heavy; bottom = Heavy; left = Light; right = Heavy } | 0x254b -> Some { top = Heavy; bottom = Heavy; left = Heavy; right = Heavy } | 0x2574 -> Some { top = Blank; bottom = Blank; left = Light; right = Blank } | 0x2575 -> Some { top = Light; bottom = Blank; left = Blank; right = Blank } | 0x2576 -> Some { top = Blank; bottom = Blank; left = Blank; right = Light } | 0x2577 -> Some { top = Blank; bottom = Light; left = Blank; right = Blank } | 0x2578 -> Some { top = Blank; bottom = Blank; left = Heavy; right = Blank } | 0x2579 -> Some { top = Heavy; bottom = Blank; left = Blank; right = Blank } | 0x257a -> Some { top = Blank; bottom = Blank; left = Blank; right = Heavy } | 0x257b -> Some { top = Blank; bottom = Heavy; left = Blank; right = Blank } | 0x257c -> Some { top = Blank; bottom = Blank; left = Light; right = Heavy } | 0x257d -> Some { top = Light; bottom = Heavy; left = Blank; right = Blank } | 0x257e -> Some { top = Blank; bottom = Blank; left = Heavy; right = Light } | 0x257f -> Some { top = Heavy; bottom = Light; left = Blank; right = Blank } | _ -> None let char_of_piece = function | { top = Blank; bottom = Blank; left = Blank; right = Blank } -> UChar.of_int 0x0020 | { top = Blank; bottom = Blank; left = Light; right = Light } -> UChar.of_int 0x2500 | { top = Blank; bottom = Blank; left = Heavy; right = Heavy } -> UChar.of_int 0x2501 | { top = Light; bottom = Light; left = Blank; right = Blank } -> UChar.of_int 0x2502 | { top = Heavy; bottom = Heavy; left = Blank; right = Blank } -> UChar.of_int 0x2503 | { top = Blank; bottom = Light; left = Blank; right = Light } -> UChar.of_int 0x250c | { top = Blank; bottom = Light; left = Blank; right = Heavy } -> UChar.of_int 0x250d | { top = Blank; bottom = Heavy; left = Blank; right = Light } -> UChar.of_int 0x250e | { top = Blank; bottom = Heavy; left = Blank; right = Heavy } -> UChar.of_int 0x250f | { top = Blank; bottom = Light; left = Light; right = Blank } -> UChar.of_int 0x2510 | { top = Blank; bottom = Light; left = Heavy; right = Blank } -> UChar.of_int 0x2511 | { top = Blank; bottom = Heavy; left = Light; right = Blank } -> UChar.of_int 0x2512 | { top = Blank; bottom = Heavy; left = Heavy; right = Blank } -> UChar.of_int 0x2513 | { top = Light; bottom = Blank; left = Blank; right = Light } -> UChar.of_int 0x2514 | { top = Light; bottom = Blank; left = Blank; right = Heavy } -> UChar.of_int 0x2515 | { top = Heavy; bottom = Blank; left = Blank; right = Light } -> UChar.of_int 0x2516 | { top = Heavy; bottom = Blank; left = Blank; right = Heavy } -> UChar.of_int 0x2517 | { top = Light; bottom = Blank; left = Light; right = Blank } -> UChar.of_int 0x2518 | { top = Light; bottom = Blank; left = Heavy; right = Blank } -> UChar.of_int 0x2519 | { top = Heavy; bottom = Blank; left = Light; right = Blank } -> UChar.of_int 0x251a | { top = Heavy; bottom = Blank; left = Heavy; right = Blank } -> UChar.of_int 0x251b | { top = Light; bottom = Light; left = Blank; right = Light } -> UChar.of_int 0x251c | { top = Light; bottom = Light; left = Blank; right = Heavy } -> UChar.of_int 0x251d | { top = Heavy; bottom = Light; left = Blank; right = Light } -> UChar.of_int 0x251e | { top = Light; bottom = Heavy; left = Blank; right = Light } -> UChar.of_int 0x251f | { top = Heavy; bottom = Heavy; left = Blank; right = Light } -> UChar.of_int 0x2520 | { top = Heavy; bottom = Light; left = Blank; right = Heavy } -> UChar.of_int 0x2521 | { top = Light; bottom = Heavy; left = Blank; right = Heavy } -> UChar.of_int 0x2522 | { top = Heavy; bottom = Heavy; left = Blank; right = Heavy } -> UChar.of_int 0x2523 | { top = Light; bottom = Light; left = Light; right = Blank } -> UChar.of_int 0x2524 | { top = Light; bottom = Light; left = Heavy; right = Blank } -> UChar.of_int 0x2525 | { top = Heavy; bottom = Light; left = Light; right = Blank } -> UChar.of_int 0x2526 | { top = Light; bottom = Heavy; left = Light; right = Blank } -> UChar.of_int 0x2527 | { top = Heavy; bottom = Heavy; left = Light; right = Blank } -> UChar.of_int 0x2528 | { top = Heavy; bottom = Light; left = Heavy; right = Blank } -> UChar.of_int 0x2529 | { top = Light; bottom = Heavy; left = Heavy; right = Blank } -> UChar.of_int 0x252a | { top = Heavy; bottom = Heavy; left = Heavy; right = Blank } -> UChar.of_int 0x252b | { top = Blank; bottom = Light; left = Light; right = Light } -> UChar.of_int 0x252c | { top = Blank; bottom = Light; left = Heavy; right = Light } -> UChar.of_int 0x252d | { top = Blank; bottom = Light; left = Light; right = Heavy } -> UChar.of_int 0x252e | { top = Blank; bottom = Light; left = Heavy; right = Heavy } -> UChar.of_int 0x252f | { top = Blank; bottom = Heavy; left = Light; right = Light } -> UChar.of_int 0x2530 | { top = Blank; bottom = Heavy; left = Heavy; right = Light } -> UChar.of_int 0x2531 | { top = Blank; bottom = Heavy; left = Light; right = Heavy } -> UChar.of_int 0x2532 | { top = Blank; bottom = Heavy; left = Heavy; right = Heavy } -> UChar.of_int 0x2533 | { top = Light; bottom = Blank; left = Light; right = Light } -> UChar.of_int 0x2534 | { top = Light; bottom = Blank; left = Heavy; right = Light } -> UChar.of_int 0x2535 | { top = Light; bottom = Blank; left = Light; right = Heavy } -> UChar.of_int 0x2536 | { top = Light; bottom = Blank; left = Heavy; right = Heavy } -> UChar.of_int 0x2537 | { top = Heavy; bottom = Blank; left = Light; right = Light } -> UChar.of_int 0x2538 | { top = Heavy; bottom = Blank; left = Heavy; right = Light } -> UChar.of_int 0x2539 | { top = Heavy; bottom = Blank; left = Light; right = Heavy } -> UChar.of_int 0x253a | { top = Heavy; bottom = Blank; left = Heavy; right = Heavy } -> UChar.of_int 0x253b | { top = Light; bottom = Light; left = Light; right = Light } -> UChar.of_int 0x253c | { top = Light; bottom = Light; left = Heavy; right = Light } -> UChar.of_int 0x253d | { top = Light; bottom = Light; left = Light; right = Heavy } -> UChar.of_int 0x253e | { top = Light; bottom = Light; left = Heavy; right = Heavy } -> UChar.of_int 0x253f | { top = Heavy; bottom = Light; left = Light; right = Light } -> UChar.of_int 0x2540 | { top = Light; bottom = Heavy; left = Light; right = Light } -> UChar.of_int 0x2541 | { top = Heavy; bottom = Heavy; left = Light; right = Light } -> UChar.of_int 0x2542 | { top = Heavy; bottom = Light; left = Heavy; right = Light } -> UChar.of_int 0x2543 | { top = Heavy; bottom = Light; left = Light; right = Heavy } -> UChar.of_int 0x2544 | { top = Light; bottom = Heavy; left = Heavy; right = Light } -> UChar.of_int 0x2545 | { top = Light; bottom = Heavy; left = Light; right = Heavy } -> UChar.of_int 0x2546 | { top = Heavy; bottom = Light; left = Heavy; right = Heavy } -> UChar.of_int 0x2547 | { top = Light; bottom = Heavy; left = Heavy; right = Heavy } -> UChar.of_int 0x2548 | { top = Heavy; bottom = Heavy; left = Heavy; right = Light } -> UChar.of_int 0x2549 | { top = Heavy; bottom = Heavy; left = Light; right = Heavy } -> UChar.of_int 0x254a | { top = Heavy; bottom = Heavy; left = Heavy; right = Heavy } -> UChar.of_int 0x254b | { top = Blank; bottom = Blank; left = Light; right = Blank } -> UChar.of_int 0x2574 | { top = Light; bottom = Blank; left = Blank; right = Blank } -> UChar.of_int 0x2575 | { top = Blank; bottom = Blank; left = Blank; right = Light } -> UChar.of_int 0x2576 | { top = Blank; bottom = Light; left = Blank; right = Blank } -> UChar.of_int 0x2577 | { top = Blank; bottom = Blank; left = Heavy; right = Blank } -> UChar.of_int 0x2578 | { top = Heavy; bottom = Blank; left = Blank; right = Blank } -> UChar.of_int 0x2579 | { top = Blank; bottom = Blank; left = Blank; right = Heavy } -> UChar.of_int 0x257a | { top = Blank; bottom = Heavy; left = Blank; right = Blank } -> UChar.of_int 0x257b | { top = Blank; bottom = Blank; left = Light; right = Heavy } -> UChar.of_int 0x257c | { top = Light; bottom = Heavy; left = Blank; right = Blank } -> UChar.of_int 0x257d | { top = Blank; bottom = Blank; left = Heavy; right = Light } -> UChar.of_int 0x257e | { top = Heavy; bottom = Light; left = Blank; right = Blank } -> UChar.of_int 0x257f let piece_of_point point= match !point with | Elem elem-> piece_of_char (Zed_char.core elem.char) | WidthHolder _-> None let draw_piece ctx row col ?style piece= let row= ctx.ctx_row1 + row and col= ctx.ctx_col1 + col in if row >= ctx.ctx_row1 && col >= ctx.ctx_col1 && row < ctx.ctx_row2 && col < ctx.ctx_col2 then begin let piece= if row > 0 then begin let point= unsafe_get ctx.ctx_matrix (row - 1) col in match piece_of_point point with | None -> piece | Some piece' -> if piece.top = piece'.bottom then piece else if piece.top = Blank then { piece with top = piece'.bottom } else if piece'.bottom = Blank then begin let char= Zed_char.unsafe_of_uChar (char_of_piece { piece' with bottom = piece.top }) in unsafe_draw_char_raw ctx (row-1) col char; piece end else piece end else piece in let piece= if row < ctx.ctx_matrix_size.rows - 1 then begin let point= unsafe_get ctx.ctx_matrix (row + 1) col in match piece_of_point point with | None -> piece | Some piece' -> if piece.bottom = piece'.top then piece else if piece.bottom = Blank then { piece with bottom = piece'.top } else if piece'.top = Blank then begin let char= Zed_char.unsafe_of_uChar (char_of_piece { piece' with top = piece.bottom }) in unsafe_draw_char_raw ctx (row+1) col char; piece end else piece end else piece in let piece= if col > 0 then begin let point= unsafe_get ctx.ctx_matrix row (col - 1) in match piece_of_point point with | None -> piece | Some piece' -> if piece.left = piece'.right then piece else if piece.left = Blank then { piece with left = piece'.right } else if piece'.right = Blank then begin let char= Zed_char.unsafe_of_uChar (char_of_piece { piece' with right = piece.left }) in unsafe_draw_char_raw ctx row (col-1) char; piece end else piece end else piece in let piece= if col < ctx.ctx_matrix_size.cols - 1 then begin let point= unsafe_get ctx.ctx_matrix row (col + 1) in match piece_of_point point with | None -> piece | Some piece' -> if piece.right = piece'.left then piece else if piece.right = Blank then { piece with right = piece'.left } else if piece'.left = Blank then begin let char= Zed_char.unsafe_of_uChar (char_of_piece { piece' with left = piece.right }) in unsafe_draw_char_raw ctx row (col+1) char; piece end else piece end else piece in let char= Zed_char.unsafe_of_uChar (char_of_piece piece) in unsafe_draw_char_raw ctx row col ?style char end let draw_hline ctx row col len ?style connection = let piece = { top = Blank; bottom = Blank; left = connection; right = connection } in for i = 0 to len - 1 do draw_piece ctx row (col + i) ?style piece done let draw_vline ctx row col len ?style connection = let piece = { top = connection; bottom = connection; left = Blank; right = Blank } in for i = 0 to len - 1 do draw_piece ctx (row + i) col ?style piece done let draw_frame ctx rect ?style connection = let hline = { top = Blank; bottom = Blank; left = connection; right = connection } in let vline = { top = connection; bottom = connection; left = Blank; right = Blank } in for col = rect.col1 + 1 to rect.col2 - 2 do draw_piece ctx (rect.row1 + 0) col ?style hline; draw_piece ctx (rect.row2 - 1) col ?style hline done; for row = rect.row1 + 1 to rect.row2 - 2 do draw_piece ctx row (rect.col1 + 0) ?style vline; draw_piece ctx row (rect.col2 - 1) ?style vline done; draw_piece ctx (rect.row1 + 0) (rect.col1 + 0) ?style { top = Blank; bottom = connection; left = Blank; right = connection }; draw_piece ctx (rect.row1 + 0) (rect.col2 - 1) ?style { top = Blank; bottom = connection; left = connection; right = Blank }; draw_piece ctx (rect.row2 - 1) (rect.col2 - 1) ?style { top = connection; bottom = Blank; left = connection; right = Blank }; draw_piece ctx (rect.row2 - 1) (rect.col1 + 0) ?style { top = connection; bottom = Blank; left = Blank; right = connection } let draw_frame_labelled ctx rect ?style ?(alignment=H_align_left) label connection = draw_frame ctx rect ?style connection; let rect = { row1 = rect.row1; row2 = rect.row1+1; col1 = rect.col1+1; col2 = rect.col2-1 } in match sub_opt ctx rect with | Some(ctx) -> draw_string_aligned ctx 0 alignment label | None -> () lambda-term-3.1.0/src/lTerm_draw.mli000066400000000000000000000125071366433625400173130ustar00rootroot00000000000000(* * lTerm_draw.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Drawing *) open LTerm_geom (** Type of a element in a matrix of styled characters. *) type elem = { char : Zed_char.t; (** The Zed_char.t character. *) bold : bool; (** Whether the character is in bold or not. *) underline : bool; (** Whether the character is underlined or not. *) blink : bool; (** Whether the character is blinking or not. *) reverse : bool; (** Whether the character is in reverse video mode or not. *) foreground : LTerm_style.color; (** The foreground color. *) background : LTerm_style.color; (** The background color. *) } type point'= | Elem of elem | WidthHolder of int (** Type of a point in a matrix of styled characters. *) type point= point' ref type matrix = point array array (** Type of a matrix of points. The matrix is indexed by lines then columns, i.e. to access the point at line [l] and column [c] in matrix [m] you should use [m.(l).(c)]. *) val make_matrix : LTerm_geom.size -> matrix (** [matrix size] creates a matrix of the given size containing only blank characters. *) val set_style : point -> LTerm_style.t -> unit (** [set_style point style] sets fields of [point] according to fields of [style]. For example: {[ set_style point { LTerm_style.none with LTerm_style.bold = Some true } ]} will have the following effect: {[ point.bold <- true ]} *) type context (** Type of contexts. A context is used for drawing. *) val context : matrix -> LTerm_geom.size -> context (** [context m s] creates a context from a matrix [m] of size [s]. It raises [Invalid_argument] if [s] is not the size of [m]. *) exception Out_of_bounds (** Exception raised when trying to access a point that is outside the bounds of a context. *) val size : context -> size (** [size ctx] returns the size of the given context. *) val sub : context -> rect -> context (** [sub ctx rect] creates a sub-context from the given context. It raises {!Out_of_bounds} if the rectangle is not contained in the given context. *) val clear : context -> unit (** [clear ctx] clears the given context. It resets all styles to their default and sets characters to spaces. *) val fill : context -> ?style : LTerm_style.t -> Zed_char.t -> unit (** [fill ctx ch] fills the given context with [ch]. *) val fill_style : context -> LTerm_style.t -> unit (** [fill_style style] fills the given context with [style]. *) val point : context -> int -> int -> point (** [point ctx row column] returns the point at given position in [ctx]. It raises {!Out_of_bounds} if the coordinates are outside the given context. *) val draw_char_matrix : matrix -> int -> int -> ?style : LTerm_style.t -> Zed_char.t -> unit (** [draw_char_matrix matrix row column ?style ch] sets the character at given coordinates to [ch]. It does nothing if the given coordinates are outside the bounds of the context. *) val draw_char : context -> int -> int -> ?style : LTerm_style.t -> Zed_char.t -> unit (** [draw_char ctx row column ?style ch] sets the character at given coordinates to [ch]. It does nothing if the given coordinates are outside the bounds of the context. *) val draw_string : context -> int -> int -> ?style : LTerm_style.t -> Zed_string.t -> unit (** [draw_string ctx row column ?style str] draws the given string at given coordinates. This does not affect styles. [str] may contains newlines. *) val draw_styled : context -> int -> int -> ?style : LTerm_style.t -> LTerm_text.t -> unit (** [draw_styled ctx row column ?style text] draws the given styled text at given coordinates. *) val draw_string_aligned : context -> int -> horz_alignment -> ?style : LTerm_style.t -> Zed_string.t -> unit (** Draws a string with the given alignment. *) val draw_styled_aligned : context -> int -> horz_alignment -> ?style : LTerm_style.t -> LTerm_text.t -> unit (** Draws a styled string with the given aglienment. *) (** Type of an connection in a piece that can be connected to other pieces. *) type connection = | Blank (** No connection. *) | Light (** Connection with a light line. *) | Heavy (** Connection with a heavy line. *) type piece = { top : connection; bottom : connection; left : connection; right : connection } (** Type of a piece, given by its four connection. *) val draw_piece : context -> int -> int -> ?style : LTerm_style.t -> piece -> unit (** Draws a piece. It may modify pieces around it. *) val draw_hline : context -> int -> int -> int -> ?style : LTerm_style.t -> connection -> unit (** [draw_hline ctx row column length connection] draws an horizontal line. *) val draw_vline : context -> int -> int -> int -> ?style : LTerm_style.t -> connection -> unit (** [draw_hline ctx row column length connection] draws a vertical line. *) val draw_frame : context -> rect -> ?style : LTerm_style.t -> connection -> unit (** Draws a rectangle. *) val draw_frame_labelled : context -> rect -> ?style : LTerm_style.t -> ?alignment : LTerm_geom.horz_alignment -> Zed_string.t -> connection -> unit (** Draws a rectangle with a label on the top row. *) lambda-term-3.1.0/src/lTerm_edit.ml000066400000000000000000000502631366433625400171330ustar00rootroot00000000000000(* * lTerm_edit.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) let pervasives_compare= compare open CamomileLibraryDefault.Camomile open Zed_edit open LTerm_key open LTerm_geom open Lwt_react (* +-----------------------------------------------------------------+ | Actions | +-----------------------------------------------------------------+ *) type action = | Zed of Zed_edit.action | Start_macro | Stop_macro | Cancel_macro | Play_macro | Insert_macro_counter | Set_macro_counter | Add_macro_counter | Custom of (unit -> unit) let doc_of_action = function | Zed action -> Zed_edit.doc_of_action action | Start_macro -> "start a new macro." | Stop_macro -> "end the current macro." | Cancel_macro -> "cancel the current macro." | Play_macro -> "play the last recorded macro." | Insert_macro_counter -> "insert the current value of the macro counter." | Set_macro_counter -> "sets the value of the macro counter." | Add_macro_counter -> "adds a value to the macro counter." | Custom _ -> "programmer defined action." let actions = [ Start_macro, "start-macro"; Stop_macro, "stop-macro"; Cancel_macro, "cancel-macro"; Play_macro, "play-macro"; Insert_macro_counter, "insert-macro-counter"; Set_macro_counter, "set-macro-counter"; Add_macro_counter, "add-macro-counter"; ] let actions_to_names = Array.of_list (List.sort (fun (a1, _) (a2, _) -> pervasives_compare a1 a2) actions) let names_to_actions = Array.of_list (List.sort (fun (_, n1) (_, n2) -> pervasives_compare n1 n2) actions) let action_of_name x = let rec loop a b = if a = b then Zed (Zed_edit.action_of_name x) else let c = (a + b) / 2 in let action, name = Array.unsafe_get names_to_actions c in match pervasives_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 pervasives_compare x action with | d when d < 0 -> loop a c | d when d > 0 -> loop (c + 1) b | _ -> name in match x with | Zed x -> Zed_edit.name_of_action x | Custom _ -> "custom" | _ -> loop 0 (Array.length actions_to_names) module Bindings = Zed_input.Make (LTerm_key) let bindings = ref Bindings.empty let bind seq actions = bindings := Bindings.add seq actions !bindings let unbind seq = bindings := Bindings.remove seq !bindings let () = bind [{ control = false; meta = false; shift = false; code = Left }] [Zed Prev_char]; bind [{ control = false; meta = false; shift = false; code = Right }] [Zed Next_char]; bind [{ control = false; meta = false; shift = false; code = Up }] [Zed Prev_line]; bind [{ control = false; meta = false; shift = false; code = Down }] [Zed Next_line]; bind [{ control = false; meta = false; shift = false; code = Home }] [Zed Goto_bol]; bind [{ control = false; meta = false; shift = false; code = End }] [Zed Goto_eol]; bind [{ control = false; meta = false; shift = false; code = Insert }] [Zed Switch_erase_mode]; bind [{ control = false; meta = false; shift = false; code = Delete }] [Zed Delete_next_char]; bind [{ control = false; meta = false; shift = false; code = Enter }] [Zed Newline]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char ' ') }] [Zed Set_mark]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'a') }] [Zed Goto_bol]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'e') }] [Zed Goto_eol]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'd') }] [Zed Delete_next_char]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'h') }] [Zed Delete_prev_char]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') }] [Zed Kill_next_line]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'u') }] [Zed Kill_prev_line]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'n') }] [Zed Next_line]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'p') }] [Zed Prev_line]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'w') }] [Zed Kill]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'y') }] [Zed Yank]; bind [{ control = false; meta = false; shift = false; code = Backspace }] [Zed Delete_prev_char]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'w') }] [Zed Copy]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'c') }] [Zed Capitalize_word]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'l') }] [Zed Lowercase_word]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'u') }] [Zed Uppercase_word]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'b') }] [Zed Prev_word]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'f') }] [Zed Next_word]; bind [{ control = false; meta = true; shift = false; code = Right }] [Zed Next_word]; bind [{ control = false; meta = true; shift = false; code = Left }] [Zed Prev_word]; bind [{ control = true; meta = false; shift = false; code = Right }] [Zed Next_word]; bind [{ control = true; meta = false; shift = false; code = Left }] [Zed Prev_word]; bind [{ control = false; meta = true; shift = false; code = Backspace }] [Zed Kill_prev_word]; bind [{ control = false; meta = true; shift = false; code = Delete }] [Zed Kill_prev_word]; bind [{ control = true; meta = false; shift = false; code = Delete }] [Zed Kill_next_word]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'd') }] [Zed Kill_next_word]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char '_') }] [Zed Undo]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char '(') }] [Start_macro]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char ')') }] [Stop_macro]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = false; meta = false; shift = false; code = Char(UChar.of_char 'e') }] [Play_macro]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'g') }] [Cancel_macro]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') }; { control = false; meta = false; shift = false; code = Tab }] [Insert_macro_counter]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') }; { control = true; meta = false; shift = false; code = Char(UChar.of_char 'a') }] [Add_macro_counter]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') }; { control = true; meta = false; shift = false; code = Char(UChar.of_char 'k') }; { control = true; meta = false; shift = false; code = Char(UChar.of_char 'c') }] [Set_macro_counter] (* +-----------------------------------------------------------------+ | Widgets | +-----------------------------------------------------------------+ *) let clipboard = Zed_edit.new_clipboard () let macro = Zed_macro.create [] let regexp_word = 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 dummy_engine = Zed_edit.create () let dummy_cursor = Zed_edit.new_cursor dummy_engine let dummy_context = Zed_edit.context dummy_engine dummy_cursor let newline = Zed_char.unsafe_of_uChar (UChar.of_char '\n') class scrollable = object inherit LTerm_widget.scrollable method! calculate_range page_size document_size = (document_size - page_size/2) end class edit ?(clipboard = clipboard) ?(macro = macro) ?(size = { cols = 1; rows = 1 }) () = let locale, set_locale = S.create None in object(self) inherit LTerm_widget.t "edit" as super val vscroll = new scrollable method vscroll = vscroll method clipboard = clipboard method macro = macro method! can_focus = true val mutable engine = dummy_engine method engine = engine val mutable cursor = dummy_cursor method cursor = cursor val mutable context = dummy_context method context = context method text = Zed_rope.to_string (Zed_edit.text engine) val mutable style = LTerm_style.none val mutable marked_style = LTerm_style.none val mutable current_line_style = LTerm_style.none method! update_resources = let rc = self#resource_class and resources = self#resources in style <- LTerm_resources.get_style rc resources; marked_style <- LTerm_resources.get_style (rc ^ ".marked") resources; current_line_style <- LTerm_resources.get_style (rc ^ ".current-line") resources method editable _pos _len = true method match_word text pos = match_by_regexp_core regexp_word text pos method locale = S.value locale method set_locale locale = set_locale locale val mutable event = E.never val mutable resolver = None val mutable local_bindings = Bindings.empty method bind keys actions = local_bindings <- Bindings.add keys actions local_bindings val mutable shift_width = 0 val mutable start = 0 val mutable start_line = 0 val mutable size = size method! size_request = size method private update_window_position = let line_set = Zed_edit.lines engine in let line_count = Zed_lines.count line_set in let cursor_offset = Zed_cursor.get_position cursor in let cursor_line = Zed_lines.line_index line_set cursor_offset in let cursor_column = cursor_offset - Zed_lines.line_start line_set cursor_line in let column_display= Zed_lines.force_width line_set (Zed_lines.line_start line_set cursor_line) cursor_column in (*** check cursor position is in view *) (* Horizontal check *) if column_display < shift_width || column_display >= shift_width + size.cols then begin shift_width <- max 0 (column_display - size.cols / 2); end; (* Vertical check *) let start_line' = Zed_lines.line_index line_set start in let start_line' = if cursor_line < start_line' || cursor_line >= start_line' + size.rows then begin (*let start_line' = max 0 (cursor_line - size.rows / 2) in*) let line_count = Zed_lines.count line_set in let start_line' = min line_count (max 0 (cursor_line - size.rows / 2)) in start <- Zed_lines.line_start line_set start_line'; start_line' end else start_line' in (* document size *) if start_line <> start_line' then begin start_line <- start_line'; vscroll#set_offset ~trigger_callback:false start_line end; vscroll#set_document_size (line_count+1); () initializer engine <- ( Zed_edit.create ~editable:(fun pos len -> self#editable pos len) ~match_word:(fun text pos -> self#match_word text pos) ~clipboard ~locale () ); cursor <- Zed_edit.new_cursor engine; context <- Zed_edit.context engine cursor; Zed_edit.set_data engine (self :> edit); event <- E.map (fun _ -> self#update_window_position; self#queue_draw) (Zed_edit.update engine [cursor]); self#on_event (function | LTerm_event.Key key -> begin let res = match resolver with | Some res -> res | None -> Bindings.resolver [ Bindings.pack (fun x -> x) local_bindings ; Bindings.pack (fun x -> x) !bindings ] in match Bindings.resolve key res with | Bindings.Accepted actions -> resolver <- None; let rec exec = function | Custom f :: actions -> Zed_macro.add macro (Custom f); f (); exec actions | Zed action :: actions -> Zed_macro.add macro (Zed action); Zed_edit.get_action action context; exec actions | Start_macro :: actions -> Zed_macro.set_recording macro true; exec actions | Stop_macro :: actions -> Zed_macro.set_recording macro false; exec actions | Cancel_macro :: actions -> Zed_macro.cancel macro; exec actions | Play_macro :: actions -> Zed_macro.cancel macro; exec (Zed_macro.contents macro @ actions) | Insert_macro_counter :: actions -> Zed_macro.add macro Insert_macro_counter; Zed_edit.insert context (Zed_rope.of_string (Zed_string.unsafe_of_utf8 (string_of_int (Zed_macro.get_counter macro)))); Zed_macro.add_counter macro 1; exec actions | (Add_macro_counter | Set_macro_counter) :: actions -> exec actions | [] -> true in exec actions | Bindings.Continue res -> resolver <- Some res; true | Bindings.Rejected -> if resolver = None then match key with | { control = false; meta = false; shift = false; code = Char ch } -> Zed_edit.insert_char context ch; true | _ -> false else begin resolver <- None; false end end | _ -> false) method! set_allocation rect = size <- size_of_rect rect; super#set_allocation rect; vscroll#set_page_size size.rows; start <- 0; shift_width <- 0; start_line <- 0; self#update_window_position initializer vscroll#on_offset_change (fun n -> (* find what line the cursor is currently on. *) let line_set = Zed_edit.lines engine in let cursor_offset = Zed_cursor.get_position cursor in let cursor_line = Zed_lines.line_index line_set cursor_offset in start_line <- n; start <- Zed_lines.line_start line_set start_line; if cursor_line < start_line then begin let d = start_line - cursor_line in Zed_edit.move_line context d (* first row *) end else if cursor_line >= start_line + size.rows then begin let line_count = Zed_lines.count line_set in let line = max 0 (min (line_count+1) (start_line + size.rows - 1)) in (* last row *) let d = line - cursor_line in Zed_edit.move_line context d end; self#queue_draw; ) method! draw ctx _focused = let open LTerm_draw in let size = LTerm_draw.size ctx in let line_set = Zed_edit.lines engine in let cursor_offset = Zed_cursor.get_position cursor in let cursor_line = Zed_lines.line_index line_set cursor_offset in let cursor_column = cursor_offset - Zed_lines.line_start line_set cursor_line in (*** Drawing ***) (* Initialises points with the text style and spaces. *) fill ctx (Zed_char.unsafe_of_char ' '); fill_style ctx style; (*** Text drawing ***) let rec draw_line row col zip = if Zed_rope.Zip.at_eos zip then draw_eoi (row + 1) else let char, zip = Zed_rope.Zip.next zip in if char = newline then begin let row = row + 1 in if row < size.rows then begin_line row zip end else begin if col > size.cols then begin let row = row + 1 in if row < size.rows then skip_eol row zip end else begin draw_char ctx row col char; draw_line row (col + (Zed_char.width char)) zip end end and skip_eol row zip = if Zed_rope.Zip.at_eos zip then draw_eoi (row + 1) else let char, zip = Zed_rope.Zip.next zip in if char = newline then begin_line row zip else skip_eol row zip and skip_bol row zip remaining = if remaining <= 0 then draw_line row (-remaining) zip else if Zed_rope.Zip.at_eos zip then draw_eoi (row + 1) else let char, zip = Zed_rope.Zip.next zip in if char = newline then begin let row = row + 1 in if row < size.rows then begin_line row zip end else skip_bol row zip (remaining - (Zed_char.width char)) and begin_line row zip = if Zed_rope.Zip.at_eos zip then draw_eoi row else if shift_width <> 0 then begin skip_bol row zip shift_width end else draw_line row 0 zip and draw_eoi _row = () in let text = Zed_edit.text engine in begin_line 0 (Zed_rope.Zip.make_f text start); (* Colorize the current line. *) for col = 0 to size.cols - 1 do set_style (point ctx (cursor_line - start_line) col) current_line_style done; (* Colorize the selection if needed *) if Zed_edit.get_selection engine then begin let sel_offset = Zed_cursor.get_position (Zed_edit.mark engine) in let sel_line = Zed_lines.line_index line_set sel_offset in let sel_column = sel_offset - Zed_lines.line_start line_set sel_line in let line_a, column_a, line_b, column_b = if sel_offset < cursor_offset then (sel_line, sel_column, cursor_line, cursor_column) else (cursor_line, cursor_column, sel_line, sel_column) in let line_a, column_a = if line_a < start_line then (start_line, 0) else (line_a, column_a) in let line_b, column_b = if line_b >= start_line + size.rows then (start_line + size.rows - 1, size.cols - 1) else (line_b, column_b) in if line_a < start_line + size.rows && line_b >= start_line then begin let line_a = line_a - start_line and line_b = line_b - start_line in let column_a = column_a and column_b = column_b in if line_a = line_b then for column = column_a to column_b - 1 do set_style (point ctx line_a column) marked_style done else begin for column = column_a to size.cols - 1 do set_style (point ctx line_a column) marked_style done; for line = line_a + 1 to line_b - 1 do for column = 0 to size.cols - 1 do set_style (point ctx line column) marked_style done done; for column = 0 to column_b - 1 do set_style (point ctx line_b column) marked_style done end end end method! cursor_position = let line_set = Zed_edit.lines engine in let cursor_offset = Zed_cursor.get_position cursor in let cursor_line = Zed_lines.line_index line_set cursor_offset in let line_start= Zed_lines.line_start line_set cursor_line in let start_line = Zed_lines.line_index line_set start in let col= Zed_lines.force_width line_set line_start (cursor_offset - line_start) - shift_width in Some { row = cursor_line - start_line; col } end lambda-term-3.1.0/src/lTerm_edit.mli000066400000000000000000000060371366433625400173040ustar00rootroot00000000000000(* * lTerm_edit.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Text edition *) (** {6 Actions} *) type action = | Zed of Zed_edit.action (** A zed action. *) | Start_macro (** Start a new macro. *) | Stop_macro (** Ends the current macro. *) | Cancel_macro (** Cancel the current macro. *) | Play_macro (** Play the last recorded macro. *) | Insert_macro_counter (** Insert the current value of the macro counter. *) | Set_macro_counter (** Sets the value of the macro counter. *) | Add_macro_counter (** Adds a value to the macro counter. *) | Custom of (unit -> unit) val bindings : action list Zed_input.Make(LTerm_key).t ref (** Bindings. These bindings are used by {!LTerm_read_line} and by edition widgets. *) val bind : LTerm_key.t list -> action list -> unit (** [bind seq actions] associates [actions] to the given sequence. *) val unbind : LTerm_key.t list -> unit (** [unbind seq] unbinds [seq]. *) val actions : (action * string) list (** List of actions with their names, except {!Zed}. *) 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 variants name but lowercased and with '_' replaced by '-'. It raises [Not_found] if the name does not correspond to an action. It also recognizes zed actions. *) val name_of_action : action -> string (** [name_of_action act] returns the name of the given action. *) (** {6 Widgets} *) val clipboard : Zed_edit.clipboard (** The global clipboard. *) val macro : action Zed_macro.t (** The global macro recorder. *) (** Class of edition widgets. If no clipboard is provided, then the global one is used. *) class edit : ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> ?size : LTerm_geom.size -> unit -> object inherit LTerm_widget.t method engine : edit Zed_edit.t (** The edition engine used by this widget. *) method cursor : Zed_cursor.t (** The cursor used by this widget. *) method context : edit Zed_edit.context (** The context for editing the engine. *) method clipboard : Zed_edit.clipboard (** The clipboard used by the edition engine. *) method macro : action Zed_macro.t (** The macro recorder. *) method text : Zed_string.t (** Shorthand for [Zed_rope.to_string (Zed_edit.text edit#engine)]. *) method editable : int -> int -> bool (** The editable function of the engine. *) method match_word : Zed_rope.t -> int -> int option (** The match word function of the engine. *) method locale : string option (** The locale used by the engine. *) method set_locale : string option -> unit method bind : LTerm_key.t list -> action list -> unit method vscroll : LTerm_widget.scrollable end lambda-term-3.1.0/src/lTerm_editor.ml000066400000000000000000000002761366433625400174730ustar00rootroot00000000000000(* * lTerm_editor.ml * ------------ * Copyright : (c) 2020, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) type mode= | Default | Vi lambda-term-3.1.0/src/lTerm_editor.mli000066400000000000000000000003271366433625400176410ustar00rootroot00000000000000(* * lTerm_editor.mli * ------------ * Copyright : (c) 2020, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** The editor mode *) type mode= | Default | Vi lambda-term-3.1.0/src/lTerm_event.ml000066400000000000000000000011311366433625400173150ustar00rootroot00000000000000(* * lTerm_event.ml * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) type t = | Resize of LTerm_geom.size | Key of LTerm_key.t | Sequence of string | Mouse of LTerm_mouse.t let to_string = function | Resize size -> Printf.sprintf "Resize %s" (LTerm_geom.string_of_size size) | Key key -> Printf.sprintf "Key %s" (LTerm_key.to_string key) | Sequence seq -> Printf.sprintf "Sequence %S" seq | Mouse mouse -> Printf.sprintf "Mouse %s" (LTerm_mouse.to_string mouse) lambda-term-3.1.0/src/lTerm_event.mli000066400000000000000000000011521366433625400174710ustar00rootroot00000000000000(* * lTerm_event.mli * --------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Events *) (** Event from the terminal. *) type t = | Resize of LTerm_geom.size (** The terminal has been resized. *) | Key of LTerm_key.t (** A key has been pressed. *) | Sequence of string (** An uninterpreted escape sequence. *) | Mouse of LTerm_mouse.t (** A mouse button has been pressed. *) val to_string : t -> string (** [to_string event] returns the string representation of the given event. *) lambda-term-3.1.0/src/lTerm_geom.ml000066400000000000000000000024351366433625400171330ustar00rootroot00000000000000(* * lTerm_geom.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) type size = { rows : int; cols : int; } let rows size = size.rows let cols size = size.cols let string_of_size size = Printf.sprintf "{ rows = %d; cols = %d }" size.rows size.cols type coord = { row : int; col : int; } let row size = size.row let col size = size.col let string_of_coord coord = Printf.sprintf "{ row = %d; col = %d }" coord.row coord.col type rect = { row1 : int; col1 : int; row2 : int; col2 : int; } let row1 rect = rect.row1 let col1 rect = rect.col1 let row2 rect = rect.row2 let col2 rect = rect.col2 let size_of_rect rect = { rows = rect.row2 - rect.row1; cols = rect.col2 - rect.col1 } let string_of_rect rect = Printf.sprintf "{ row1 = %d; col1 = %d; row2 = %d; col2 = %d }" rect.row1 rect.col1 rect.row2 rect.col2 let in_rect rect coord = coord.col >= rect.col1 && coord.col < rect.col2 && coord.row >= rect.row1 && coord.row < rect.row2 type horz_alignment = | H_align_left | H_align_center | H_align_right type vert_alignment = | V_align_top | V_align_center | V_align_bottom type 'a directions = { left : 'a; right : 'a; up : 'a; down : 'a; } lambda-term-3.1.0/src/lTerm_geom.mli000066400000000000000000000025601366433625400173030ustar00rootroot00000000000000(* * lTerm_geom.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Common types. *) (** Type of sizes. *) type size = { rows : int; cols : int; } val rows : size -> int val cols : size -> int val string_of_size : size -> string (** Returns the string representation of the given size. *) (** Type of coordinates. *) type coord = { row : int; col : int; } val row : coord -> int val col : coord -> int val string_of_coord : coord -> string (** Returns the string representation of the given coordinates. *) (** Type of rectangles. *) type rect = { row1 : int; col1 : int; row2 : int; col2 : int; } val row1 : rect -> int val col1 : rect -> int val row2 : rect -> int val col2 : rect -> int val size_of_rect : rect -> size (** Returns the size of a rectangle. *) val string_of_rect : rect -> string (** Returns the string representation of the given rectangle. *) val in_rect : rect -> coord -> bool (** Test if coord is within rect *) (** Horizontal alignment. *) type horz_alignment = | H_align_left | H_align_center | H_align_right (** Vertical alignement. *) type vert_alignment = | V_align_top | V_align_center | V_align_bottom (** Movement directions. *) type 'a directions = { left : 'a; right : 'a; up : 'a; down : 'a; } lambda-term-3.1.0/src/lTerm_history.ml000066400000000000000000000420601366433625400177030ustar00rootroot00000000000000(* * lTerm_history.ml * ---------------- * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile let return, (>>=) = Lwt.return, Lwt.(>>=) (* A node contains an entry of the history. *) type node = { mutable data : Zed_string.t; mutable size : int; mutable prev : node; } type t = { mutable entries : node; (* Points to the first entry (the most recent). Its [prev] is a fake node used as marker, is after the oldest entry. *) mutable full_size : int; mutable length : int; mutable max_size : int; mutable max_entries : int; mutable old_count : int; mutable cache : Zed_string.t list option; (* When set, the cache is equal to the list of entries, from the most recent to the oldest. *) } let entry_size str = let zChar_newline= Zed_char.unsafe_of_char '\n' and zChar_slash= Zed_char.unsafe_of_char '\\' in let size = ref 0 in let eos= Zed_string.bytes str in let rec calc ofs= if ofs < eos then let ch, ofs= Zed_string.extract_next str ofs in if Zed_char.compare ch zChar_newline = 0 || Zed_char.compare ch zChar_slash = 0 then size := !size + 2 else size := !size + 1; calc ofs in calc 0; !size + 1 (* Check that [size1 + size2 < limit], handling overflow. *) let size_ok size1 size2 limit = let sum = size1 + size2 in sum >= 0 && sum <= limit let create ?(max_size=max_int) ?(max_entries=max_int) init = if max_size < 0 then invalid_arg "LTerm_history.create: negative maximum size"; if max_entries < 0 then invalid_arg "LTerm_history.create: negative maximum number of entries"; let rec aux size count node entries = match entries with | [] -> (size, count, node) | entry :: entries -> let entry_size = entry_size entry in if size_ok size entry_size max_size && count + 1 < max_entries then begin let next = { data = Zed_string.empty (); prev = node; size = 0 } in node.data <- entry; node.size <- entry_size; aux (size + entry_size) (count + 1) next entries end else (size, count, node) in let rec node = { data = Zed_string.empty (); size = 0; prev = node } in let size, count, marker = aux 0 0 node init in node.prev <- marker; { entries = node; full_size = size; length = count; max_size = max_size; max_entries = max_entries; old_count = count; cache = None; } let spaces = UCharInfo.load_property_tbl `White_Space let is_space_uChar ch = UCharTbl.Bool.get spaces ch let is_space ch = Zed_char.for_all is_space_uChar ch let is_empty str = Zed_string.for_all is_space str let is_dup history entry = history.length > 0 && history.entries.data = entry (* Remove the oldest entry of history, precondition: the history contains at least one entry. *) let drop_oldest history = let last = history.entries.prev.prev in (* Make [last] become the end of entries marker. *) history.entries.prev <- last; (* Update counters. *) history.length <- history.length - 1; history.full_size <- history.full_size - last.size; if history.old_count > 0 then history.old_count <- history.old_count - 1; (* Clear the marker so its contents can be garbage collected. *) last.data <- Zed_string.empty (); last.size <- 0 let add_aux history data size = if size <= history.max_size then begin (* Check length. *) if history.length = history.max_entries then begin history.cache <- None; (* We know that [max_entries > 0], so the precondition is verified. *) drop_oldest history end; (* Check size. *) if not (size_ok history.full_size size history.max_size) then begin history.cache <- None; (* We know that size <= max_size, so we are here only if there is at least one other entry in the history, so the precondition is verified. *) drop_oldest history; while not (size_ok history.full_size size history.max_size) do (* Same here. *) drop_oldest history done end; (* Add the entry. *) let node = { data = data; size = size; prev = history.entries.prev } in history.entries.prev <- node; history.entries <- node; history.length <- history.length + 1; history.full_size <- history.full_size + size; match history.cache with | None -> () | Some l -> history.cache <- Some (data :: l) end let add history ?(skip_empty=true) ?(skip_dup=true) entry = if history.max_entries > 0 && history.max_size > 0 && not (skip_empty && is_empty entry) && not (skip_dup && is_dup history entry) then add_aux history entry (entry_size entry) let rec list_of_nodes marker acc node = if node == marker then acc else list_of_nodes marker (node.data :: acc) node.prev let contents history = match history.cache with | Some l -> l | None -> let marker = history.entries.prev in let l = list_of_nodes marker [] marker.prev in history.cache <- Some l; l let size history = history.full_size let length history = history.length let old_count history = history.old_count let max_size history = history.max_size let max_entries history = history.max_entries let set_old_count history n = if n < 0 then invalid_arg "LTerm_history.set_old_count: negative old count"; if n > history.length then invalid_arg "LTerm_history.set_old_count: old count greater than the length of the history"; history.old_count <- n let set_max_size history size = if size < 0 then invalid_arg "LTerm_history.set_max_size: negative maximum size"; if size < history.full_size then begin history.cache <- None; (* 0 <= size < full_size so there is at least one element. *) drop_oldest history; while size < history.full_size do (* Same here. *) drop_oldest history done end; history.max_size <- size let set_max_entries history n = if n < 0 then invalid_arg "LTerm_history.set_max_entries: negative maximum number of entries"; if n < history.length then begin history.cache <- None; (* 0 <= n < length so there is at least one element. *) drop_oldest history; while n < history.length do (* Same here. *) drop_oldest history done end; history.max_entries <- n (*let escape_utf8 entry = let len = String.length entry in let buf = Buffer.create len in let rec loop ofs = if ofs = len then Buffer.contents buf else match String.unsafe_get entry ofs with | '\n' -> Buffer.add_string buf "\\n"; loop (ofs + 1) | '\\' -> Buffer.add_string buf "\\\\"; loop (ofs + 1) | ch when Char.code ch <= 127 -> Buffer.add_char buf ch; loop (ofs + 1) | _ -> let ofs' = Zed_utf8.unsafe_next entry ofs in Buffer.add_substring buf entry ofs (ofs' - ofs); loop ofs' in loop 0*) let escape entry = let len = Zed_string.bytes entry in let buf = Zed_string.Buf.create len in let zChar_n= Zed_char.unsafe_of_char 'n' in let zChar_slash= Zed_char.unsafe_of_char '\\' in let zChar_nl= Zed_char.unsafe_of_char '\n' in let rec loop ofs = if ofs = len then Zed_string.Buf.contents buf else let ch, ofs= Zed_string.extract_next entry ofs in if Zed_char.compare ch zChar_nl = 0 then begin Zed_string.Buf.add_zChar buf zChar_slash; Zed_string.Buf.add_zChar buf zChar_n; loop ofs; end else if Zed_char.compare ch zChar_slash = 0 then begin Zed_string.Buf.add_zChar buf zChar_slash; Zed_string.Buf.add_zChar buf zChar_slash; loop ofs; end else begin Zed_string.Buf.add_zChar buf ch; loop ofs; end in loop 0 (*let unescape_utf8 line = let len = String.length line in let buf = Buffer.create len in let rec loop ofs size = if ofs = len then (Buffer.contents buf, size + 1) else match String.unsafe_get line ofs with | '\\' -> if ofs = len then begin Buffer.add_char buf '\\'; (Buffer.contents buf, size + 3) end else begin match String.unsafe_get line (ofs + 1) with | 'n' -> Buffer.add_char buf '\n'; loop (ofs + 2) (size + 2) | '\\' -> Buffer.add_char buf '\\'; loop (ofs + 2) (size + 2) | _ -> Buffer.add_char buf '\\'; loop (ofs + 1) (size + 2) end | ch when Char.code ch <= 127 -> Buffer.add_char buf ch; loop (ofs + 1) (size + 1) | _ -> let ofs' = Zed_utf8.unsafe_next line ofs in Buffer.add_substring buf line ofs (ofs' - ofs); loop ofs' (size + ofs' - ofs) in loop 0 0*) let unescape line = let eos= Zed_string.bytes line in let buf= Zed_string.Buf.create 0 in let zChar_n= Zed_char.unsafe_of_char 'n' in let zChar_slash= Zed_char.unsafe_of_char '\\' in let zChar_nl= Zed_char.unsafe_of_char '\n' in let rec loop ofs size = if ofs >= eos then (Zed_string.Buf.contents buf, size + 1) else let ch, ofs= Zed_string.extract_next line ofs in if Zed_char.compare ch zChar_slash = 0 then if ofs >= eos then (Zed_string.Buf.add_zChar buf zChar_slash; (Zed_string.Buf.contents buf, size + 3);) else (let next, ofs_next= Zed_string.extract_next line ofs in if Zed_char.compare next zChar_n = 0 then (Zed_string.Buf.add_zChar buf zChar_nl; loop ofs_next (size + 2);) else if Zed_char.compare next zChar_slash = 0 then (Zed_string.Buf.add_zChar buf zChar_slash; loop ofs_next (size + 2);) else (Zed_string.Buf.add_zChar buf zChar_slash; loop ofs (size + 2);)) else (Zed_string.Buf.add_zChar buf ch; loop ofs (size + Zed_char.size ch);) in loop 0 0 let section = Lwt_log.Section.make "lambda-term(history)" let rec safe_lockf fn fd cmd ofs = Lwt.catch (fun () -> Lwt_unix.lockf fd cmd ofs >>= fun () -> return true) (function | Unix.Unix_error (Unix.EINTR, _, _) -> safe_lockf fn fd cmd ofs | Unix.Unix_error (error, _, _) -> Lwt_log.ign_warning_f ~section "failed to lock file '%s': %s" fn (Unix.error_message error); return false | exn -> Lwt.fail exn) let open_history fn = Lwt.catch (fun () -> Lwt_unix.openfile fn [Unix.O_RDWR] 0 >>= fun fd -> safe_lockf fn fd Lwt_unix.F_LOCK 0 >>= fun locked -> return (Some (fd, locked))) (function | Unix.Unix_error (Unix.ENOENT, _, _) -> return None | Unix.Unix_error (Unix.EACCES, _, _) -> Lwt_log.ign_info_f "cannot open file '%s' in read and write mode: %s" fn (Unix.error_message Unix.EACCES); (* If the file cannot be openned in read & write mode, open it in read only mode but do not lock it. *) Lwt.catch (fun () -> Lwt_unix.openfile fn [Unix.O_RDONLY] 0 >>= fun fd -> return (Some (fd, false))) (function | Unix.Unix_error (Unix.ENOENT, _, _) -> return None | exn -> Lwt.fail exn) | exn -> Lwt.fail exn) let load history ?log ?(skip_empty=true) ?(skip_dup=true) fn = (* In case we do not load anything. *) history.old_count <- history.length; if history.max_entries = 0 || history.max_size = 0 then (* Do not bother loading the file for nothing... *) return () else begin let log = match log with | Some func -> func | None -> fun line msg -> Lwt_log.ign_error_f ~section "File %S, at line %d: %s" fn line msg in (* File opening. *) open_history fn >>= fun history_file -> match history_file with | None -> return () | Some (fd, locked) -> (* File loading. *) let ic = Lwt_io.of_fd ~mode:Lwt_io.input fd in Lwt.finalize (fun () -> let rec aux num = Lwt_io.read_line_opt ic >>= fun line -> match line with | None -> return () | Some line -> (try let line= Zed_string.of_utf8 line in let entry, size = unescape line in if not (skip_empty && is_empty entry) && not (skip_dup && is_dup history entry) then begin add_aux history entry size; history.old_count <- history.length end with | Zed_string.Invalid (msg, _)-> log num msg | Zed_utf8.Invalid (msg, _)-> log num msg ); aux (num + 1) in aux 1) (fun () -> (* Cleanup. *) (if locked then safe_lockf fn fd Lwt_unix.F_ULOCK 0 else return true) >>= fun _ -> Lwt_unix.close fd) end let rec skip_nodes node count = if count = 0 then node else skip_nodes node.prev (count - 1) let rec copy history marker node skip_empty skip_dup = if node != marker then begin let line = escape node.data in if not (skip_empty && is_empty line) && not (skip_dup && is_dup history line) then add_aux history line node.size; copy history marker node.prev skip_empty skip_dup end let rec dump_entries oc marker node = if node == marker then return () else begin Lwt_io.write_line oc (Zed_string.to_utf8 node.data) >>= fun () -> dump_entries oc marker node.prev end let save history ?max_size ?max_entries ?(skip_empty=true) ?(skip_dup=true) ?(append=true) ?(perm=0o666) fn = let max_size = match max_size with | Some m -> m | None -> history.max_size and max_entries = match max_entries with | Some m -> m | None -> history.max_entries in let history_save = create ~max_size ~max_entries [] in if history_save.max_size = 0 || history_save.max_entries = 0 || (not append && history.old_count = history.length) then (* Just empty the history. *) Lwt_unix.openfile fn [Unix.O_CREAT; Unix.O_TRUNC] perm >>= Lwt_unix.close else if append && history.old_count = history.length then (* Do not touch the file. *) return () else begin Lwt_unix.openfile fn [Unix.O_CREAT; Unix.O_RDWR] perm >>= fun fd -> (* Lock the entire file. *) safe_lockf fn fd Unix.F_LOCK 0 >>= fun locked -> Lwt.finalize (fun () -> begin if append then begin (* Load existing entries into [history_save]. We return the number of entries read. This may be greater than the number of entries stored in [history_save]: - because of limits - because the history files contains duplicated lines and/or empty lines and [skip_dup] and/or [skip_empty] have been specified. *) let ic = Lwt_io.of_fd ~mode:Lwt_io.input ~close:return fd in let rec aux count = Lwt_io.read_line_opt ic >>= fun line -> match line with | None -> history_save.old_count <- history_save.length; Lwt_io.close ic >>= fun () -> return count | Some line -> let line= Zed_string.unsafe_of_utf8 line in (* Do not bother unescaping. Tests remain the same on the unescaped version. *) if not (skip_empty && is_empty line) && not (skip_dup && is_dup history_save line) then add_aux history_save line (Zed_string.bytes line + 1); aux (count + 1) in aux 0 end else return 0 end >>= fun count -> let marker = history.entries.prev in (* Copy new entries into the saving history. *) copy history_save marker (skip_nodes marker.prev history.old_count) skip_empty skip_dup; begin if append && history_save.old_count = count then (* We are in append mode and no old entries were removed: do not modify the file and append new entries at the end of the file. *) return count else (* Otherwise truncate the file and save everything. *) Lwt_unix.lseek fd 0 Unix.SEEK_SET >>= fun _ -> Lwt_unix.ftruncate fd 0 >>= fun () -> return 0 end >>= fun to_skip -> (* Save entries to the temporary file. *) let oc = Lwt_io.of_fd ~mode:Lwt_io.output ~close:return fd in let marker = history_save.entries.prev in dump_entries oc marker (skip_nodes marker.prev to_skip) >>= fun () -> Lwt_io.close oc >>= fun () -> (* Done! *) history.old_count <- history.length; return ()) (fun () -> (if locked then safe_lockf fn fd Lwt_unix.F_ULOCK 0 else return true) >>= fun _ -> Lwt_unix.close fd) end lambda-term-3.1.0/src/lTerm_history.mli000066400000000000000000000104301366433625400200500ustar00rootroot00000000000000(* * lTerm_history.mli * ----------------- * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** History management *) type t (** Type of a history. *) val create : ?max_size : int -> ?max_entries : int -> Zed_string.t list -> t (** [create ?max_size ?max_lines init] creates a new history. [max_size] is the maximum size in bytes of the history. Oldest entries are dropped if this limit is reached. The default is [max_int]. [max_entries] is the maximum number of entries of the history. Oldest entries are dropped if this limit is reached. The default is no [max_int]. [init] is the initial contents of the history. All entries of [init] are considered "old". Old entries are not saved by {!save} when [append] is set to [true]. Note: the first element of [init] must be the most recent entry. *) val add : t -> ?skip_empty : bool -> ?skip_dup : bool -> Zed_string.t -> unit (** [add history ?skip_empty ?skip_dup entry] adds [entry] to the top of the history. If [skip_empty] is [true] (the default) and [entry] contains only spaces, it is not added. If [skip_dup] is [true] (the default) and [entry] is equal to the top of the history, it is not added. If [entry] is bigger than the maximum size of the history, the history is not modified. *) val contents : t -> Zed_string.t list (** Returns all the entries of the history. The first element of the list is the most recent entry. *) val size : t -> int (** Returns the size (in bytes) of the history. *) val length : t -> int (** Returns the number of entries in the history. *) val old_count : t -> int (** Returns the number of old entries in the history. *) val set_old_count : t -> int -> unit (** [set_old_count history count] sets the number of old entries in the history. *) val max_size : t -> int (** Returns the maximum size of the history. *) val set_max_size : t -> int -> unit (** Sets the maximum size of the history. It may drop oldest entries to honor the new limit. *) val max_entries : t -> int (** Returns the maximum number of entries of the history. *) val set_max_entries : t -> int -> unit (** Sets the maximum number of entries of the history. It may drop oldest entries to honor the new limit. *) val load : t -> ?log : (int -> string -> unit) -> ?skip_empty : bool -> ?skip_dup : bool -> string -> unit Lwt.t (** [load history ?log ?skip_empty ?skip_dup filename] loads entries from [filename] to [history]. If [filename] does not exists [history] is not modified. [log] is the function used to log errors contained in the history file (errors are because of non-UTF8 data). Arguments are a line number and an error message. The default is to use the default logger (of [Lwt_log]). Entries containing errors are skipped. Note: all entries are marked as old, i.e. [old_count history = length history]. *) val save : t -> ?max_size : int -> ?max_entries : int -> ?skip_empty : bool -> ?skip_dup : bool -> ?append : bool -> ?perm : int -> string -> unit Lwt.t (** [save history ?max_size ?max_entries ?skip_empty ?sjip_dup ?perm filename] saves [history] to [filename]. If [append] is [false] then the file is truncated and new entries are saved. If it is [true] (the default) then new entries are added at the end. [perm] are the file permissions in case it is created. If [append] is [true] and there is no new entries, the file is not touched. In any other case, limits are honored and the resulting file will never contains more bytes than [max_size] or more entries than [max_entries]. If [max_size] and/or [max_entries] are not specified, the ones of [history] are used. After the history is successfully saved, all entries of [history] are marked as old, i.e. [old_count history = length history]. *) val entry_size : Zed_string.t -> int (** [entry_size entry] returns the size taken by an entry in the history file in bytes. This is not exactly [String.length entry] since some characters are escaped and the entry is terminated by a newline character. *) lambda-term-3.1.0/src/lTerm_inputrc.mli000066400000000000000000000013071366433625400200360ustar00rootroot00000000000000(* * lTerm_inputrc.mli * ----------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Loading of key bindings *) exception Parse_error of string * int * string (** [Parse_error(source, line, message)] is raised when the inputrc file contains errors. *) val load : ?file : string -> unit -> unit Lwt.t (** [load ?file ()] loads key bindings from [file], which defaults to ~/.config/.lambda-term-inputrc, if it exists. *) val default : string (** The name of the default key bindings file, i.e. ~/.config/.lambda-term-inputrc or the legacy location ~/.lambda-term-inputrc, if it exists *) lambda-term-3.1.0/src/lTerm_inputrc.mll000066400000000000000000000251501366433625400200430ustar00rootroot00000000000000(* * lTerm_inputrc.mll * ----------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) { open CamomileLibraryDefault.Camomile open LTerm_key let return, (>>=) = Lwt.return, Lwt.(>>=) exception Parse_error of string * int * string let parse_error src line fmt = Printf.ksprintf (fun msg -> raise (Parse_error (src, line, msg))) fmt let handle_edit_action src line seq actions = if actions = [] then LTerm_edit.unbind seq else let actions = List.map (fun str -> try LTerm_edit.action_of_name str with Not_found -> parse_error src line "invalid edit action %S" str) actions in LTerm_edit.bind seq actions let handle_read_line_action src line seq actions = if actions = [] then LTerm_read_line.unbind seq else let actions = List.map (fun str -> try LTerm_read_line.action_of_name str with Not_found -> parse_error src line "invalid read-line action %S" str) actions in LTerm_read_line.bind seq actions type line = | Comment | Section of string | Binding of LTerm_key.t list * string list | Error of string let dummy_key = { control = false; meta = false; shift = false; code = Escape } } let blank = [' ' '\t'] rule line = parse | blank* eof { Comment } | blank* '#' [^'\n']* eof { Comment } | blank* '[' blank* ([^'\n' ' ' '\t' ']']* as section) blank* ']' blank* ('#' [^'\n']*)? eof { Section section } | blank* { sequence dummy_key [] lexbuf } and sequence key seq = parse | "C-" { sequence { key with control = true } seq lexbuf } | "M-" { sequence { key with meta = true } seq lexbuf } | "S-" { sequence { key with shift = true } seq lexbuf } | "enter" (blank+ | ':' as sep) { let seq = { key with code = Enter } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "escape" (blank+ | ':' as sep) { let seq = { key with code = Escape } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "tab" (blank+ | ':' as sep) { let seq = { key with code = Tab } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "up" (blank+ | ':' as sep) { let seq = { key with code = Up } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "down" (blank+ | ':' as sep) { let seq = { key with code = Down } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "left" (blank+ | ':' as sep) { let seq = { key with code = Left } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "right" (blank+ | ':' as sep) { let seq = { key with code = Right } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f1" (blank+ | ':' as sep) { let seq = { key with code = F1 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f2" (blank+ | ':' as sep) { let seq = { key with code = F2 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f3" (blank+ | ':' as sep) { let seq = { key with code = F3 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f4" (blank+ | ':' as sep) { let seq = { key with code = F4 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f5" (blank+ | ':' as sep) { let seq = { key with code = F5 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f6" (blank+ | ':' as sep) { let seq = { key with code = F6 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f7" (blank+ | ':' as sep) { let seq = { key with code = F7 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f8" (blank+ | ':' as sep) { let seq = { key with code = F8 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f9" (blank+ | ':' as sep) { let seq = { key with code = F9 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f10" (blank+ | ':' as sep) { let seq = { key with code = F10 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f11" (blank+ | ':' as sep) { let seq = { key with code = F11 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "f12" (blank+ | ':' as sep) { let seq = { key with code = F12 } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "next" (blank+ | ':' as sep) { let seq = { key with code = Next_page } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "prev" (blank+ | ':' as sep) { let seq = { key with code = Prev_page } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "home" (blank+ | ':' as sep) { let seq = { key with code = Home } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "end" (blank+ | ':' as sep) { let seq = { key with code = End } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "insert" (blank+ | ':' as sep) { let seq = { key with code = Insert } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "delete" (blank+ | ':' as sep) { let seq = { key with code = Delete } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "backspace" (blank+ | ':' as sep) { let seq = { key with code = Backspace } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | [ 'a'-'z' 'A'-'Z' '0'-'9' '_' '(' ')' '[' ']' '{' '}' '~' '&' '$' '*' '%' '!' '?' ',' ';' '/' '\\' '.' '@' '=' '+' '-' '^' ] as ch (blank+ | ':' as sep) { let seq = { key with code = Char(UChar.of_char ch) } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf } | "U+" (['a'-'f' 'A'-'F' '0'-'9']+ as hexa) (blank+ | ':' as sep) { let code = ref 0 in for i = 0 to String.length hexa - 1 do let ch = hexa.[i] in code := !code * 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 | _ -> assert false) done; match try Some (UChar.of_int !code) with _ -> None with | Some ch -> let seq = { key with code = Char ch } :: seq in if sep = ":" then actions (List.rev seq) [] lexbuf else sequence dummy_key seq lexbuf | None -> Error (Printf.sprintf "invalid unicode character U+%s" hexa) } | "" { Error "parsing error in key sequence" } and actions seq l = parse | blank* ('#' [^'\n']*)? eof { Binding (seq, List.rev l) } | blank* (['a'-'z' 'A'-'Z' '-']+ ('(' [^')' '\n']* ')')? as action) { comma_actions seq (action :: l) lexbuf } | "" { Error "parsing error in actions" } and comma_actions seq l = parse | blank* ',' { actions seq l lexbuf } | blank* ('#' [^'\n']*)? eof { Binding (seq, List.rev l) } | "" { Error "parsing error in actions" } { let default = LTerm_resources.xdgbd_file ~loc:LTerm_resources.Config ~allow_legacy_location:true ".lambda-term-inputrc" let load ?(file = default) () = Lwt.catch (fun () -> Lwt_io.open_file ~mode:Lwt_io.input file >>= fun ic -> let rec loop num handler = Lwt_io.read_line_opt ic >>= fun input_line -> match input_line with | None -> return () | Some str -> match line (Lexing.from_string str) with | Comment -> loop (num + 1) handler | Section "edit" -> loop (num + 1) handle_edit_action | Section "read-line" -> loop (num + 1) handle_read_line_action | Section section -> parse_error file num "invalid section %S" section | Binding (seq, actions) -> handler file num seq actions; loop (num + 1) handler | Error msg -> raise (Parse_error (file, num, msg)) in Lwt.finalize (fun () -> loop 1 handle_edit_action) (fun () -> Lwt_io.close ic)) (function | Unix.Unix_error(Unix.ENOENT, _, _) -> return () | exn -> Lwt.fail exn) } lambda-term-3.1.0/src/lTerm_key.ml000066400000000000000000000053051366433625400167730ustar00rootroot00000000000000(* * lTerm_key.ml * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* little hack to maintain 4.02.3 compat with warnings *) module String = struct [@@@ocaml.warning "-3-32"] let lowercase_ascii = StringLabels.lowercase include String end open CamomileLibraryDefault.Camomile type code = | Char of UChar.t | Enter | Escape | Tab | Up | Down | Left | Right | F1 | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12 | Next_page | Prev_page | Home | End | Insert | Delete | Backspace type t = { control : bool; meta : bool; shift : bool; code : code; } let compare = compare let control key = key.control let meta key = key.meta let code key = key.code let string_of_code = function | Char ch -> Printf.sprintf "Char 0x%02x" (UChar.code ch) | Enter -> "Enter" | Escape -> "Escape" | Tab -> "Tab" | Up -> "Up" | Down -> "Down" | Left -> "Left" | Right -> "Right" | F1 -> "F1" | F2 -> "F2" | F3 -> "F3" | F4 -> "F4" | F5 -> "F5" | F6 -> "F6" | F7 -> "F7" | F8 -> "F8" | F9 -> "F9" | F10 -> "F10" | F11 -> "F11" | F12 -> "F12" | Next_page -> "Next_page" | Prev_page -> "Prev_page" | Home -> "Home" | End -> "End" | Insert -> "Insert" | Delete -> "Delete" | Backspace -> "Backspace" let to_string key = Printf.sprintf "{ control = %B; meta = %B; shift = %B; code = %s }" key.control key.meta key.shift (string_of_code key.code) let to_string_compact key = let buffer = Buffer.create 32 in if key.control then Buffer.add_string buffer "C-"; if key.meta then Buffer.add_string buffer "M-"; if key.shift then Buffer.add_string buffer "S-"; (match key.code with | Char ch -> let code = UChar.code ch in if code <= 255 then match Char.chr code with | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '(' | ')' | '[' | ']' | '{' | '}' | '#' | '~' | '&' | '$' | '*' | '%' | '!' | '?' | ',' | ';' | ':' | '/' | '\\' | '.' | '@' | '=' | '+' | '-' as ch -> Buffer.add_char buffer ch | ' ' -> Buffer.add_string buffer "space" | _ -> Printf.bprintf buffer "U+%02x" code else if code <= 0xffff then Printf.bprintf buffer "U+%04x" code else Printf.bprintf buffer "U+%06x" code | Next_page -> Buffer.add_string buffer "next" | Prev_page -> Buffer.add_string buffer "prev" | code -> Buffer.add_string buffer (String.lowercase_ascii (string_of_code code))); Buffer.contents buffer lambda-term-3.1.0/src/lTerm_key.mli000066400000000000000000000021141366433625400171370ustar00rootroot00000000000000(* * lTerm_key.mli * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Keys *) open CamomileLibrary (** Type of key code. *) type code = | Char of UChar.t (** A unicode character. *) | Enter | Escape | Tab | Up | Down | Left | Right | F1 | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12 | Next_page | Prev_page | Home | End | Insert | Delete | Backspace (** Type of key. *) type t = { control : bool; (** Is the control key down ? *) meta : bool; (** Is the meta key down ? *) shift : bool; (** Is the shift key down ? *) code : code; (** The code of the key. *) } val compare : t -> t -> int (** Same as [Pervasives.compare]. *) val control : t -> bool val meta : t -> bool val code : t -> code val to_string : t -> string (** Returns the string representation of the given key. *) val to_string_compact : t -> string (** Returns the string representation of the given key in the form "C-M-a". *) lambda-term-3.1.0/src/lTerm_mouse.ml000066400000000000000000000017771366433625400173440ustar00rootroot00000000000000(* * lTerm_mouse.ml * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) type button = | Button1 | Button2 | Button3 | Button4 | Button5 | Button6 | Button7 | Button8 | Button9 type t = { control : bool; meta : bool; shift : bool; button : button; row : int; col : int; } let compare = compare let control m = m.control let meta m = m.meta let button m = m.button let row m = m.row let col m = m.col let coord m = { LTerm_geom.row = row m; col = col m } let string_of_button = function | Button1 -> "Button1" | Button2 -> "Button2" | Button3 -> "Button3" | Button4 -> "Button4" | Button5 -> "Button5" | Button6 -> "Button6" | Button7 -> "Button7" | Button8 -> "Button8" | Button9 -> "Button9" let to_string m = Printf.sprintf "{ control = %B; meta = %B; shift = %B; button = %s; row = %d; col = %d }" m.control m.meta m.shift (string_of_button m.button) m.row m.col lambda-term-3.1.0/src/lTerm_mouse.mli000066400000000000000000000021111366433625400174740ustar00rootroot00000000000000(* * lTerm_mouse.mli * --------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Mouse events *) (** Type of mouse button. *) type button = | Button1 | Button2 | Button3 | Button4 | Button5 | Button6 | Button7 | Button8 | Button9 (** Type of mouse click event. *) type t = { control : bool; (** Is the control key down ? *) meta : bool; (** Is the meta key down ? *) shift : bool; (** Is the shift key down ? *) button : button; (** Which button have been pressed ? *) row : int; (** The row at which the mouse was when the button has been pressed. *) col : int; (** The column at which the mouse was when the button has been pressed. *) } val compare : t -> t -> int (** Same as [Pervasives.compare]. *) val control : t -> bool val meta : t -> bool val button : t -> button val row : t -> int val col : t -> int val coord : t -> LTerm_geom.coord val to_string : t -> string (** Returns the string representation of the given mouse event. *) lambda-term-3.1.0/src/lTerm_read_line.ml000066400000000000000000001414021366433625400201240ustar00rootroot00000000000000(* * lTerm_read_line.ml * ------------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile open Lwt_react open LTerm_geom open LTerm_style open LTerm_key let return, (>>=) = Lwt.return, Lwt.(>>=) type prompt = LTerm_text.t type history = Zed_string.t list (* +-----------------------------------------------------------------+ | Completion | +-----------------------------------------------------------------+ *) let common_prefix_one a b = let rec loop ofs = if ofs = String.length a || ofs = String.length b then String.sub a 0 ofs else let ch1, ofs1 = Zed_utf8.unsafe_extract_next a ofs and ch2, ofs2 = Zed_utf8.unsafe_extract_next b ofs in if ch1 = ch2 && ofs1 = ofs2 then loop ofs1 else String.sub a 0 ofs in loop 0 let common_prefix = function | [] -> "" | word :: rest -> List.fold_left common_prefix_one word rest let zed_common_prefix_one a b = let rec loop ofs = if ofs = Zed_string.bytes a || ofs = Zed_string.bytes b then Zed_string.sub_ofs ~ofs:0 ~len:ofs a else let ch1, ofs1= Zed_string.extract_next a ofs and ch2, ofs2= Zed_string.extract_next b ofs in if ch1 = ch2 && ofs1 = ofs2 then loop ofs1 else Zed_string.sub_ofs ~ofs:0 ~len:ofs a in loop 0 let zed_common_prefix = function | [] -> Zed_string.empty () | word :: rest -> List.fold_left zed_common_prefix_one word rest let lookup word words = List.filter (fun word' -> Zed_utf8.starts_with word' word) words let lookup_assoc word words = List.filter (fun (word', _) -> Zed_utf8.starts_with word' word) words include LTerm_read_line_base module Bindings = Zed_input.Make (LTerm_key) let bindings = ref Bindings.empty let bind seq actions = bindings := Bindings.add seq actions !bindings let unbind seq = bindings := Bindings.remove seq !bindings let () = bind [{ control = false; meta = false; shift = false; code = Home }] [Edit (LTerm_edit.Zed Zed_edit.Goto_bot)]; bind [{ control = false; meta = false; shift = false; code = End }] [Edit (LTerm_edit.Zed Zed_edit.Goto_eot)]; bind [{ control = false; meta = false; shift = false; code = Up }] [History_prev]; bind [{ control = false; meta = false; shift = false; code = Down }] [History_next]; bind [{ control = false; meta = false; shift = false; code = Tab }] [Complete]; bind [{ control = false; meta = false; shift = false; code = Enter }] [Accept]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'b') }] [Edit (LTerm_edit.Zed Zed_edit.Prev_char)]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'f') }] [Edit (LTerm_edit.Zed Zed_edit.Next_char)]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'h') }] [Edit (LTerm_edit.Zed Zed_edit.Delete_prev_char)]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'c') }] [Break]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'z') }] [Suspend]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'm') }] [Accept]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'l') }] [Clear_screen]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'r') }] [Prev_search]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 's') }] [Next_search]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'd') }] [Interrupt_or_delete_next_char]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'p') }] [History_prev]; bind [{ control = false; meta = true; shift = false; code = Char(UChar.of_char 'n') }] [History_next]; bind [{ control = false; meta = true; shift = false; code = Left }] [Complete_bar_prev]; bind [{ control = false; meta = true; shift = false; code = Right }] [Complete_bar_next]; bind [{ control = false; meta = true; shift = false; code = Home }] [Complete_bar_first]; bind [{ control = false; meta = true; shift = false; code = End }] [Complete_bar_last]; bind [{ control = false; meta = true; shift = false; code = Tab }] [Complete_bar]; bind [{ control = false; meta = true; shift = false; code = Down }] [Complete_bar]; bind [{ control = false; meta = true; shift = false; code = Enter }] [Edit (LTerm_edit.Zed Zed_edit.Newline)]; bind [{ control = false; meta = false; shift = false; code = Escape }] [Cancel_search]; bind [{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'x') } ;{ control = true; meta = false; shift = false; code = Char(UChar.of_char 'e') }] [Edit_with_external_editor] (* +-----------------------------------------------------------------+ | The read-line engine | +-----------------------------------------------------------------+ *) let is_prefix ~prefix s= let prefix= Zed_string.to_utf8 prefix and s= Zed_string.to_utf8 s in String.length prefix <= String.length s && (let i = ref 0 in while !i < String.length prefix && s.[!i] = prefix.[!i] do incr i done; !i = String.length prefix ) let history_find predicate history = let rec history_find_ skipped = function | [] -> None | x :: xs -> if predicate x then Some (skipped, x, xs) else history_find_ (x :: skipped) xs in history_find_ [] history let search_string str sub = let str= Zed_string.to_utf8 str and sub= Zed_string.to_utf8 sub in let rec equal_at a b = (b = String.length sub) || (String.unsafe_get str a = String.unsafe_get sub b) && equal_at (a + 1) (b + 1) in let rec loop ofs idx = if ofs + String.length sub > String.length str then None else if equal_at ofs 0 then Some idx else loop (Zed_utf8.unsafe_next str ofs) (idx + 1) in loop 0 0 let macro = Zed_macro.create [] type mode = | Edition | Search | Set_counter | Add_counter type completion_state = { start : int; (* Beginning of the word being completed *) index : int; (* Index of the selected in [words] *) count : int; (* Length of [words] *) words : (Zed_string.t * Zed_string.t) list; } let no_completion = { start = 0; index = 0; words = []; count = 0; } type direction = Forward | Backward type search_status = { before : Zed_string.t list ; after : Zed_string.t list ; match_ : (Zed_string.t * int) option } class virtual ['a] engine ?(history = []) ?(clipboard = LTerm_edit.clipboard) ?(macro = macro) () = let edit : unit Zed_edit.t = Zed_edit.create ~clipboard () in let context = Zed_edit.context edit (Zed_edit.new_cursor edit) in let mode, set_mode = S.create Edition in let user_completion_state, set_completion_state = E.create () in let reset_completion_state = E.when_ (S.map (fun mode -> mode = Edition) mode) (E.select [ E.stamp (Zed_edit.changes edit ) no_completion; E.stamp (S.changes (Zed_cursor.position (Zed_edit.cursor context))) no_completion; ]) in let completion_state = S.hold ~eq:(==) no_completion (E.select [reset_completion_state; user_completion_state]) in let completion_words = S.map ~eq:(==) (fun c -> c.words) completion_state in let completion_index = S.map (fun c -> c.index) completion_state in let history, set_history = S.create (history, []) in let message, set_message = S.create None in let history_prefix, set_history_prefix = let ev, send = E.create () in let edit_changes = Zed_edit.changes edit in let edit_changes = E.map (fun _ -> Zed_edit.text edit) edit_changes in let prefix = S.hold (Zed_rope.empty ()) (E.select [ev; edit_changes]) in prefix, send in object(self) method virtual eval : 'a method edit = edit method context = context method show_box = true method mode = mode method history = history method message = message method clipboard = clipboard method macro = macro val interrupt: exn Lwt_mvar.t= Lwt_mvar.create_empty () method interrupt= interrupt (* The event which occurs when completion need to be recomputed. *) val mutable completion_event = E.never (* Save for when setting the macro counter. *) val mutable save = (0, Zed_rope.empty ()) method set_completion ?(index=0) start words = let count = List.length words in if index < 0 || index > max 0 (count - 1) then invalid_arg "LTerm_read_line.set_completion: \ index out of bounds compared to words."; set_completion_state { start; index; count; words } initializer completion_event <- ( E.map (fun _ -> (* We can't execute it right now as the user might call [set_completion] immediatly. *) Lwt.pause () >>= fun () -> self#completion; Lwt.return_unit) reset_completion_state ); self#completion method input_prev = Zed_rope.before (Zed_edit.text edit) (Zed_edit.position context) method input_next = Zed_rope.after (Zed_edit.text edit) (Zed_edit.position context) method completion_words = completion_words method completion_index = completion_index method completion = self#set_completion 0 [] method complete = let comp = S.value completion_state in let prefix_length = Zed_edit.position context - comp.start in match comp.words with | [] -> () | [(completion, suffix)] -> Zed_edit.insert context (Zed_rope.of_string (Zed_string.sub completion ~pos:prefix_length ~len:(Zed_string.length completion - prefix_length))); Zed_edit.insert context (Zed_rope.of_string suffix) | (completion, _suffix) :: rest -> let word = List.fold_left (fun acc (word, _) -> zed_common_prefix_one acc word) completion rest in Zed_edit.insert context (Zed_rope.of_string (Zed_string.sub word ~pos:prefix_length ~len:(Zed_string.length word - prefix_length))) (* The event which search for the string in the history. *) val mutable search_event = E.never val mutable search_status = None initializer let reset_search _ = search_status <- None; self#search Backward in search_event <- E.map reset_search (E.when_ (S.map (fun mode -> mode = Search) mode) (Zed_edit.changes edit)) method private search direction = let do_search direction = let set_status other_entries entries match_ = let before, after = match direction with | Backward -> (other_entries, entries) | Forward -> (entries, other_entries) in search_status <- Some { before; after; match_ } in let input = Zed_rope.to_string (Zed_edit.text edit) in let rec loop other_entries entries = match entries with | [] -> set_status other_entries entries None; set_message (Some(LTerm_text.of_utf8 "Reverse search: not found")) | entry :: rest -> match search_string entry input with | Some pos -> begin match search_status with | Some { match_ = Some (entry', _); _ } when entry = entry' -> loop (entry :: other_entries) rest | _ -> set_status other_entries rest (Some (entry, pos)); let txt = LTerm_text.of_string entry in for i = pos to pos + Zed_rope.length (Zed_edit.text edit) - 1 do let ch, style = txt.(i) in txt.(i) <- (ch, { style with underline = Some true }) done; set_message (Some (Array.append (LTerm_text.of_utf8 "Reverse search: ") txt)) end | None -> loop (entry :: other_entries) rest in match search_status with | None -> let hist = fst (S.value history) in loop [] (match direction with | Backward -> hist | Forward -> List.rev hist) | Some { before; after; match_ } -> let other_entries, entries = match direction with | Backward -> (before, after) | Forward -> (after, before) in let other_entries = match match_ with | None -> other_entries | Some (entry, _) -> entry :: other_entries in loop other_entries entries in match S.value mode with | Search -> do_search direction | Edition -> let text = Zed_edit.text edit in Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length text); let prev, next = S.value history in set_history (Zed_rope.to_string text :: (List.rev_append next prev), []); search_status <- None; set_mode Search; do_search direction | _ -> () method insert ch = Zed_edit.insert_char context ch method send_action action = if action <> Edit LTerm_edit.Stop_macro then Zed_macro.add macro action; match action with | (Complete | Complete_bar | Accept) when S.value mode = Search -> begin set_mode Edition; set_message None; match search_status with | Some { match_ = Some (entry, _pos); _ } -> search_status <- None; Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length (Zed_edit.text edit)); Zed_edit.insert context (Zed_rope.of_string entry) | Some { match_ = None; _ } | None -> () end | Edit (LTerm_edit.Zed action) -> Zed_edit.get_action action context | Interrupt_or_delete_next_char -> if Zed_rope.is_empty (Zed_edit.text edit) then Lwt.async (fun ()-> Lwt_mvar.put interrupt Interrupt) else Zed_edit.delete_next_char context | Complete when S.value mode = Edition -> self#complete | Complete_bar_next when S.value mode = Edition -> let comp = S.value completion_state in if comp.index < comp.count - 1 then set_completion_state { comp with index = comp.index + 1 } | Complete_bar_prev when S.value mode = Edition -> let comp = S.value completion_state in if comp.index > 0 then set_completion_state { comp with index = comp.index - 1 } | Complete_bar_first when S.value mode = Edition -> let comp = S.value completion_state in if comp.index > 0 then set_completion_state { comp with index = 0 } | Complete_bar_last when S.value mode = Edition -> let comp = S.value completion_state in if comp.index < comp.count - 1 then set_completion_state { comp with index = comp.count - 1 } | Complete_bar when S.value mode = Edition -> let comp = S.value completion_state in if comp.words <> [] then begin let prefix_length = Zed_edit.position context - comp.start in let completion, suffix = List.nth comp.words comp.index in Zed_edit.insert context (Zed_rope.of_string (Zed_string.after completion prefix_length)); Zed_edit.insert context (Zed_rope.of_string suffix) end | History_prev when S.value mode = Edition ->begin let prev, next = S.value history in match prev with | [] -> () | line :: rest -> let text = Zed_edit.text edit in set_history (rest, Zed_rope.to_string text :: next); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length text); Zed_edit.insert context (Zed_rope.of_string line) end | History_next when S.value mode = Edition -> begin let prev, next = S.value history in match next with | [] -> () | line :: rest -> let text = Zed_edit.text edit in set_history (Zed_rope.to_string text :: prev, rest); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length text); Zed_edit.insert context (Zed_rope.of_string line) end | History_search_prev when S.value mode = Edition -> begin let prev, next = S.value history in let text = Zed_rope.to_string @@ Zed_edit.text edit in let prefix = S.value history_prefix in match history_find (is_prefix ~prefix:(Zed_rope.to_string prefix)) prev with | None -> () | Some (not_matched, line, rest) -> set_history (rest, not_matched @ text :: next); Zed_edit.goto context 0; Zed_edit.delete_next_line context; Zed_edit.insert context (Zed_rope.of_string line); set_history_prefix prefix end | History_search_next when S.value mode = Edition -> begin let prev, next = S.value history in let prefix = S.value history_prefix in match history_find (is_prefix ~prefix:(Zed_rope.to_string prefix)) next with | None -> () | Some (not_matched, line, rest) -> let text = Zed_rope.to_string @@ Zed_edit.text edit in set_history (not_matched @ text :: prev, rest); Zed_edit.goto context 0; Zed_edit.delete_next_line context; Zed_edit.insert context (Zed_rope.of_string line); set_history_prefix prefix end | Prev_search -> self#search Backward | Next_search -> self#search Forward | Cancel_search -> if S.value mode = Search then begin set_mode Edition; set_message None end | Edit LTerm_edit.Start_macro when S.value mode = Edition -> Zed_macro.set_recording macro true | Edit LTerm_edit.Stop_macro -> Zed_macro.set_recording macro false | Edit LTerm_edit.Cancel_macro -> Zed_macro.cancel macro | Edit LTerm_edit.Play_macro -> Zed_macro.cancel macro; List.iter self#send_action (Zed_macro.contents macro) | Edit LTerm_edit.Insert_macro_counter -> Zed_edit.insert context (Zed_rope.of_string (Zed_string.unsafe_of_utf8 (string_of_int (Zed_macro.get_counter macro)))); Zed_macro.add_counter macro 1 | Edit LTerm_edit.Set_macro_counter when S.value mode = Edition -> let text = Zed_edit.text edit in save <- (Zed_edit.position context, text); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length text); set_mode Set_counter; set_message (Some (LTerm_text.of_utf8 "Enter a value for the macro counter.")) | Edit LTerm_edit.Add_macro_counter when S.value mode = Edition -> let text = Zed_edit.text edit in save <- (Zed_edit.position context, text); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length text); set_mode Add_counter; set_message (Some (LTerm_text.of_utf8 "Enter a value to add to the macro counter.")) | Accept -> begin match S.value mode with | Edition | Search -> () | Set_counter -> let pos, text = save in save <- (0, Zed_rope.empty ()); (try Zed_macro.set_counter macro (int_of_string (Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text edit)))) with Failure _ -> ()); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length (Zed_edit.text edit)); Zed_edit.insert context text; Zed_edit.goto context pos; set_mode Edition; set_message None | Add_counter -> let pos, text = save in save <- (0, Zed_rope.empty ()); (try Zed_macro.add_counter macro (int_of_string (Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text edit)))) with Failure _ -> ()); Zed_edit.goto context 0; Zed_edit.remove context (Zed_rope.length (Zed_edit.text edit)); Zed_edit.insert context text; Zed_edit.goto context pos; set_mode Edition; set_message None end | Break -> raise Sys.Break | Edit (LTerm_edit.Custom f) -> f () | _ -> () method stylise last = let txt = LTerm_text.of_rope (Zed_edit.text edit) in let pos = Zed_edit.position context in if not last && Zed_edit.get_selection edit then begin let mark = Zed_cursor.get_position (Zed_edit.mark edit) in let a = min pos mark and b = max pos mark in for i = a to b - 1 do let ch, style = txt.(i) in txt.(i) <- (ch, { style with underline = Some true }) done; end; (txt, pos) end class virtual ['a] abstract = object method virtual eval : 'a method virtual send_action : action -> unit method virtual insert : UChar.t -> unit method virtual edit : unit Zed_edit.t method virtual context : unit Zed_edit.context method virtual clipboard : Zed_edit.clipboard method virtual macro : action Zed_macro.t method virtual stylise : bool -> LTerm_text.t * int method virtual history : (Zed_string.t list * Zed_string.t list) signal method virtual message : LTerm_text.t option signal method virtual input_prev : Zed_rope.t method virtual input_next : Zed_rope.t method virtual completion_words : (Zed_string.t * Zed_string.t) list signal method virtual completion_index : int signal method virtual set_completion : ?index:int -> int -> (Zed_string.t * Zed_string.t) list -> unit method virtual completion : unit method virtual complete : unit method virtual show_box : bool method virtual mode : mode signal method virtual interrupt : exn Lwt_mvar.t end (* +-----------------------------------------------------------------+ | Predefined classes | +-----------------------------------------------------------------+ *) class read_line ?history () = object(self) inherit [Zed_string.t] engine ?history () method eval = Zed_rope.to_string (Zed_edit.text self#edit) end class read_password () = object(self) inherit [Zed_string.t] engine () as super method! stylise last = let text, pos = super#stylise last in for i = 0 to Array.length text - 1 do let _ch, style = text.(i) in text.(i) <- (Zed_char.unsafe_of_char '*', style) done; (text, pos) method eval = Zed_rope.to_string (Zed_edit.text self#edit) method! show_box = false method! send_action = function | Prev_search | Next_search -> () | action -> super#send_action action end type 'a read_keyword_result = | Rk_value of 'a | Rk_error of Zed_string.t class ['a] read_keyword ?history () = object(self) inherit ['a read_keyword_result] engine ?history () method keywords = [] method eval = let input = Zed_rope.to_string (Zed_edit.text self#edit) in try Rk_value(List.assoc input self#keywords) with Not_found -> Rk_error input method! completion = let word = Zed_rope.to_string self#input_prev in let keywords = List.filter (fun (keyword, _value) -> Zed_string.starts_with ~prefix:word keyword) self#keywords in self#set_completion 0 (List.map (fun (keyword, _value) -> (keyword, Zed_string.empty ())) keywords) end (* +-----------------------------------------------------------------+ | Running in a terminal | +-----------------------------------------------------------------+ *) let newline_uChar = UChar.of_char '\n' let newline = Zed_char.unsafe_of_uChar @@ newline_uChar let vline = LTerm_draw.({ top = Light; bottom = Light; left = Blank; right = Blank }) let reverse_style = { LTerm_style.none with LTerm_style.reverse = Some true } let default_prompt = LTerm_text.of_utf8 "# " let rec drop count l = if count <= 0 then l else match l with | [] -> [] | _ :: l -> drop (count - 1) l (* Computes the position of the cursor after printing the given styled string: - [pos] is the current cursor position (it may be at column [max-column + 1]) - [text] is the text to display - [start] is the start of the chunk to display in [text] - [stop] is the end of the chunk to display in [text] *) let rec compute_position cols pos text start stop = if start = stop then pos else let ch, _style = text.(start) in if ch = newline then compute_position cols { row = pos.row + 1; col = 0 } text (start + 1) stop else let width= Zed_char.width ch in if pos.col + width > cols then compute_position cols { row = pos.row + 1; col = width } text (start + 1) stop else compute_position cols { pos with col = pos.col + max 0 width } text (start + 1) stop (* Return the "real" position of the cursor, i.e. on the screen. *) let real_pos cols pos = if pos.col = cols then { row = pos.row + 1; col = 0 } else pos let rec get_index_of_last_displayed_word column columns index words = match words with | [] -> index - 1 | (word, _suffix) :: words -> let column = column + Zed_string.length word in if column <= columns - 1 then get_index_of_last_displayed_word (column + 1) columns (index + 1) words else index - 1 (*let rec get_index_of_last_displayed_word_by_width column columns index words = match words with | [] -> index - 1 | (word, _suffix) :: words -> let column = column + Zed_string.(aval_width (width word)) in if column <= columns - 1 then get_index_of_last_displayed_word_by_width (column + 1) columns (index + 1) words else index - 1*) let draw_styled ctx row col str = let size = LTerm_draw.size ctx in let rec loop row col idx = if idx < Array.length str then begin let ch, style = Array.unsafe_get str idx in if ch = newline then loop (row + 1) 0 (idx + 1) else begin let width= max 1 (Zed_char.width ch) in if col + width > size.cols then loop (row + 1) 0 idx else begin LTerm_draw.draw_char ctx row col ~style ch; loop row (col+width) (idx + 1) end end end in loop row col 0 let draw_styled_with_newlines matrix cols row col str = let rec loop row col idx = if idx < Array.length str then begin let ch, style = Array.unsafe_get str idx in if ch = newline then begin LTerm_draw.draw_char_matrix matrix row col newline; loop (row + 1) 0 (idx + 1) end else begin let width= max 1 (Zed_char.width ch) in if col + width > cols then loop (row + 1) 0 idx else begin LTerm_draw.draw_char_matrix matrix row col ~style ch; loop row (col + width) (idx + 1) end end end in loop row col 0 let styled_newline = [|(newline, LTerm_style.none)|] class virtual ['a] term term = let size, set_size = S.create (LTerm.size term) in let event, set_prompt = E.create () in let editor_mode, set_editor_mode = S.create LTerm_editor.Default in let prompt = S.switch (S.hold ~eq:( == ) (S.const default_prompt) event) in let key_sequence, set_key_sequence = S.create [] in object(self) inherit ['a] abstract method size = size method prompt = prompt method set_prompt prompt = set_prompt prompt val mutable visible = true (* Whether the read-line instance is currently visible. *) val mutable displayed = false (* Whether the read-line instance is currently displayed on the screen. *) val mutable draw_queued = false (* Whether a draw operation has been queued, in which case it is not necessary to redraw. *) val mutable cursor = { row = 0; col = 0 } (* The position of the cursor. *) val mutable completion_start = S.const 0 (* Index of the first displayed word in the completion bar. *) val mutable height = 0 (* The height of the displayed material. *) val mutable resolver = None (* The current resolver for resolving input sequences. *) val mutable running = true val vi_state= new LTerm_vi.state val mutable vi_edit= None initializer completion_start <- ( S.fold (fun start (words, index, columns) -> if index < start then (* The cursor is before the left margin. *) let count = List.length words in let rev_index = count - index - 1 in count - get_index_of_last_displayed_word 1 columns rev_index (drop rev_index (List.rev words)) - 1 else if index > get_index_of_last_displayed_word 1 columns start (drop start words) then (* The cursor is after the right margin. *) index else start) 0 (S.changes (S.l3 (fun words index size -> (words, index, size.cols)) self#completion_words self#completion_index size)) ) method editor_mode = editor_mode val mutable vi_thread= None method vi_state= vi_state method set_editor_mode mode = set_editor_mode mode; match mode with | LTerm_editor.Default-> vi_edit <- None; (match vi_thread with | Some thread-> LTerm_vi.Concurrent.Thread.cancel thread; vi_thread <- None; | None-> ()); | LTerm_editor.Vi-> let _vi_edit= vi_state#vi_edit in vi_edit <- Some _vi_edit; self#listen_vi _vi_edit self#interrupt method key_sequence = key_sequence method completion_start = completion_start val draw_mutex = Lwt_mutex.create () method private queue_draw_update = if draw_queued then return () else begin (* Wait a bit in order not to draw too often. *) draw_queued <- true; Lwt.pause () >>= fun () -> draw_queued <- false; Lwt_mutex.with_lock draw_mutex (fun () -> if running then self#draw_update else return ()) end method draw_update = let size = S.value size in if visible && size.rows > 0 && size.cols > 0 then begin let styled, position = self#stylise false in let prompt = S.value prompt in (* Compute the position of the cursor after displaying the prompt. *) let pos_after_prompt = compute_position size.cols { row = 0; col = 0 } prompt 0 (Array.length prompt) in (* Compute the position of the cursor after displaying the input before the cursor. *) let pos_after_before = compute_position size.cols pos_after_prompt styled 0 position in (* Compute the position of the cursor after displaying the input. *) let pos_after_styled = compute_position size.cols pos_after_before styled position (Array.length styled) in (* Compute the position of the cursor after displaying the newline used to end the input. *) let pos_after_newline = compute_position size.cols pos_after_styled styled_newline 0 1 in (* The real position of the cursor on the screen. *) let pos_cursor = real_pos size.cols pos_after_before in (* Height of prompt+input. *) let prompt_input_height = max (pos_cursor.row + 1) pos_after_newline.row in let matrix = if self#show_box && size.cols > 2 then match S.value self#message with | Some msg -> (* Compute the height of the message. *) let message_height = (compute_position (size.cols - 2) { row = 0; col = 0 } msg 0 (Array.length msg)).row + 1 in (* The total height of the displayed text. *) let total_height = prompt_input_height + message_height + 2 in (* Create the matrix for the rendering. *) let matrix_size = { cols = size.cols + 1; rows = if displayed then max total_height height else total_height } in let matrix = LTerm_draw.make_matrix matrix_size in (* Update the height parameter. *) height <- total_height; (* Draw the prompt and the input. *) draw_styled_with_newlines matrix size.cols 0 0 prompt; draw_styled_with_newlines matrix size.cols pos_after_prompt.row pos_after_prompt.col styled; draw_styled_with_newlines matrix size.cols pos_after_styled.row pos_after_styled.col styled_newline; let ctx = LTerm_draw.sub (LTerm_draw.context matrix matrix_size) { row1 = 0; col1 = 0; row2 = matrix_size.rows; col2 = size.cols; } in (* Draw a frame for the message. *) LTerm_draw.draw_frame ctx { row1 = prompt_input_height; col1 = 0; row2 = total_height; col2 = size.cols; } LTerm_draw.Light; for row = prompt_input_height to total_height - 1 do LTerm_draw.draw_char_matrix matrix row size.cols newline; done; (* Draw the message. *) let ctx = LTerm_draw.sub ctx { row1 = prompt_input_height + 1; col1 = 1; row2 = total_height - 1; col2 = size.cols - 1; } in draw_styled ctx 0 0 msg; matrix | None -> let comp_start = S.value self#completion_start in let comp_index = S.value self#completion_index in let comp_words = drop comp_start (S.value self#completion_words) in (* The total height of the displayed text. *) let total_height = prompt_input_height + 3 in (* Create the matrix for the rendering. *) let matrix_size = { cols = size.cols + 1; rows = if displayed then max total_height height else total_height } in let matrix = LTerm_draw.make_matrix matrix_size in (* Update the height parameter. *) height <- total_height; (* Draw the prompt and the input. *) draw_styled_with_newlines matrix size.cols 0 0 prompt; draw_styled_with_newlines matrix size.cols pos_after_prompt.row pos_after_prompt.col styled; draw_styled_with_newlines matrix size.cols pos_after_styled.row pos_after_styled.col styled_newline; let ctx = LTerm_draw.sub (LTerm_draw.context matrix matrix_size) { row1 = 0; col1 = 0; row2 = matrix_size.rows; col2 = size.cols; } in (* Draw a frame for the completion. *) LTerm_draw.draw_frame ctx { row1 = prompt_input_height; col1 = 0; row2 = total_height; col2 = size.cols; } LTerm_draw.Light; for row = prompt_input_height to total_height - 1 do LTerm_draw.draw_char_matrix matrix row size.cols newline; done; (* Draw the completion. *) let ctx = LTerm_draw.sub ctx { row1 = prompt_input_height + 1; col1 = 1; row2 = total_height - 1; col2 = size.cols - 1; } in let rec loop idx col = function | [] -> () | (word, _suffix) :: words -> let len = Zed_string.length word in LTerm_draw.draw_string ctx 0 col word; (* Apply the reverse style if this is the selected word. *) if idx = comp_index then for col = col to min (col + len - 1) (size.cols - 2) do LTerm_draw.set_style (LTerm_draw.point ctx 0 col) reverse_style done; (* Draw a separator. *) LTerm_draw.draw_piece ctx 0 (col + len) vline; let col = col + len + 1 in if col < size.cols - 2 then loop (idx + 1) col words in loop comp_start 0 comp_words; matrix else begin let total_height = prompt_input_height in let matrix_size = { cols = size.cols + 1; rows = if displayed then max total_height height else total_height } in let matrix = LTerm_draw.make_matrix matrix_size in height <- total_height; draw_styled_with_newlines matrix size.cols 0 0 prompt; draw_styled_with_newlines matrix size.cols pos_after_prompt.row pos_after_prompt.col styled; matrix end in LTerm.hide_cursor term >>= fun () -> begin if displayed then (* Go back to the beginning of displayed text. *) LTerm.move term (-cursor.row) (-cursor.col) else return () end >>= fun () -> (* Display everything. *) LTerm.print_box_with_newlines term matrix >>= fun () -> (* Update the cursor. *) cursor <- pos_cursor; (* Move the cursor to the right position. *) LTerm.move term (cursor.row - Array.length matrix + 1) cursor.col >>= fun () -> LTerm.show_cursor term >>= fun () -> LTerm.flush term >>= fun () -> displayed <- true; return () end else return () method draw_success = let size = S.value size in if size.rows > 0 && size.cols > 0 then begin let styled, _position = self#stylise true in let prompt = S.value prompt in (if displayed then LTerm.move term (-cursor.row) (-cursor.col) >>= fun () -> LTerm.clear_screen_next term else return ()) >>= fun () -> LTerm.fprints term prompt >>= fun () -> LTerm.fprintls term styled end else return () method draw_failure = self#draw_success method hide = if visible then begin visible <- false; Lwt_mutex.lock draw_mutex >>= fun () -> Lwt.finalize (fun () -> let size = S.value size in if displayed && size.rows > 0 && size.cols > 0 then let matrix_size = { cols = size.cols + 1; rows = height } in let matrix = LTerm_draw.make_matrix matrix_size in for row = 0 to height - 1 do LTerm_draw.draw_char_matrix matrix row 0 newline; done; LTerm.move term (-cursor.row) (-cursor.col) >>= fun () -> LTerm.print_box_with_newlines term matrix >>= fun () -> LTerm.move term (1 - Array.length matrix) 0 >>= fun () -> cursor <- { row = 0; col = 0 }; height <- 0; displayed <- false; return () else return ()) (fun () -> Lwt_mutex.unlock draw_mutex; return ()) end else return () method show = if not visible then begin visible <- true; self#queue_draw_update end else return () val mutable mode = None val mutable local_bindings = Bindings.empty method bind keys actions = local_bindings <- Bindings.add keys actions local_bindings method private keyseq keys= match keys with | []-> return (ContinueLoop []) | key::tl-> let res = match resolver with | Some res -> res | None -> Bindings.resolver [ Bindings.pack (fun x -> x) local_bindings ; Bindings.pack (fun x -> x) !bindings ; Bindings.pack (List.map (fun x -> Edit x)) !LTerm_edit.bindings ] in match Bindings.resolve key res with | Bindings.Accepted actions -> resolver <- None; set_key_sequence []; self#exec ~keys:tl actions | Bindings.Continue res -> resolver <- Some res; set_key_sequence (S.value key_sequence @ [key]); return (ContinueLoop tl) | Bindings.Rejected -> set_key_sequence []; if resolver = None then match key with | { control = false; meta = false; shift = false; code = Char ch } -> Zed_macro.add self#macro (Edit (LTerm_edit.Zed (Zed_edit.Insert (Zed_char.unsafe_of_uChar ch)))); self#insert ch | { code = Char ch; _ } when LTerm.windows term && UChar.code ch >= 32 -> (* Windows reports Shift+A for A, ... *) Zed_macro.add self#macro (Edit (LTerm_edit.Zed (Zed_edit.Insert (Zed_char.unsafe_of_uChar ch)))); self#insert ch | _ -> () else resolver <- None; return (ContinueLoop tl) val result= Lwt_mvar.create_empty () method private listen_vi vi_edit exnBox= let msgBox= vi_edit#action_output in let rec perform_actions= function | []-> return (ContinueLoop []) | action::tl-> LTerm_vi.perform vi_edit self#context self#exec action >>= function | Result _ as r -> return r | ContinueLoop _-> perform_actions tl in let rec listen ()= set_key_sequence []; LTerm_vi.Concurrent.MsgBox.get msgBox >>= (function | Bypass keyseq-> let keyseq= List.map LTerm_vi.of_vi_key keyseq in self#process_keys keyseq >>= (function | Result r-> Lwt_mvar.put result r | ContinueLoop _-> listen () ) | Dummy-> listen () | Vi actions-> perform_actions actions >>= function | ContinueLoop _-> listen () | Result r-> Lwt_mvar.put result r ) in let thread= Lwt.catch listen (fun exn-> Lwt_mvar.put exnBox exn) in vi_thread <- Some (thread) method private process_keys keys= self#keyseq keys >>= function | Result r-> return (Result r) | ContinueLoop keys-> match keys with | []-> return (ContinueLoop []) | _-> self#process_keys keys (* The main loop. *) method private loop = let read_event= match vi_edit with | Some _-> Lwt.pause () >>= fun ()-> Lwt.(>|=) (LTerm.read_event term) (fun ev-> Ev ev) | None-> Lwt.(>|=) (LTerm.read_event term) (fun ev-> Ev ev) in Lwt.pick [ read_event; Lwt.(>|=) (Lwt_mvar.take result) (fun r-> Loop_result r); Lwt.(>|=) (Lwt_mvar.take self#interrupt) (fun e-> Interrupted e); ] >>= function | Loop_result r-> return r | Interrupted exn-> raise exn | Ev ev-> match ev with | LTerm_event.Resize size -> set_size size; self#loop | LTerm_event.Key key -> (match S.value editor_mode with | LTerm_editor.Default-> self#process_keys [key] >>= (function | Result r-> return r | ContinueLoop _-> self#loop) | LTerm_editor.Vi-> match vi_edit with | Some vi_edit-> set_key_sequence (S.value key_sequence @ [key]); LTerm_vi.Concurrent.MsgBox.put vi_edit#i (LTerm_vi.of_lterm_key key) >>= fun ()-> self#loop | None-> self#process_keys [key] >>= (function | Result r-> return r | ContinueLoop _-> self#loop ) (* falllback to the default mode *)) | _ -> self#loop method create_temporary_file_for_external_editor = Filename.temp_file "lambda-term" ".txt" method external_editor = try Sys.getenv "EDITOR" with Not_found -> "vi" method private exec ?(keys= []) actions= match actions with | Accept :: _ when S.value self#mode = Edition -> Zed_macro.add self#macro Accept; return (Result self#eval) | Clear_screen :: actions -> Zed_macro.add self#macro Clear_screen; LTerm.clear_screen term >>= fun () -> LTerm.goto term { row = 0; col = 0 } >>= fun () -> displayed <- false; self#queue_draw_update >>= fun () -> self#exec ~keys actions | Edit LTerm_edit.Play_macro :: actions -> Zed_macro.cancel self#macro; self#exec ~keys (Zed_macro.contents macro @ actions) | Suspend :: actions -> if Sys.win32 then self#exec ~keys actions else begin let is_visible = visible in self#hide >>= fun () -> LTerm.flush term >>= fun () -> begin match mode with | Some mode -> LTerm.leave_raw_mode term mode | None -> return () end >>= fun () -> Unix.kill (Unix.getpid ()) Sys.sigtstp; begin match LTerm.is_a_tty term with | true -> LTerm.enter_raw_mode term >>= fun m -> mode <- Some m; return () | false -> return () end >>= fun () -> (if is_visible then self#show else return ()) >>= fun () -> self#exec ~keys actions end | Edit_with_external_editor :: actions -> begin let is_visible = visible in self#hide >>= fun () -> LTerm.flush term >>= fun () -> begin match mode with | Some mode -> LTerm.leave_raw_mode term mode | None -> return () end >>= fun () -> let temp_fn = self#create_temporary_file_for_external_editor in let input = Zed_rope.to_string (Zed_edit.text self#edit) in Lwt_io.with_file ~mode:Output temp_fn (fun oc -> Lwt_io.write_line oc (Zed_string.to_utf8 input)) >>= fun () -> let editor = self#external_editor in Printf.ksprintf Lwt_unix.system "%s %s" editor (Filename.quote temp_fn) >>= fun status -> (if status <> WEXITED 0 then Lwt_io.eprintf "`%s %s' exited with status %d\n" editor temp_fn (match status with | WEXITED n -> n | _ -> 255) else Lwt.try_bind (fun () -> Lwt_io.with_file ~mode:Input temp_fn Lwt_io.read) (fun s -> let s = Zed_utf8.rstrip s in Zed_edit.goto_bot self#context; Zed_edit.replace self#context (Zed_rope.length (Zed_edit.text self#edit)) (Zed_rope.of_string (Zed_string.unsafe_of_utf8 s)); Lwt.return ()) (function | Unix.Unix_error (err, _, _) -> Lwt_io.eprintf "%s: %s\n" temp_fn (Unix.error_message err) | exn -> Lwt.fail exn) ) >>= fun () -> begin match LTerm.is_a_tty term with | true -> LTerm.enter_raw_mode term >>= fun m -> mode <- Some m; return () | false -> return () end >>= fun () -> (if is_visible then self#show else return ()) >>= fun () -> self#exec ~keys actions end | action :: actions -> self#send_action action; self#exec ~keys actions | [] -> return (ContinueLoop keys) method run = (* Update the size with the current size. *) set_size (LTerm.size term); running <- true; (* Redraw everything when needed. *) let event = E.map_p (fun () -> if running then self#queue_draw_update else return ()) (E.select [ E.stamp (S.changes size) (); Zed_edit.update self#edit [Zed_edit.cursor self#context]; E.stamp (S.changes prompt) (); E.stamp (S.changes self#completion_words) (); E.stamp (S.changes self#completion_index) (); E.stamp (S.changes self#completion_start) (); E.stamp (S.changes self#message) (); ]) in begin match LTerm.is_a_tty term with | true -> LTerm.enter_raw_mode term >>= fun m -> mode <- Some m; return () | false -> return () end >>= fun () -> begin Lwt.finalize (fun () -> Lwt.catch (fun () -> (* Go to the beginning of line otherwise all offset calculation will be false. *) LTerm.fprint term "\r" >>= fun () -> self#queue_draw_update >>= fun () -> self#loop) (fun exn -> running <- false; E.stop event; Lwt_mutex.with_lock draw_mutex (fun () -> self#draw_failure) >>= fun () -> Lwt.fail exn)) (fun () -> match mode with | Some mode -> LTerm.leave_raw_mode term mode | None -> return ()) end >>= fun result -> running <- false; E.stop event; Lwt_mutex.with_lock draw_mutex (fun () -> self#draw_success) >>= fun () -> return result end lambda-term-3.1.0/src/lTerm_read_line.mli000066400000000000000000000266711366433625400203070ustar00rootroot00000000000000(* * lTerm_read_line.mli * ------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Interactive line input *) (** For a complete example of usage of this module, look at the shell example (examples/shell.ml) distributed with Lambda-Term. *) open CamomileLibrary open React exception Interrupt (** Exception raised when the user presses [Ctrl^D] with an empty input. *) type prompt = LTerm_text.t (** Type of prompts. *) type history = Zed_string.t list (** Type of histories. It is a list of entries from the most recent to the oldest. *) (** {6 Completion} *) val common_prefix : string list -> string (** Returns the common prefix of a list of words. *) val zed_common_prefix : Zed_string.t list -> Zed_string.t (** Returns the common prefix of a list of words. *) val lookup : Zed_utf8.t -> Zed_utf8.t list -> Zed_utf8.t list (** [lookup word words] lookup for completion of [word] into [words]. It returns all words starting with [word]. *) val lookup_assoc : Zed_utf8.t -> (Zed_utf8.t * 'a) list -> (Zed_utf8.t * 'a) list (** [lookup_assoc word words] does the same as {!lookup} but works on associative list. *) (** {6 Actions} *) (** Type of actions. *) type action = | Edit of LTerm_edit.action (** An edition action. *) | Interrupt_or_delete_next_char (** Interrupt if at the beginning of an empty line, or delete the next character. *) | Complete (** Complete current input. *) | Complete_bar_next (** Go to the next possible completion in the completion bar. *) | Complete_bar_prev (** Go to the previous possible completion in the completion bar. *) | Complete_bar_first (** Goto the beginning of the completion bar. *) | Complete_bar_last (** Goto the end of the completion bar. *) | Complete_bar (** Complete current input using the completion bar. *) | History_prev (** Go to the previous entry of the history. *) | History_next (** Go to the next entry of the history. *) | History_search_prev (** Search the previous entry of the history. *) | History_search_next (** Search the next entry of the history. *) | Accept (** Accept the current input. *) | Clear_screen (** Clear the screen. *) | Prev_search (** Search backward in the history. *) | Next_search (** Search forward in the history. *) | Cancel_search (** Cancel search mode. *) | Break (** Raise [Sys.Break]. *) | Suspend (** Suspend the program. *) | Edit_with_external_editor (** Launch external editor. *) val bindings : action list Zed_input.Make(LTerm_key).t ref (** Bindings. *) val bind : LTerm_key.t list -> action list -> unit (** [bind seq actions] associates [actions] to the given sequence. *) val unbind : LTerm_key.t list -> unit (** [unbind seq] unbinds [seq]. *) val actions : (action * string) list (** List of actions with their names, except {!Edit}. *) 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 variants name but lowercased and with '_' replaced by '-'. It raises [Not_found] if the name does not correspond to an action. It also recognizes edition actions. *) val name_of_action : action -> string (** [name_of_action act] returns the name of the given action. *) (** {6 The read-line engine} *) val macro : action Zed_macro.t (** The global macro recorder. *) (** The current read-line mode. *) type mode = | Edition (** Editing. *) | Search (** Backward search. *) | Set_counter (** Setting the macro counter value. *) | Add_counter (** Adding a value to the macro counter. *) (** The read-line engine. If no clipboard is provided, {!LTerm_edit.clipboard} is used. If no macro recorder is provided, {!macro} is used. *) class virtual ['a] engine : ?history : history -> ?clipboard : Zed_edit.clipboard -> ?macro : action Zed_macro.t -> unit -> object (** {6 Result} *) method virtual eval : 'a (** Evaluates the contents of the engine. *) (** {6 Actions} *) method insert : UChar.t -> unit (** Inserts the given character. Note that is it also possible to manipulate directly the edition context. *) method send_action : action -> unit (** Evolves according to the given action. *) (** {6 State} *) method edit : unit Zed_edit.t (** The edition engine used by this read-line engine. *) method context : unit Zed_edit.context (** The context for the edition engine. *) method clipboard : Zed_edit.clipboard (** The clipboard used by the edition engine. *) method macro : action Zed_macro.t (** The macro recorder. *) method input_prev : Zed_rope.t (** The input before the cursor. *) method input_next : Zed_rope.t (** The input after the cursor. *) method mode : mode signal (** The current mode. *) method stylise : bool -> LTerm_text.t * int (** Returns the stylised input and the position of the cursor. The argument is [true] if this is for the last drawing or [false] otherwise. *) method history : (Zed_string.t list * Zed_string.t list) signal (** The history zipper. *) method message : LTerm_text.t option signal (** A message to display in the completion box. When [None] the completion should be displayed, and when [Some msg] [msg] should be displayed. *) method interrupt : exn Lwt_mvar.t (** To notify an interrupt singal *) (** {6 Completion} *) method completion_words : (Zed_string.t * Zed_string.t) list signal (** Current possible completions. Each completion is of the form [(word, suffix)] where [word] is the completion itself and [suffix] is a suffix to add if the completion is choosen. *) method completion_index : int signal (** The position in the completion bar. *) method set_completion : ?index:int -> int -> (Zed_string.t * Zed_string.t) list -> unit (** [set_completion ?index start words] sets the current completions. [start] is the position of the beginning of the word being completed and [words] is the list of possible completions with their suffixes. [index] is the position in the completion bar, default to [0]. The result is made available through the {!completion_words} signal. *) method completion : unit (** Ask for computing completion for current input. This method should call {!set_completion}. *) method complete : unit (** Complete current input. This is the method called when the user presses Tab. *) method show_box : bool (** Whether to show the box or not. It default to [true]. *) end (** Abstract version of {!engine}. *) class virtual ['a] abstract : object method virtual eval : 'a method virtual send_action : action -> unit method virtual insert : UChar.t -> unit method virtual edit : unit Zed_edit.t method virtual context : unit Zed_edit.context method virtual clipboard : Zed_edit.clipboard method virtual macro : action Zed_macro.t method virtual stylise : bool -> LTerm_text.t * int method virtual history : (Zed_string.t list * Zed_string.t list) signal method virtual message : LTerm_text.t option signal method virtual input_prev : Zed_rope.t method virtual input_next : Zed_rope.t method virtual completion_words : (Zed_string.t * Zed_string.t) list signal method virtual completion_index : int signal method virtual set_completion : ?index:int -> int -> (Zed_string.t * Zed_string.t) list -> unit method virtual completion : unit method virtual complete : unit method virtual show_box : bool method virtual mode : mode signal method virtual interrupt : exn Lwt_mvar.t end (** {6 Predefined classes} *) (** Simple read-line engine which returns the result as a string. *) class read_line : ?history : history -> unit -> object inherit [Zed_string.t] engine method eval : Zed_string.t (** Returns the result as a UTF-8 encoded string. *) end (** Read-line engine for reading a password. The [stylise] method default to replacing all characters by ['*']. You can also for example completely disable displaying the password by doing: {[ method stylise = ([||], 0) ]} Also showing completion is disabled. *) class read_password : unit -> object inherit [Zed_string.t] engine method eval : Zed_string.t (** Returns the result as a UTF-8 encoded string. *) end (** The result of reading a keyword. *) type 'a read_keyword_result = | Rk_value of 'a (** The user typed a correct keyword and this is its associated value. *) | Rk_error of Zed_string.t (** The user did not enter a correct keyword and this is what he typed instead. *) (** Read a keyword. *) class ['a] read_keyword : ?history : history -> unit -> object inherit ['a read_keyword_result] engine method eval : 'a read_keyword_result (** If the input correspond to a keyword, returns its associated value. otherwise returns [`Error input]. *) method keywords : (Zed_string.t * 'a) list (** List of keywords with their associated values. *) end (** {6 Running in a terminal} *) type 'a loop_result= | Result of 'a | ContinueLoop of LTerm_key.t list (** Class for read-line instances running in a terminal. *) class virtual ['a] term : LTerm.t -> object inherit ['a] abstract method run : 'a Lwt.t (** Run this read-line instance. *) method private exec : ?keys : LTerm_key.t list -> action list -> 'a loop_result Lwt.t (** Executes a list of actions. Rememver to call [Zed_macro.add self#macro action] if you overload this method. *) method editor_mode : LTerm_editor.mode signal (** The current editor mode. *) method set_editor_mode : LTerm_editor.mode -> unit (** Set the current editor mode. *) method vi_state : LTerm_vi.state (** Get the current vi_state . *) method bind : LTerm_key.t list -> action list -> unit method draw_update : unit Lwt.t (** Updates current display and put the cursor at current edition position. *) method draw_success : unit Lwt.t (** Draws after accepting current input. *) method draw_failure : unit Lwt.t (** Draws after an exception has been raised. *) method prompt : prompt signal (** The signal holding the prompt. *) method set_prompt : prompt signal -> unit (** Sets the prompt signal. *) method size : LTerm_geom.size signal (** The size of the terminal. This can be used for computing the prompt. *) method key_sequence : LTerm_key.t list signal (** The currently typed key sequence. *) method completion_start : int signal (** Index of the first displayed word in the completion bar. *) method hide : unit Lwt.t (** Hide this read-line instance. It remains invisible until {!show} is called. *) method show : unit Lwt.t (** Show this read-line instance if it has been previously hidden. *) val mutable visible : bool (** Whether the instance is visible. *) method create_temporary_file_for_external_editor : string (** Create a temporary file and return its path. Used for editing input with an external command. *) method external_editor : string (** External editor command. *) end lambda-term-3.1.0/src/lTerm_read_line_base.ml000066400000000000000000000104621366433625400211170ustar00rootroot00000000000000(* * lTerm_read_line_base.ml * ------------ * Copyright : (c) 2020, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* +-----------------------------------------------------------------+ | Actions | +-----------------------------------------------------------------+ *) let pervasives_compare= compare exception Interrupt type action = | Edit of LTerm_edit.action | Interrupt_or_delete_next_char | Complete | Complete_bar_next | Complete_bar_prev | Complete_bar_first | Complete_bar_last | Complete_bar | History_prev | History_next | History_search_prev | History_search_next | Accept | Clear_screen | Prev_search | Next_search | Cancel_search | Break | Suspend | Edit_with_external_editor let doc_of_action = function | Edit action -> LTerm_edit.doc_of_action action | Interrupt_or_delete_next_char -> "interrupt if at the beginning of an empty line, or delete the next character." | Complete -> "complete current input." | Complete_bar_next -> "go to the next possible completion in the completion bar." | Complete_bar_prev -> "go to the previous possible completion in the completion bar." | Complete_bar_first -> "go to the beginning of the completion bar." | Complete_bar_last -> "go to the end of the completion bar." | Complete_bar -> "complete current input using the completion bar." | History_prev -> "go to the previous entry of the history." | History_next -> "go to the next entry of the history." | History_search_prev -> "go to the previous entry of the history that matches the start of the current line." | History_search_next -> "go to the next entry of the history that matches the start of the current line." | Accept -> "accept the current input." | Clear_screen -> "clear the screen." | Prev_search -> "search backward in the history." | Next_search -> "search forward in the history." | Cancel_search -> "cancel search mode." | Break -> "cancel edition." | Suspend -> "suspend edition." | Edit_with_external_editor -> "edit input with external editor command." let actions = [ Interrupt_or_delete_next_char, "interrupt-or-delete-next-char"; Complete, "complete"; Complete_bar_next, "complete-bar-next"; Complete_bar_prev, "complete-bar-prev"; Complete_bar_first, "complete-bar-first"; Complete_bar_last, "complete-bar-last"; Complete_bar, "complete-bar"; History_prev, "history-prev"; History_next, "history-next"; History_search_prev, "history-search-prev"; History_search_next, "history-search-next"; Accept, "accept"; Clear_screen, "clear-screen"; Prev_search, "prev-search"; Next_search, "next-search"; Cancel_search, "cancel-search"; Break, "break"; Suspend, "suspend"; Edit_with_external_editor, "edit-with-external-editor"; ] let actions_to_names = Array.of_list (List.sort (fun (a1, _) (a2, _) -> pervasives_compare a1 a2) actions) let names_to_actions = Array.of_list (List.sort (fun (_, n1) (_, n2) -> pervasives_compare n1 n2) actions) let action_of_name x = let rec loop a b = if a = b then Edit (LTerm_edit.action_of_name x) else let c = (a + b) / 2 in let action, name = Array.unsafe_get names_to_actions c in match pervasives_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 pervasives_compare x action with | d when d < 0 -> loop a c | d when d > 0 -> loop (c + 1) b | _ -> name in match x with | Edit x -> LTerm_edit.name_of_action x | _ -> loop 0 (Array.length actions_to_names) (* +-----------------------------------------------------------------+ | Event loop | +-----------------------------------------------------------------+ *) type 'a loop_result= | Result of 'a | ContinueLoop of LTerm_key.t list type 'a loop_status= | Ev of LTerm_event.t | Loop_result of 'a | Interrupted of exn lambda-term-3.1.0/src/lTerm_resource_lexer.mll000066400000000000000000000011511366433625400214000ustar00rootroot00000000000000(* * lTerm_resource_lexer.mll * ------------------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) let blank = [' ' '\t'] let eol = ('\n' | eof) rule line = parse | eof { `EOF } | blank* ('!' [^'\n']* eol | eol) { `Empty } | blank* ([^' ' '\t' '\n']+ as key) blank* ':' blank* ([^' ' '\t' '\n']* as value) blank* eol { `Assoc(key, value) } | [^':' '\n']+ eol { `Error("':' missing") } | blank* ':' [^'\n']* eol { `Error("key missing") } | [^'\n']* eol { `Error("unknown error") } lambda-term-3.1.0/src/lTerm_resources.ml000066400000000000000000001456041366433625400202240ustar00rootroot00000000000000 (* * lTerm_resources.ml * ------------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* little hack to maintain 4.02.3 compat with warnings *) module String = struct [@@@ocaml.warning "-3-32"] let lowercase_ascii = StringLabels.lowercase include String end let (>>=) = Lwt.(>>=) let home = try Sys.getenv "HOME" with Not_found -> try (Unix.getpwuid (Unix.getuid ())).Unix.pw_dir with Unix.Unix_error _ | Not_found -> if Sys.win32 then try Sys.getenv "AppData" with Not_found -> "" else "" type xdg_location = Cache | Config | Data module XDGBD = struct let ( / ) = Filename.concat let get env_var unix_default win32_default = try Sys.getenv env_var with Not_found -> if Sys.win32 then win32_default else unix_default let cache = get "XDG_CACHE_HOME" (home / ".cache") (home / "Local Settings" / "Cache") let config = get "XDG_CONFIG_HOME" (home / ".config") (home / "Local Settings") let data = get "XDG_DATA_HOME" (home / ".local" / "share") (try Sys.getenv "AppData" with Not_found -> "") let user_dir = function | Cache -> cache | Config -> config | Data -> data end let xdgbd_warning loc file_name = let loc_name = match loc with | Cache -> "$XDG_CACHE_HOME" | Config -> "$XDG_CONFIG_HOME" | Data -> "$XDG_DATA_HOME" in Printf.eprintf "Warning: it is recommended to move `%s` to `%s`, see:\n%s\n" file_name loc_name "http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html" let xdgbd_file ~loc ?(allow_legacy_location=false) name = let home_file = Filename.concat home name in if allow_legacy_location && Sys.file_exists home_file then let () = xdgbd_warning loc home_file in home_file else Filename.concat (XDGBD.user_dir loc) name (* +-----------------------------------------------------------------+ | Types | +-----------------------------------------------------------------+ *) type pattern = string list (* Type of a pattern. For example the pattern ["foo*bar*"] is represented by the list [["foo"; "bar"; ""]]. *) type t = (pattern * string) list (* +-----------------------------------------------------------------+ | Pattern matching | +-----------------------------------------------------------------+ *) let sub_equal str ofs patt = let str_len = String.length str and patt_len = String.length patt in let rec loop ofs ofs_patt = ofs_patt = patt_len || (str.[ofs] = patt.[ofs_patt] && loop (ofs + 1) (ofs_patt + 1)) in ofs + patt_len <= str_len && loop ofs 0 let pattern_match pattern string = let length = String.length string in let rec loop offset pattern = if offset = length then pattern = [] || pattern = [""] else match pattern with | [] -> false | literal :: pattern -> let literal_length = String.length literal in let max_offset = length - literal_length in let rec search offset = offset <= max_offset && ((sub_equal string offset literal && loop (offset + literal_length) pattern) || search (offset + 1)) in search offset in match pattern with | [] -> string = "" | literal :: pattern -> sub_equal string 0 literal && loop (String.length literal) pattern (* +-----------------------------------------------------------------+ | Pattern creation | +-----------------------------------------------------------------+ *) let split pattern = let len = String.length pattern in let rec loop ofs = if ofs = len then [""] else match try Some(String.index_from pattern ofs '*') with Not_found -> None with | Some ofs' -> String.sub pattern ofs (ofs' - ofs) :: loop (ofs' + 1) | None -> [String.sub pattern ofs (len - ofs)] in loop 0 (* +-----------------------------------------------------------------+ | Set operations | +-----------------------------------------------------------------+ *) let empty = [] let rec get key = function | [] -> "" | (pattern, value) :: rest -> if pattern_match pattern key then value else get key rest let add pattern value resources = (split pattern, value) :: resources let merge = ( @ ) (* +-----------------------------------------------------------------+ | Readers | +-----------------------------------------------------------------+ *) exception Error of string let error str = raise (Error str) let get_bool key resources = match String.lowercase_ascii (get key resources) with | "true" -> Some true | "false" -> Some false | "" | "none" -> None | s -> Printf.ksprintf error "invalid boolean value %S" s let hex_of_char ch = 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 Exit let get_color key resources = match String.lowercase_ascii (get key resources) with (* Terminal colors. *) | "default" -> Some LTerm_style.default | "black" -> Some LTerm_style.black | "red" -> Some LTerm_style.red | "green" -> Some LTerm_style.green | "yellow" -> Some LTerm_style.yellow | "blue" -> Some LTerm_style.blue | "magenta" -> Some LTerm_style.magenta | "cyan" -> Some LTerm_style.cyan | "white" -> Some LTerm_style.white | "lblack" -> Some LTerm_style.lblack | "lred" -> Some LTerm_style.lred | "lgreen" -> Some LTerm_style.lgreen | "lyellow" -> Some LTerm_style.lyellow | "lblue" -> Some LTerm_style.lblue | "lmagenta" -> Some LTerm_style.lmagenta | "lcyan" -> Some LTerm_style.lcyan | "lwhite" -> Some LTerm_style.lwhite | "light-black" -> Some LTerm_style.lblack | "light-red" -> Some LTerm_style.lred | "light-green" -> Some LTerm_style.lgreen | "light-yellow" -> Some LTerm_style.lyellow | "light-blue" -> Some LTerm_style.lblue | "light-magenta" -> Some LTerm_style.lmagenta | "light-cyan" -> Some LTerm_style.lcyan | "light-white" -> Some LTerm_style.lwhite (* X11 colors. *) | "x-snow" -> Some (LTerm_style.rgb 255 250 250) | "x-ghost-white" -> Some (LTerm_style.rgb 248 248 255) | "x-ghostwhite" -> Some (LTerm_style.rgb 248 248 255) | "x-white-smoke" -> Some (LTerm_style.rgb 245 245 245) | "x-whitesmoke" -> Some (LTerm_style.rgb 245 245 245) | "x-gainsboro" -> Some (LTerm_style.rgb 220 220 220) | "x-floral-white" -> Some (LTerm_style.rgb 255 250 240) | "x-floralwhite" -> Some (LTerm_style.rgb 255 250 240) | "x-old-lace" -> Some (LTerm_style.rgb 253 245 230) | "x-oldlace" -> Some (LTerm_style.rgb 253 245 230) | "x-linen" -> Some (LTerm_style.rgb 250 240 230) | "x-antique-white" -> Some (LTerm_style.rgb 250 235 215) | "x-antiquewhite" -> Some (LTerm_style.rgb 250 235 215) | "x-papaya-whip" -> Some (LTerm_style.rgb 255 239 213) | "x-papayawhip" -> Some (LTerm_style.rgb 255 239 213) | "x-blanched-almond" -> Some (LTerm_style.rgb 255 235 205) | "x-blanchedalmond" -> Some (LTerm_style.rgb 255 235 205) | "x-bisque" -> Some (LTerm_style.rgb 255 228 196) | "x-peach-puff" -> Some (LTerm_style.rgb 255 218 185) | "x-peachpuff" -> Some (LTerm_style.rgb 255 218 185) | "x-navajo-white" -> Some (LTerm_style.rgb 255 222 173) | "x-navajowhite" -> Some (LTerm_style.rgb 255 222 173) | "x-moccasin" -> Some (LTerm_style.rgb 255 228 181) | "x-cornsilk" -> Some (LTerm_style.rgb 255 248 220) | "x-ivory" -> Some (LTerm_style.rgb 255 255 240) | "x-lemon-chiffon" -> Some (LTerm_style.rgb 255 250 205) | "x-lemonchiffon" -> Some (LTerm_style.rgb 255 250 205) | "x-seashell" -> Some (LTerm_style.rgb 255 245 238) | "x-honeydew" -> Some (LTerm_style.rgb 240 255 240) | "x-mint-cream" -> Some (LTerm_style.rgb 245 255 250) | "x-mintcream" -> Some (LTerm_style.rgb 245 255 250) | "x-azure" -> Some (LTerm_style.rgb 240 255 255) | "x-alice-blue" -> Some (LTerm_style.rgb 240 248 255) | "x-aliceblue" -> Some (LTerm_style.rgb 240 248 255) | "x-lavender" -> Some (LTerm_style.rgb 230 230 250) | "x-lavender-blush" -> Some (LTerm_style.rgb 255 240 245) | "x-lavenderblush" -> Some (LTerm_style.rgb 255 240 245) | "x-misty-rose" -> Some (LTerm_style.rgb 255 228 225) | "x-mistyrose" -> Some (LTerm_style.rgb 255 228 225) | "x-white" -> Some (LTerm_style.rgb 255 255 255) | "x-black" -> Some (LTerm_style.rgb 0 0 0) | "x-dark-slate-gray" -> Some (LTerm_style.rgb 47 79 79) | "x-darkslategray" -> Some (LTerm_style.rgb 47 79 79) | "x-dark-slate-grey" -> Some (LTerm_style.rgb 47 79 79) | "x-darkslategrey" -> Some (LTerm_style.rgb 47 79 79) | "x-dim-gray" -> Some (LTerm_style.rgb 105 105 105) | "x-dimgray" -> Some (LTerm_style.rgb 105 105 105) | "x-dim-grey" -> Some (LTerm_style.rgb 105 105 105) | "x-dimgrey" -> Some (LTerm_style.rgb 105 105 105) | "x-slate-gray" -> Some (LTerm_style.rgb 112 128 144) | "x-slategray" -> Some (LTerm_style.rgb 112 128 144) | "x-slate-grey" -> Some (LTerm_style.rgb 112 128 144) | "x-slategrey" -> Some (LTerm_style.rgb 112 128 144) | "x-light-slate-gray" -> Some (LTerm_style.rgb 119 136 153) | "x-lightslategray" -> Some (LTerm_style.rgb 119 136 153) | "x-light-slate-grey" -> Some (LTerm_style.rgb 119 136 153) | "x-lightslategrey" -> Some (LTerm_style.rgb 119 136 153) | "x-gray" -> Some (LTerm_style.rgb 190 190 190) | "x-grey" -> Some (LTerm_style.rgb 190 190 190) | "x-light-grey" -> Some (LTerm_style.rgb 211 211 211) | "x-lightgrey" -> Some (LTerm_style.rgb 211 211 211) | "x-light-gray" -> Some (LTerm_style.rgb 211 211 211) | "x-lightgray" -> Some (LTerm_style.rgb 211 211 211) | "x-midnight-blue" -> Some (LTerm_style.rgb 25 25 112) | "x-midnightblue" -> Some (LTerm_style.rgb 25 25 112) | "x-navy" -> Some (LTerm_style.rgb 0 0 128) | "x-navy-blue" -> Some (LTerm_style.rgb 0 0 128) | "x-navyblue" -> Some (LTerm_style.rgb 0 0 128) | "x-cornflower-blue" -> Some (LTerm_style.rgb 100 149 237) | "x-cornflowerblue" -> Some (LTerm_style.rgb 100 149 237) | "x-dark-slate-blue" -> Some (LTerm_style.rgb 72 61 139) | "x-darkslateblue" -> Some (LTerm_style.rgb 72 61 139) | "x-slate-blue" -> Some (LTerm_style.rgb 106 90 205) | "x-slateblue" -> Some (LTerm_style.rgb 106 90 205) | "x-medium-slate-blue" -> Some (LTerm_style.rgb 123 104 238) | "x-mediumslateblue" -> Some (LTerm_style.rgb 123 104 238) | "x-light-slate-blue" -> Some (LTerm_style.rgb 132 112 255) | "x-lightslateblue" -> Some (LTerm_style.rgb 132 112 255) | "x-medium-blue" -> Some (LTerm_style.rgb 0 0 205) | "x-mediumblue" -> Some (LTerm_style.rgb 0 0 205) | "x-royal-blue" -> Some (LTerm_style.rgb 65 105 225) | "x-royalblue" -> Some (LTerm_style.rgb 65 105 225) | "x-blue" -> Some (LTerm_style.rgb 0 0 255) | "x-dodger-blue" -> Some (LTerm_style.rgb 30 144 255) | "x-dodgerblue" -> Some (LTerm_style.rgb 30 144 255) | "x-deep-sky-blue" -> Some (LTerm_style.rgb 0 191 255) | "x-deepskyblue" -> Some (LTerm_style.rgb 0 191 255) | "x-sky-blue" -> Some (LTerm_style.rgb 135 206 235) | "x-skyblue" -> Some (LTerm_style.rgb 135 206 235) | "x-light-sky-blue" -> Some (LTerm_style.rgb 135 206 250) | "x-lightskyblue" -> Some (LTerm_style.rgb 135 206 250) | "x-steel-blue" -> Some (LTerm_style.rgb 70 130 180) | "x-steelblue" -> Some (LTerm_style.rgb 70 130 180) | "x-light-steel-blue" -> Some (LTerm_style.rgb 176 196 222) | "x-lightsteelblue" -> Some (LTerm_style.rgb 176 196 222) | "x-light-blue" -> Some (LTerm_style.rgb 173 216 230) | "x-lightblue" -> Some (LTerm_style.rgb 173 216 230) | "x-powder-blue" -> Some (LTerm_style.rgb 176 224 230) | "x-powderblue" -> Some (LTerm_style.rgb 176 224 230) | "x-pale-turquoise" -> Some (LTerm_style.rgb 175 238 238) | "x-paleturquoise" -> Some (LTerm_style.rgb 175 238 238) | "x-dark-turquoise" -> Some (LTerm_style.rgb 0 206 209) | "x-darkturquoise" -> Some (LTerm_style.rgb 0 206 209) | "x-medium-turquoise" -> Some (LTerm_style.rgb 72 209 204) | "x-mediumturquoise" -> Some (LTerm_style.rgb 72 209 204) | "x-turquoise" -> Some (LTerm_style.rgb 64 224 208) | "x-cyan" -> Some (LTerm_style.rgb 0 255 255) | "x-light-cyan" -> Some (LTerm_style.rgb 224 255 255) | "x-lightcyan" -> Some (LTerm_style.rgb 224 255 255) | "x-cadet-blue" -> Some (LTerm_style.rgb 95 158 160) | "x-cadetblue" -> Some (LTerm_style.rgb 95 158 160) | "x-medium-aquamarine" -> Some (LTerm_style.rgb 102 205 170) | "x-mediumaquamarine" -> Some (LTerm_style.rgb 102 205 170) | "x-aquamarine" -> Some (LTerm_style.rgb 127 255 212) | "x-dark-green" -> Some (LTerm_style.rgb 0 100 0) | "x-darkgreen" -> Some (LTerm_style.rgb 0 100 0) | "x-dark-olive-green" -> Some (LTerm_style.rgb 85 107 47) | "x-darkolivegreen" -> Some (LTerm_style.rgb 85 107 47) | "x-dark-sea-green" -> Some (LTerm_style.rgb 143 188 143) | "x-darkseagreen" -> Some (LTerm_style.rgb 143 188 143) | "x-sea-green" -> Some (LTerm_style.rgb 46 139 87) | "x-seagreen" -> Some (LTerm_style.rgb 46 139 87) | "x-medium-sea-green" -> Some (LTerm_style.rgb 60 179 113) | "x-mediumseagreen" -> Some (LTerm_style.rgb 60 179 113) | "x-light-sea-green" -> Some (LTerm_style.rgb 32 178 170) | "x-lightseagreen" -> Some (LTerm_style.rgb 32 178 170) | "x-pale-green" -> Some (LTerm_style.rgb 152 251 152) | "x-palegreen" -> Some (LTerm_style.rgb 152 251 152) | "x-spring-green" -> Some (LTerm_style.rgb 0 255 127) | "x-springgreen" -> Some (LTerm_style.rgb 0 255 127) | "x-lawn-green" -> Some (LTerm_style.rgb 124 252 0) | "x-lawngreen" -> Some (LTerm_style.rgb 124 252 0) | "x-green" -> Some (LTerm_style.rgb 0 255 0) | "x-chartreuse" -> Some (LTerm_style.rgb 127 255 0) | "x-medium-spring-green" -> Some (LTerm_style.rgb 0 250 154) | "x-mediumspringgreen" -> Some (LTerm_style.rgb 0 250 154) | "x-green-yellow" -> Some (LTerm_style.rgb 173 255 47) | "x-greenyellow" -> Some (LTerm_style.rgb 173 255 47) | "x-lime-green" -> Some (LTerm_style.rgb 50 205 50) | "x-limegreen" -> Some (LTerm_style.rgb 50 205 50) | "x-yellow-green" -> Some (LTerm_style.rgb 154 205 50) | "x-yellowgreen" -> Some (LTerm_style.rgb 154 205 50) | "x-forest-green" -> Some (LTerm_style.rgb 34 139 34) | "x-forestgreen" -> Some (LTerm_style.rgb 34 139 34) | "x-olive-drab" -> Some (LTerm_style.rgb 107 142 35) | "x-olivedrab" -> Some (LTerm_style.rgb 107 142 35) | "x-dark-khaki" -> Some (LTerm_style.rgb 189 183 107) | "x-darkkhaki" -> Some (LTerm_style.rgb 189 183 107) | "x-khaki" -> Some (LTerm_style.rgb 240 230 140) | "x-pale-goldenrod" -> Some (LTerm_style.rgb 238 232 170) | "x-palegoldenrod" -> Some (LTerm_style.rgb 238 232 170) | "x-light-goldenrod-yellow" -> Some (LTerm_style.rgb 250 250 210) | "x-lightgoldenrodyellow" -> Some (LTerm_style.rgb 250 250 210) | "x-light-yellow" -> Some (LTerm_style.rgb 255 255 224) | "x-lightyellow" -> Some (LTerm_style.rgb 255 255 224) | "x-yellow" -> Some (LTerm_style.rgb 255 255 0) | "x-gold" -> Some (LTerm_style.rgb 255 215 0) | "x-light-goldenrod" -> Some (LTerm_style.rgb 238 221 130) | "x-lightgoldenrod" -> Some (LTerm_style.rgb 238 221 130) | "x-goldenrod" -> Some (LTerm_style.rgb 218 165 32) | "x-dark-goldenrod" -> Some (LTerm_style.rgb 184 134 11) | "x-darkgoldenrod" -> Some (LTerm_style.rgb 184 134 11) | "x-rosy-brown" -> Some (LTerm_style.rgb 188 143 143) | "x-rosybrown" -> Some (LTerm_style.rgb 188 143 143) | "x-indian-red" -> Some (LTerm_style.rgb 205 92 92) | "x-indianred" -> Some (LTerm_style.rgb 205 92 92) | "x-saddle-brown" -> Some (LTerm_style.rgb 139 69 19) | "x-saddlebrown" -> Some (LTerm_style.rgb 139 69 19) | "x-sienna" -> Some (LTerm_style.rgb 160 82 45) | "x-peru" -> Some (LTerm_style.rgb 205 133 63) | "x-burlywood" -> Some (LTerm_style.rgb 222 184 135) | "x-beige" -> Some (LTerm_style.rgb 245 245 220) | "x-wheat" -> Some (LTerm_style.rgb 245 222 179) | "x-sandy-brown" -> Some (LTerm_style.rgb 244 164 96) | "x-sandybrown" -> Some (LTerm_style.rgb 244 164 96) | "x-tan" -> Some (LTerm_style.rgb 210 180 140) | "x-chocolate" -> Some (LTerm_style.rgb 210 105 30) | "x-firebrick" -> Some (LTerm_style.rgb 178 34 34) | "x-brown" -> Some (LTerm_style.rgb 165 42 42) | "x-dark-salmon" -> Some (LTerm_style.rgb 233 150 122) | "x-darksalmon" -> Some (LTerm_style.rgb 233 150 122) | "x-salmon" -> Some (LTerm_style.rgb 250 128 114) | "x-light-salmon" -> Some (LTerm_style.rgb 255 160 122) | "x-lightsalmon" -> Some (LTerm_style.rgb 255 160 122) | "x-orange" -> Some (LTerm_style.rgb 255 165 0) | "x-dark-orange" -> Some (LTerm_style.rgb 255 140 0) | "x-darkorange" -> Some (LTerm_style.rgb 255 140 0) | "x-coral" -> Some (LTerm_style.rgb 255 127 80) | "x-light-coral" -> Some (LTerm_style.rgb 240 128 128) | "x-lightcoral" -> Some (LTerm_style.rgb 240 128 128) | "x-tomato" -> Some (LTerm_style.rgb 255 99 71) | "x-orange-red" -> Some (LTerm_style.rgb 255 69 0) | "x-orangered" -> Some (LTerm_style.rgb 255 69 0) | "x-red" -> Some (LTerm_style.rgb 255 0 0) | "x-hot-pink" -> Some (LTerm_style.rgb 255 105 180) | "x-hotpink" -> Some (LTerm_style.rgb 255 105 180) | "x-deep-pink" -> Some (LTerm_style.rgb 255 20 147) | "x-deeppink" -> Some (LTerm_style.rgb 255 20 147) | "x-pink" -> Some (LTerm_style.rgb 255 192 203) | "x-light-pink" -> Some (LTerm_style.rgb 255 182 193) | "x-lightpink" -> Some (LTerm_style.rgb 255 182 193) | "x-pale-violet-red" -> Some (LTerm_style.rgb 219 112 147) | "x-palevioletred" -> Some (LTerm_style.rgb 219 112 147) | "x-maroon" -> Some (LTerm_style.rgb 176 48 96) | "x-medium-violet-red" -> Some (LTerm_style.rgb 199 21 133) | "x-mediumvioletred" -> Some (LTerm_style.rgb 199 21 133) | "x-violet-red" -> Some (LTerm_style.rgb 208 32 144) | "x-violetred" -> Some (LTerm_style.rgb 208 32 144) | "x-magenta" -> Some (LTerm_style.rgb 255 0 255) | "x-violet" -> Some (LTerm_style.rgb 238 130 238) | "x-plum" -> Some (LTerm_style.rgb 221 160 221) | "x-orchid" -> Some (LTerm_style.rgb 218 112 214) | "x-medium-orchid" -> Some (LTerm_style.rgb 186 85 211) | "x-mediumorchid" -> Some (LTerm_style.rgb 186 85 211) | "x-dark-orchid" -> Some (LTerm_style.rgb 153 50 204) | "x-darkorchid" -> Some (LTerm_style.rgb 153 50 204) | "x-dark-violet" -> Some (LTerm_style.rgb 148 0 211) | "x-darkviolet" -> Some (LTerm_style.rgb 148 0 211) | "x-blue-violet" -> Some (LTerm_style.rgb 138 43 226) | "x-blueviolet" -> Some (LTerm_style.rgb 138 43 226) | "x-purple" -> Some (LTerm_style.rgb 160 32 240) | "x-medium-purple" -> Some (LTerm_style.rgb 147 112 219) | "x-mediumpurple" -> Some (LTerm_style.rgb 147 112 219) | "x-thistle" -> Some (LTerm_style.rgb 216 191 216) | "x-snow1" -> Some (LTerm_style.rgb 255 250 250) | "x-snow2" -> Some (LTerm_style.rgb 238 233 233) | "x-snow3" -> Some (LTerm_style.rgb 205 201 201) | "x-snow4" -> Some (LTerm_style.rgb 139 137 137) | "x-seashell1" -> Some (LTerm_style.rgb 255 245 238) | "x-seashell2" -> Some (LTerm_style.rgb 238 229 222) | "x-seashell3" -> Some (LTerm_style.rgb 205 197 191) | "x-seashell4" -> Some (LTerm_style.rgb 139 134 130) | "x-antiquewhite1" -> Some (LTerm_style.rgb 255 239 219) | "x-antiquewhite2" -> Some (LTerm_style.rgb 238 223 204) | "x-antiquewhite3" -> Some (LTerm_style.rgb 205 192 176) | "x-antiquewhite4" -> Some (LTerm_style.rgb 139 131 120) | "x-bisque1" -> Some (LTerm_style.rgb 255 228 196) | "x-bisque2" -> Some (LTerm_style.rgb 238 213 183) | "x-bisque3" -> Some (LTerm_style.rgb 205 183 158) | "x-bisque4" -> Some (LTerm_style.rgb 139 125 107) | "x-peachpuff1" -> Some (LTerm_style.rgb 255 218 185) | "x-peachpuff2" -> Some (LTerm_style.rgb 238 203 173) | "x-peachpuff3" -> Some (LTerm_style.rgb 205 175 149) | "x-peachpuff4" -> Some (LTerm_style.rgb 139 119 101) | "x-navajowhite1" -> Some (LTerm_style.rgb 255 222 173) | "x-navajowhite2" -> Some (LTerm_style.rgb 238 207 161) | "x-navajowhite3" -> Some (LTerm_style.rgb 205 179 139) | "x-navajowhite4" -> Some (LTerm_style.rgb 139 121 94) | "x-lemonchiffon1" -> Some (LTerm_style.rgb 255 250 205) | "x-lemonchiffon2" -> Some (LTerm_style.rgb 238 233 191) | "x-lemonchiffon3" -> Some (LTerm_style.rgb 205 201 165) | "x-lemonchiffon4" -> Some (LTerm_style.rgb 139 137 112) | "x-cornsilk1" -> Some (LTerm_style.rgb 255 248 220) | "x-cornsilk2" -> Some (LTerm_style.rgb 238 232 205) | "x-cornsilk3" -> Some (LTerm_style.rgb 205 200 177) | "x-cornsilk4" -> Some (LTerm_style.rgb 139 136 120) | "x-ivory1" -> Some (LTerm_style.rgb 255 255 240) | "x-ivory2" -> Some (LTerm_style.rgb 238 238 224) | "x-ivory3" -> Some (LTerm_style.rgb 205 205 193) | "x-ivory4" -> Some (LTerm_style.rgb 139 139 131) | "x-honeydew1" -> Some (LTerm_style.rgb 240 255 240) | "x-honeydew2" -> Some (LTerm_style.rgb 224 238 224) | "x-honeydew3" -> Some (LTerm_style.rgb 193 205 193) | "x-honeydew4" -> Some (LTerm_style.rgb 131 139 131) | "x-lavenderblush1" -> Some (LTerm_style.rgb 255 240 245) | "x-lavenderblush2" -> Some (LTerm_style.rgb 238 224 229) | "x-lavenderblush3" -> Some (LTerm_style.rgb 205 193 197) | "x-lavenderblush4" -> Some (LTerm_style.rgb 139 131 134) | "x-mistyrose1" -> Some (LTerm_style.rgb 255 228 225) | "x-mistyrose2" -> Some (LTerm_style.rgb 238 213 210) | "x-mistyrose3" -> Some (LTerm_style.rgb 205 183 181) | "x-mistyrose4" -> Some (LTerm_style.rgb 139 125 123) | "x-azure1" -> Some (LTerm_style.rgb 240 255 255) | "x-azure2" -> Some (LTerm_style.rgb 224 238 238) | "x-azure3" -> Some (LTerm_style.rgb 193 205 205) | "x-azure4" -> Some (LTerm_style.rgb 131 139 139) | "x-slateblue1" -> Some (LTerm_style.rgb 131 111 255) | "x-slateblue2" -> Some (LTerm_style.rgb 122 103 238) | "x-slateblue3" -> Some (LTerm_style.rgb 105 89 205) | "x-slateblue4" -> Some (LTerm_style.rgb 71 60 139) | "x-royalblue1" -> Some (LTerm_style.rgb 72 118 255) | "x-royalblue2" -> Some (LTerm_style.rgb 67 110 238) | "x-royalblue3" -> Some (LTerm_style.rgb 58 95 205) | "x-royalblue4" -> Some (LTerm_style.rgb 39 64 139) | "x-blue1" -> Some (LTerm_style.rgb 0 0 255) | "x-blue2" -> Some (LTerm_style.rgb 0 0 238) | "x-blue3" -> Some (LTerm_style.rgb 0 0 205) | "x-blue4" -> Some (LTerm_style.rgb 0 0 139) | "x-dodgerblue1" -> Some (LTerm_style.rgb 30 144 255) | "x-dodgerblue2" -> Some (LTerm_style.rgb 28 134 238) | "x-dodgerblue3" -> Some (LTerm_style.rgb 24 116 205) | "x-dodgerblue4" -> Some (LTerm_style.rgb 16 78 139) | "x-steelblue1" -> Some (LTerm_style.rgb 99 184 255) | "x-steelblue2" -> Some (LTerm_style.rgb 92 172 238) | "x-steelblue3" -> Some (LTerm_style.rgb 79 148 205) | "x-steelblue4" -> Some (LTerm_style.rgb 54 100 139) | "x-deepskyblue1" -> Some (LTerm_style.rgb 0 191 255) | "x-deepskyblue2" -> Some (LTerm_style.rgb 0 178 238) | "x-deepskyblue3" -> Some (LTerm_style.rgb 0 154 205) | "x-deepskyblue4" -> Some (LTerm_style.rgb 0 104 139) | "x-skyblue1" -> Some (LTerm_style.rgb 135 206 255) | "x-skyblue2" -> Some (LTerm_style.rgb 126 192 238) | "x-skyblue3" -> Some (LTerm_style.rgb 108 166 205) | "x-skyblue4" -> Some (LTerm_style.rgb 74 112 139) | "x-lightskyblue1" -> Some (LTerm_style.rgb 176 226 255) | "x-lightskyblue2" -> Some (LTerm_style.rgb 164 211 238) | "x-lightskyblue3" -> Some (LTerm_style.rgb 141 182 205) | "x-lightskyblue4" -> Some (LTerm_style.rgb 96 123 139) | "x-slategray1" -> Some (LTerm_style.rgb 198 226 255) | "x-slategray2" -> Some (LTerm_style.rgb 185 211 238) | "x-slategray3" -> Some (LTerm_style.rgb 159 182 205) | "x-slategray4" -> Some (LTerm_style.rgb 108 123 139) | "x-lightsteelblue1" -> Some (LTerm_style.rgb 202 225 255) | "x-lightsteelblue2" -> Some (LTerm_style.rgb 188 210 238) | "x-lightsteelblue3" -> Some (LTerm_style.rgb 162 181 205) | "x-lightsteelblue4" -> Some (LTerm_style.rgb 110 123 139) | "x-lightblue1" -> Some (LTerm_style.rgb 191 239 255) | "x-lightblue2" -> Some (LTerm_style.rgb 178 223 238) | "x-lightblue3" -> Some (LTerm_style.rgb 154 192 205) | "x-lightblue4" -> Some (LTerm_style.rgb 104 131 139) | "x-lightcyan1" -> Some (LTerm_style.rgb 224 255 255) | "x-lightcyan2" -> Some (LTerm_style.rgb 209 238 238) | "x-lightcyan3" -> Some (LTerm_style.rgb 180 205 205) | "x-lightcyan4" -> Some (LTerm_style.rgb 122 139 139) | "x-paleturquoise1" -> Some (LTerm_style.rgb 187 255 255) | "x-paleturquoise2" -> Some (LTerm_style.rgb 174 238 238) | "x-paleturquoise3" -> Some (LTerm_style.rgb 150 205 205) | "x-paleturquoise4" -> Some (LTerm_style.rgb 102 139 139) | "x-cadetblue1" -> Some (LTerm_style.rgb 152 245 255) | "x-cadetblue2" -> Some (LTerm_style.rgb 142 229 238) | "x-cadetblue3" -> Some (LTerm_style.rgb 122 197 205) | "x-cadetblue4" -> Some (LTerm_style.rgb 83 134 139) | "x-turquoise1" -> Some (LTerm_style.rgb 0 245 255) | "x-turquoise2" -> Some (LTerm_style.rgb 0 229 238) | "x-turquoise3" -> Some (LTerm_style.rgb 0 197 205) | "x-turquoise4" -> Some (LTerm_style.rgb 0 134 139) | "x-cyan1" -> Some (LTerm_style.rgb 0 255 255) | "x-cyan2" -> Some (LTerm_style.rgb 0 238 238) | "x-cyan3" -> Some (LTerm_style.rgb 0 205 205) | "x-cyan4" -> Some (LTerm_style.rgb 0 139 139) | "x-darkslategray1" -> Some (LTerm_style.rgb 151 255 255) | "x-darkslategray2" -> Some (LTerm_style.rgb 141 238 238) | "x-darkslategray3" -> Some (LTerm_style.rgb 121 205 205) | "x-darkslategray4" -> Some (LTerm_style.rgb 82 139 139) | "x-aquamarine1" -> Some (LTerm_style.rgb 127 255 212) | "x-aquamarine2" -> Some (LTerm_style.rgb 118 238 198) | "x-aquamarine3" -> Some (LTerm_style.rgb 102 205 170) | "x-aquamarine4" -> Some (LTerm_style.rgb 69 139 116) | "x-darkseagreen1" -> Some (LTerm_style.rgb 193 255 193) | "x-darkseagreen2" -> Some (LTerm_style.rgb 180 238 180) | "x-darkseagreen3" -> Some (LTerm_style.rgb 155 205 155) | "x-darkseagreen4" -> Some (LTerm_style.rgb 105 139 105) | "x-seagreen1" -> Some (LTerm_style.rgb 84 255 159) | "x-seagreen2" -> Some (LTerm_style.rgb 78 238 148) | "x-seagreen3" -> Some (LTerm_style.rgb 67 205 128) | "x-seagreen4" -> Some (LTerm_style.rgb 46 139 87) | "x-palegreen1" -> Some (LTerm_style.rgb 154 255 154) | "x-palegreen2" -> Some (LTerm_style.rgb 144 238 144) | "x-palegreen3" -> Some (LTerm_style.rgb 124 205 124) | "x-palegreen4" -> Some (LTerm_style.rgb 84 139 84) | "x-springgreen1" -> Some (LTerm_style.rgb 0 255 127) | "x-springgreen2" -> Some (LTerm_style.rgb 0 238 118) | "x-springgreen3" -> Some (LTerm_style.rgb 0 205 102) | "x-springgreen4" -> Some (LTerm_style.rgb 0 139 69) | "x-green1" -> Some (LTerm_style.rgb 0 255 0) | "x-green2" -> Some (LTerm_style.rgb 0 238 0) | "x-green3" -> Some (LTerm_style.rgb 0 205 0) | "x-green4" -> Some (LTerm_style.rgb 0 139 0) | "x-chartreuse1" -> Some (LTerm_style.rgb 127 255 0) | "x-chartreuse2" -> Some (LTerm_style.rgb 118 238 0) | "x-chartreuse3" -> Some (LTerm_style.rgb 102 205 0) | "x-chartreuse4" -> Some (LTerm_style.rgb 69 139 0) | "x-olivedrab1" -> Some (LTerm_style.rgb 192 255 62) | "x-olivedrab2" -> Some (LTerm_style.rgb 179 238 58) | "x-olivedrab3" -> Some (LTerm_style.rgb 154 205 50) | "x-olivedrab4" -> Some (LTerm_style.rgb 105 139 34) | "x-darkolivegreen1" -> Some (LTerm_style.rgb 202 255 112) | "x-darkolivegreen2" -> Some (LTerm_style.rgb 188 238 104) | "x-darkolivegreen3" -> Some (LTerm_style.rgb 162 205 90) | "x-darkolivegreen4" -> Some (LTerm_style.rgb 110 139 61) | "x-khaki1" -> Some (LTerm_style.rgb 255 246 143) | "x-khaki2" -> Some (LTerm_style.rgb 238 230 133) | "x-khaki3" -> Some (LTerm_style.rgb 205 198 115) | "x-khaki4" -> Some (LTerm_style.rgb 139 134 78) | "x-lightgoldenrod1" -> Some (LTerm_style.rgb 255 236 139) | "x-lightgoldenrod2" -> Some (LTerm_style.rgb 238 220 130) | "x-lightgoldenrod3" -> Some (LTerm_style.rgb 205 190 112) | "x-lightgoldenrod4" -> Some (LTerm_style.rgb 139 129 76) | "x-lightyellow1" -> Some (LTerm_style.rgb 255 255 224) | "x-lightyellow2" -> Some (LTerm_style.rgb 238 238 209) | "x-lightyellow3" -> Some (LTerm_style.rgb 205 205 180) | "x-lightyellow4" -> Some (LTerm_style.rgb 139 139 122) | "x-yellow1" -> Some (LTerm_style.rgb 255 255 0) | "x-yellow2" -> Some (LTerm_style.rgb 238 238 0) | "x-yellow3" -> Some (LTerm_style.rgb 205 205 0) | "x-yellow4" -> Some (LTerm_style.rgb 139 139 0) | "x-gold1" -> Some (LTerm_style.rgb 255 215 0) | "x-gold2" -> Some (LTerm_style.rgb 238 201 0) | "x-gold3" -> Some (LTerm_style.rgb 205 173 0) | "x-gold4" -> Some (LTerm_style.rgb 139 117 0) | "x-goldenrod1" -> Some (LTerm_style.rgb 255 193 37) | "x-goldenrod2" -> Some (LTerm_style.rgb 238 180 34) | "x-goldenrod3" -> Some (LTerm_style.rgb 205 155 29) | "x-goldenrod4" -> Some (LTerm_style.rgb 139 105 20) | "x-darkgoldenrod1" -> Some (LTerm_style.rgb 255 185 15) | "x-darkgoldenrod2" -> Some (LTerm_style.rgb 238 173 14) | "x-darkgoldenrod3" -> Some (LTerm_style.rgb 205 149 12) | "x-darkgoldenrod4" -> Some (LTerm_style.rgb 139 101 8) | "x-rosybrown1" -> Some (LTerm_style.rgb 255 193 193) | "x-rosybrown2" -> Some (LTerm_style.rgb 238 180 180) | "x-rosybrown3" -> Some (LTerm_style.rgb 205 155 155) | "x-rosybrown4" -> Some (LTerm_style.rgb 139 105 105) | "x-indianred1" -> Some (LTerm_style.rgb 255 106 106) | "x-indianred2" -> Some (LTerm_style.rgb 238 99 99) | "x-indianred3" -> Some (LTerm_style.rgb 205 85 85) | "x-indianred4" -> Some (LTerm_style.rgb 139 58 58) | "x-sienna1" -> Some (LTerm_style.rgb 255 130 71) | "x-sienna2" -> Some (LTerm_style.rgb 238 121 66) | "x-sienna3" -> Some (LTerm_style.rgb 205 104 57) | "x-sienna4" -> Some (LTerm_style.rgb 139 71 38) | "x-burlywood1" -> Some (LTerm_style.rgb 255 211 155) | "x-burlywood2" -> Some (LTerm_style.rgb 238 197 145) | "x-burlywood3" -> Some (LTerm_style.rgb 205 170 125) | "x-burlywood4" -> Some (LTerm_style.rgb 139 115 85) | "x-wheat1" -> Some (LTerm_style.rgb 255 231 186) | "x-wheat2" -> Some (LTerm_style.rgb 238 216 174) | "x-wheat3" -> Some (LTerm_style.rgb 205 186 150) | "x-wheat4" -> Some (LTerm_style.rgb 139 126 102) | "x-tan1" -> Some (LTerm_style.rgb 255 165 79) | "x-tan2" -> Some (LTerm_style.rgb 238 154 73) | "x-tan3" -> Some (LTerm_style.rgb 205 133 63) | "x-tan4" -> Some (LTerm_style.rgb 139 90 43) | "x-chocolate1" -> Some (LTerm_style.rgb 255 127 36) | "x-chocolate2" -> Some (LTerm_style.rgb 238 118 33) | "x-chocolate3" -> Some (LTerm_style.rgb 205 102 29) | "x-chocolate4" -> Some (LTerm_style.rgb 139 69 19) | "x-firebrick1" -> Some (LTerm_style.rgb 255 48 48) | "x-firebrick2" -> Some (LTerm_style.rgb 238 44 44) | "x-firebrick3" -> Some (LTerm_style.rgb 205 38 38) | "x-firebrick4" -> Some (LTerm_style.rgb 139 26 26) | "x-brown1" -> Some (LTerm_style.rgb 255 64 64) | "x-brown2" -> Some (LTerm_style.rgb 238 59 59) | "x-brown3" -> Some (LTerm_style.rgb 205 51 51) | "x-brown4" -> Some (LTerm_style.rgb 139 35 35) | "x-salmon1" -> Some (LTerm_style.rgb 255 140 105) | "x-salmon2" -> Some (LTerm_style.rgb 238 130 98) | "x-salmon3" -> Some (LTerm_style.rgb 205 112 84) | "x-salmon4" -> Some (LTerm_style.rgb 139 76 57) | "x-lightsalmon1" -> Some (LTerm_style.rgb 255 160 122) | "x-lightsalmon2" -> Some (LTerm_style.rgb 238 149 114) | "x-lightsalmon3" -> Some (LTerm_style.rgb 205 129 98) | "x-lightsalmon4" -> Some (LTerm_style.rgb 139 87 66) | "x-orange1" -> Some (LTerm_style.rgb 255 165 0) | "x-orange2" -> Some (LTerm_style.rgb 238 154 0) | "x-orange3" -> Some (LTerm_style.rgb 205 133 0) | "x-orange4" -> Some (LTerm_style.rgb 139 90 0) | "x-darkorange1" -> Some (LTerm_style.rgb 255 127 0) | "x-darkorange2" -> Some (LTerm_style.rgb 238 118 0) | "x-darkorange3" -> Some (LTerm_style.rgb 205 102 0) | "x-darkorange4" -> Some (LTerm_style.rgb 139 69 0) | "x-coral1" -> Some (LTerm_style.rgb 255 114 86) | "x-coral2" -> Some (LTerm_style.rgb 238 106 80) | "x-coral3" -> Some (LTerm_style.rgb 205 91 69) | "x-coral4" -> Some (LTerm_style.rgb 139 62 47) | "x-tomato1" -> Some (LTerm_style.rgb 255 99 71) | "x-tomato2" -> Some (LTerm_style.rgb 238 92 66) | "x-tomato3" -> Some (LTerm_style.rgb 205 79 57) | "x-tomato4" -> Some (LTerm_style.rgb 139 54 38) | "x-orangered1" -> Some (LTerm_style.rgb 255 69 0) | "x-orangered2" -> Some (LTerm_style.rgb 238 64 0) | "x-orangered3" -> Some (LTerm_style.rgb 205 55 0) | "x-orangered4" -> Some (LTerm_style.rgb 139 37 0) | "x-red1" -> Some (LTerm_style.rgb 255 0 0) | "x-red2" -> Some (LTerm_style.rgb 238 0 0) | "x-red3" -> Some (LTerm_style.rgb 205 0 0) | "x-red4" -> Some (LTerm_style.rgb 139 0 0) | "x-debianred" -> Some (LTerm_style.rgb 215 7 81) | "x-deeppink1" -> Some (LTerm_style.rgb 255 20 147) | "x-deeppink2" -> Some (LTerm_style.rgb 238 18 137) | "x-deeppink3" -> Some (LTerm_style.rgb 205 16 118) | "x-deeppink4" -> Some (LTerm_style.rgb 139 10 80) | "x-hotpink1" -> Some (LTerm_style.rgb 255 110 180) | "x-hotpink2" -> Some (LTerm_style.rgb 238 106 167) | "x-hotpink3" -> Some (LTerm_style.rgb 205 96 144) | "x-hotpink4" -> Some (LTerm_style.rgb 139 58 98) | "x-pink1" -> Some (LTerm_style.rgb 255 181 197) | "x-pink2" -> Some (LTerm_style.rgb 238 169 184) | "x-pink3" -> Some (LTerm_style.rgb 205 145 158) | "x-pink4" -> Some (LTerm_style.rgb 139 99 108) | "x-lightpink1" -> Some (LTerm_style.rgb 255 174 185) | "x-lightpink2" -> Some (LTerm_style.rgb 238 162 173) | "x-lightpink3" -> Some (LTerm_style.rgb 205 140 149) | "x-lightpink4" -> Some (LTerm_style.rgb 139 95 101) | "x-palevioletred1" -> Some (LTerm_style.rgb 255 130 171) | "x-palevioletred2" -> Some (LTerm_style.rgb 238 121 159) | "x-palevioletred3" -> Some (LTerm_style.rgb 205 104 137) | "x-palevioletred4" -> Some (LTerm_style.rgb 139 71 93) | "x-maroon1" -> Some (LTerm_style.rgb 255 52 179) | "x-maroon2" -> Some (LTerm_style.rgb 238 48 167) | "x-maroon3" -> Some (LTerm_style.rgb 205 41 144) | "x-maroon4" -> Some (LTerm_style.rgb 139 28 98) | "x-violetred1" -> Some (LTerm_style.rgb 255 62 150) | "x-violetred2" -> Some (LTerm_style.rgb 238 58 140) | "x-violetred3" -> Some (LTerm_style.rgb 205 50 120) | "x-violetred4" -> Some (LTerm_style.rgb 139 34 82) | "x-magenta1" -> Some (LTerm_style.rgb 255 0 255) | "x-magenta2" -> Some (LTerm_style.rgb 238 0 238) | "x-magenta3" -> Some (LTerm_style.rgb 205 0 205) | "x-magenta4" -> Some (LTerm_style.rgb 139 0 139) | "x-orchid1" -> Some (LTerm_style.rgb 255 131 250) | "x-orchid2" -> Some (LTerm_style.rgb 238 122 233) | "x-orchid3" -> Some (LTerm_style.rgb 205 105 201) | "x-orchid4" -> Some (LTerm_style.rgb 139 71 137) | "x-plum1" -> Some (LTerm_style.rgb 255 187 255) | "x-plum2" -> Some (LTerm_style.rgb 238 174 238) | "x-plum3" -> Some (LTerm_style.rgb 205 150 205) | "x-plum4" -> Some (LTerm_style.rgb 139 102 139) | "x-mediumorchid1" -> Some (LTerm_style.rgb 224 102 255) | "x-mediumorchid2" -> Some (LTerm_style.rgb 209 95 238) | "x-mediumorchid3" -> Some (LTerm_style.rgb 180 82 205) | "x-mediumorchid4" -> Some (LTerm_style.rgb 122 55 139) | "x-darkorchid1" -> Some (LTerm_style.rgb 191 62 255) | "x-darkorchid2" -> Some (LTerm_style.rgb 178 58 238) | "x-darkorchid3" -> Some (LTerm_style.rgb 154 50 205) | "x-darkorchid4" -> Some (LTerm_style.rgb 104 34 139) | "x-purple1" -> Some (LTerm_style.rgb 155 48 255) | "x-purple2" -> Some (LTerm_style.rgb 145 44 238) | "x-purple3" -> Some (LTerm_style.rgb 125 38 205) | "x-purple4" -> Some (LTerm_style.rgb 85 26 139) | "x-mediumpurple1" -> Some (LTerm_style.rgb 171 130 255) | "x-mediumpurple2" -> Some (LTerm_style.rgb 159 121 238) | "x-mediumpurple3" -> Some (LTerm_style.rgb 137 104 205) | "x-mediumpurple4" -> Some (LTerm_style.rgb 93 71 139) | "x-thistle1" -> Some (LTerm_style.rgb 255 225 255) | "x-thistle2" -> Some (LTerm_style.rgb 238 210 238) | "x-thistle3" -> Some (LTerm_style.rgb 205 181 205) | "x-thistle4" -> Some (LTerm_style.rgb 139 123 139) | "x-gray0" -> Some (LTerm_style.rgb 0 0 0) | "x-grey0" -> Some (LTerm_style.rgb 0 0 0) | "x-gray1" -> Some (LTerm_style.rgb 3 3 3) | "x-grey1" -> Some (LTerm_style.rgb 3 3 3) | "x-gray2" -> Some (LTerm_style.rgb 5 5 5) | "x-grey2" -> Some (LTerm_style.rgb 5 5 5) | "x-gray3" -> Some (LTerm_style.rgb 8 8 8) | "x-grey3" -> Some (LTerm_style.rgb 8 8 8) | "x-gray4" -> Some (LTerm_style.rgb 10 10 10) | "x-grey4" -> Some (LTerm_style.rgb 10 10 10) | "x-gray5" -> Some (LTerm_style.rgb 13 13 13) | "x-grey5" -> Some (LTerm_style.rgb 13 13 13) | "x-gray6" -> Some (LTerm_style.rgb 15 15 15) | "x-grey6" -> Some (LTerm_style.rgb 15 15 15) | "x-gray7" -> Some (LTerm_style.rgb 18 18 18) | "x-grey7" -> Some (LTerm_style.rgb 18 18 18) | "x-gray8" -> Some (LTerm_style.rgb 20 20 20) | "x-grey8" -> Some (LTerm_style.rgb 20 20 20) | "x-gray9" -> Some (LTerm_style.rgb 23 23 23) | "x-grey9" -> Some (LTerm_style.rgb 23 23 23) | "x-gray10" -> Some (LTerm_style.rgb 26 26 26) | "x-grey10" -> Some (LTerm_style.rgb 26 26 26) | "x-gray11" -> Some (LTerm_style.rgb 28 28 28) | "x-grey11" -> Some (LTerm_style.rgb 28 28 28) | "x-gray12" -> Some (LTerm_style.rgb 31 31 31) | "x-grey12" -> Some (LTerm_style.rgb 31 31 31) | "x-gray13" -> Some (LTerm_style.rgb 33 33 33) | "x-grey13" -> Some (LTerm_style.rgb 33 33 33) | "x-gray14" -> Some (LTerm_style.rgb 36 36 36) | "x-grey14" -> Some (LTerm_style.rgb 36 36 36) | "x-gray15" -> Some (LTerm_style.rgb 38 38 38) | "x-grey15" -> Some (LTerm_style.rgb 38 38 38) | "x-gray16" -> Some (LTerm_style.rgb 41 41 41) | "x-grey16" -> Some (LTerm_style.rgb 41 41 41) | "x-gray17" -> Some (LTerm_style.rgb 43 43 43) | "x-grey17" -> Some (LTerm_style.rgb 43 43 43) | "x-gray18" -> Some (LTerm_style.rgb 46 46 46) | "x-grey18" -> Some (LTerm_style.rgb 46 46 46) | "x-gray19" -> Some (LTerm_style.rgb 48 48 48) | "x-grey19" -> Some (LTerm_style.rgb 48 48 48) | "x-gray20" -> Some (LTerm_style.rgb 51 51 51) | "x-grey20" -> Some (LTerm_style.rgb 51 51 51) | "x-gray21" -> Some (LTerm_style.rgb 54 54 54) | "x-grey21" -> Some (LTerm_style.rgb 54 54 54) | "x-gray22" -> Some (LTerm_style.rgb 56 56 56) | "x-grey22" -> Some (LTerm_style.rgb 56 56 56) | "x-gray23" -> Some (LTerm_style.rgb 59 59 59) | "x-grey23" -> Some (LTerm_style.rgb 59 59 59) | "x-gray24" -> Some (LTerm_style.rgb 61 61 61) | "x-grey24" -> Some (LTerm_style.rgb 61 61 61) | "x-gray25" -> Some (LTerm_style.rgb 64 64 64) | "x-grey25" -> Some (LTerm_style.rgb 64 64 64) | "x-gray26" -> Some (LTerm_style.rgb 66 66 66) | "x-grey26" -> Some (LTerm_style.rgb 66 66 66) | "x-gray27" -> Some (LTerm_style.rgb 69 69 69) | "x-grey27" -> Some (LTerm_style.rgb 69 69 69) | "x-gray28" -> Some (LTerm_style.rgb 71 71 71) | "x-grey28" -> Some (LTerm_style.rgb 71 71 71) | "x-gray29" -> Some (LTerm_style.rgb 74 74 74) | "x-grey29" -> Some (LTerm_style.rgb 74 74 74) | "x-gray30" -> Some (LTerm_style.rgb 77 77 77) | "x-grey30" -> Some (LTerm_style.rgb 77 77 77) | "x-gray31" -> Some (LTerm_style.rgb 79 79 79) | "x-grey31" -> Some (LTerm_style.rgb 79 79 79) | "x-gray32" -> Some (LTerm_style.rgb 82 82 82) | "x-grey32" -> Some (LTerm_style.rgb 82 82 82) | "x-gray33" -> Some (LTerm_style.rgb 84 84 84) | "x-grey33" -> Some (LTerm_style.rgb 84 84 84) | "x-gray34" -> Some (LTerm_style.rgb 87 87 87) | "x-grey34" -> Some (LTerm_style.rgb 87 87 87) | "x-gray35" -> Some (LTerm_style.rgb 89 89 89) | "x-grey35" -> Some (LTerm_style.rgb 89 89 89) | "x-gray36" -> Some (LTerm_style.rgb 92 92 92) | "x-grey36" -> Some (LTerm_style.rgb 92 92 92) | "x-gray37" -> Some (LTerm_style.rgb 94 94 94) | "x-grey37" -> Some (LTerm_style.rgb 94 94 94) | "x-gray38" -> Some (LTerm_style.rgb 97 97 97) | "x-grey38" -> Some (LTerm_style.rgb 97 97 97) | "x-gray39" -> Some (LTerm_style.rgb 99 99 99) | "x-grey39" -> Some (LTerm_style.rgb 99 99 99) | "x-gray40" -> Some (LTerm_style.rgb 102 102 102) | "x-grey40" -> Some (LTerm_style.rgb 102 102 102) | "x-gray41" -> Some (LTerm_style.rgb 105 105 105) | "x-grey41" -> Some (LTerm_style.rgb 105 105 105) | "x-gray42" -> Some (LTerm_style.rgb 107 107 107) | "x-grey42" -> Some (LTerm_style.rgb 107 107 107) | "x-gray43" -> Some (LTerm_style.rgb 110 110 110) | "x-grey43" -> Some (LTerm_style.rgb 110 110 110) | "x-gray44" -> Some (LTerm_style.rgb 112 112 112) | "x-grey44" -> Some (LTerm_style.rgb 112 112 112) | "x-gray45" -> Some (LTerm_style.rgb 115 115 115) | "x-grey45" -> Some (LTerm_style.rgb 115 115 115) | "x-gray46" -> Some (LTerm_style.rgb 117 117 117) | "x-grey46" -> Some (LTerm_style.rgb 117 117 117) | "x-gray47" -> Some (LTerm_style.rgb 120 120 120) | "x-grey47" -> Some (LTerm_style.rgb 120 120 120) | "x-gray48" -> Some (LTerm_style.rgb 122 122 122) | "x-grey48" -> Some (LTerm_style.rgb 122 122 122) | "x-gray49" -> Some (LTerm_style.rgb 125 125 125) | "x-grey49" -> Some (LTerm_style.rgb 125 125 125) | "x-gray50" -> Some (LTerm_style.rgb 127 127 127) | "x-grey50" -> Some (LTerm_style.rgb 127 127 127) | "x-gray51" -> Some (LTerm_style.rgb 130 130 130) | "x-grey51" -> Some (LTerm_style.rgb 130 130 130) | "x-gray52" -> Some (LTerm_style.rgb 133 133 133) | "x-grey52" -> Some (LTerm_style.rgb 133 133 133) | "x-gray53" -> Some (LTerm_style.rgb 135 135 135) | "x-grey53" -> Some (LTerm_style.rgb 135 135 135) | "x-gray54" -> Some (LTerm_style.rgb 138 138 138) | "x-grey54" -> Some (LTerm_style.rgb 138 138 138) | "x-gray55" -> Some (LTerm_style.rgb 140 140 140) | "x-grey55" -> Some (LTerm_style.rgb 140 140 140) | "x-gray56" -> Some (LTerm_style.rgb 143 143 143) | "x-grey56" -> Some (LTerm_style.rgb 143 143 143) | "x-gray57" -> Some (LTerm_style.rgb 145 145 145) | "x-grey57" -> Some (LTerm_style.rgb 145 145 145) | "x-gray58" -> Some (LTerm_style.rgb 148 148 148) | "x-grey58" -> Some (LTerm_style.rgb 148 148 148) | "x-gray59" -> Some (LTerm_style.rgb 150 150 150) | "x-grey59" -> Some (LTerm_style.rgb 150 150 150) | "x-gray60" -> Some (LTerm_style.rgb 153 153 153) | "x-grey60" -> Some (LTerm_style.rgb 153 153 153) | "x-gray61" -> Some (LTerm_style.rgb 156 156 156) | "x-grey61" -> Some (LTerm_style.rgb 156 156 156) | "x-gray62" -> Some (LTerm_style.rgb 158 158 158) | "x-grey62" -> Some (LTerm_style.rgb 158 158 158) | "x-gray63" -> Some (LTerm_style.rgb 161 161 161) | "x-grey63" -> Some (LTerm_style.rgb 161 161 161) | "x-gray64" -> Some (LTerm_style.rgb 163 163 163) | "x-grey64" -> Some (LTerm_style.rgb 163 163 163) | "x-gray65" -> Some (LTerm_style.rgb 166 166 166) | "x-grey65" -> Some (LTerm_style.rgb 166 166 166) | "x-gray66" -> Some (LTerm_style.rgb 168 168 168) | "x-grey66" -> Some (LTerm_style.rgb 168 168 168) | "x-gray67" -> Some (LTerm_style.rgb 171 171 171) | "x-grey67" -> Some (LTerm_style.rgb 171 171 171) | "x-gray68" -> Some (LTerm_style.rgb 173 173 173) | "x-grey68" -> Some (LTerm_style.rgb 173 173 173) | "x-gray69" -> Some (LTerm_style.rgb 176 176 176) | "x-grey69" -> Some (LTerm_style.rgb 176 176 176) | "x-gray70" -> Some (LTerm_style.rgb 179 179 179) | "x-grey70" -> Some (LTerm_style.rgb 179 179 179) | "x-gray71" -> Some (LTerm_style.rgb 181 181 181) | "x-grey71" -> Some (LTerm_style.rgb 181 181 181) | "x-gray72" -> Some (LTerm_style.rgb 184 184 184) | "x-grey72" -> Some (LTerm_style.rgb 184 184 184) | "x-gray73" -> Some (LTerm_style.rgb 186 186 186) | "x-grey73" -> Some (LTerm_style.rgb 186 186 186) | "x-gray74" -> Some (LTerm_style.rgb 189 189 189) | "x-grey74" -> Some (LTerm_style.rgb 189 189 189) | "x-gray75" -> Some (LTerm_style.rgb 191 191 191) | "x-grey75" -> Some (LTerm_style.rgb 191 191 191) | "x-gray76" -> Some (LTerm_style.rgb 194 194 194) | "x-grey76" -> Some (LTerm_style.rgb 194 194 194) | "x-gray77" -> Some (LTerm_style.rgb 196 196 196) | "x-grey77" -> Some (LTerm_style.rgb 196 196 196) | "x-gray78" -> Some (LTerm_style.rgb 199 199 199) | "x-grey78" -> Some (LTerm_style.rgb 199 199 199) | "x-gray79" -> Some (LTerm_style.rgb 201 201 201) | "x-grey79" -> Some (LTerm_style.rgb 201 201 201) | "x-gray80" -> Some (LTerm_style.rgb 204 204 204) | "x-grey80" -> Some (LTerm_style.rgb 204 204 204) | "x-gray81" -> Some (LTerm_style.rgb 207 207 207) | "x-grey81" -> Some (LTerm_style.rgb 207 207 207) | "x-gray82" -> Some (LTerm_style.rgb 209 209 209) | "x-grey82" -> Some (LTerm_style.rgb 209 209 209) | "x-gray83" -> Some (LTerm_style.rgb 212 212 212) | "x-grey83" -> Some (LTerm_style.rgb 212 212 212) | "x-gray84" -> Some (LTerm_style.rgb 214 214 214) | "x-grey84" -> Some (LTerm_style.rgb 214 214 214) | "x-gray85" -> Some (LTerm_style.rgb 217 217 217) | "x-grey85" -> Some (LTerm_style.rgb 217 217 217) | "x-gray86" -> Some (LTerm_style.rgb 219 219 219) | "x-grey86" -> Some (LTerm_style.rgb 219 219 219) | "x-gray87" -> Some (LTerm_style.rgb 222 222 222) | "x-grey87" -> Some (LTerm_style.rgb 222 222 222) | "x-gray88" -> Some (LTerm_style.rgb 224 224 224) | "x-grey88" -> Some (LTerm_style.rgb 224 224 224) | "x-gray89" -> Some (LTerm_style.rgb 227 227 227) | "x-grey89" -> Some (LTerm_style.rgb 227 227 227) | "x-gray90" -> Some (LTerm_style.rgb 229 229 229) | "x-grey90" -> Some (LTerm_style.rgb 229 229 229) | "x-gray91" -> Some (LTerm_style.rgb 232 232 232) | "x-grey91" -> Some (LTerm_style.rgb 232 232 232) | "x-gray92" -> Some (LTerm_style.rgb 235 235 235) | "x-grey92" -> Some (LTerm_style.rgb 235 235 235) | "x-gray93" -> Some (LTerm_style.rgb 237 237 237) | "x-grey93" -> Some (LTerm_style.rgb 237 237 237) | "x-gray94" -> Some (LTerm_style.rgb 240 240 240) | "x-grey94" -> Some (LTerm_style.rgb 240 240 240) | "x-gray95" -> Some (LTerm_style.rgb 242 242 242) | "x-grey95" -> Some (LTerm_style.rgb 242 242 242) | "x-gray96" -> Some (LTerm_style.rgb 245 245 245) | "x-grey96" -> Some (LTerm_style.rgb 245 245 245) | "x-gray97" -> Some (LTerm_style.rgb 247 247 247) | "x-grey97" -> Some (LTerm_style.rgb 247 247 247) | "x-gray98" -> Some (LTerm_style.rgb 250 250 250) | "x-grey98" -> Some (LTerm_style.rgb 250 250 250) | "x-gray99" -> Some (LTerm_style.rgb 252 252 252) | "x-grey99" -> Some (LTerm_style.rgb 252 252 252) | "x-gray100" -> Some (LTerm_style.rgb 255 255 255) | "x-grey100" -> Some (LTerm_style.rgb 255 255 255) | "x-dark-grey" -> Some (LTerm_style.rgb 169 169 169) | "x-darkgrey" -> Some (LTerm_style.rgb 169 169 169) | "x-dark-gray" -> Some (LTerm_style.rgb 169 169 169) | "x-darkgray" -> Some (LTerm_style.rgb 169 169 169) | "x-dark-blue" -> Some (LTerm_style.rgb 0 0 139) | "x-darkblue" -> Some (LTerm_style.rgb 0 0 139) | "x-dark-cyan" -> Some (LTerm_style.rgb 0 139 139) | "x-darkcyan" -> Some (LTerm_style.rgb 0 139 139) | "x-dark-magenta" -> Some (LTerm_style.rgb 139 0 139) | "x-darkmagenta" -> Some (LTerm_style.rgb 139 0 139) | "x-dark-red" -> Some (LTerm_style.rgb 139 0 0) | "x-darkred" -> Some (LTerm_style.rgb 139 0 0) | "x-light-green" -> Some (LTerm_style.rgb 144 238 144) | "x-lightgreen" -> Some (LTerm_style.rgb 144 238 144) | "" | "none" -> None | str when str.[0] = '#' -> if String.length str = 7 then try Some(LTerm_style.rgb (hex_of_char str.[1] lsl 4 lor hex_of_char str.[2]) (hex_of_char str.[3] lsl 4 lor hex_of_char str.[4]) (hex_of_char str.[5] lsl 4 lor hex_of_char str.[6])) with Exit -> Printf.ksprintf error "invalid color %S" str else Printf.ksprintf error "invalid color %S" str | str -> try Some(LTerm_style.index (int_of_string str)) with Failure _ -> Printf.ksprintf error "invalid color %S" str let get_style prefix resources = { LTerm_style.bold = get_bool (prefix ^ ".bold") resources; LTerm_style.underline = get_bool (prefix ^ ".underline") resources; LTerm_style.blink = get_bool (prefix ^ ".blink") resources; LTerm_style.reverse = get_bool (prefix ^ ".reverse") resources; LTerm_style.foreground = get_color (prefix ^ ".foreground") resources; LTerm_style.background = get_color (prefix ^ ".background") resources; } let get_connection key resources = match String.lowercase_ascii (get key resources) with | "blank" -> LTerm_draw.Blank | "light" -> LTerm_draw.Light | "heavy" -> LTerm_draw.Heavy | "" -> LTerm_draw.Light | str -> Printf.ksprintf error "invalid connection %S" str (* +-----------------------------------------------------------------+ | Parsing | +-----------------------------------------------------------------+ *) exception Parse_error of string * int * string let parse str = let lexbuf = Lexing.from_string str in let rec loop line acc = match LTerm_resource_lexer.line lexbuf with | `EOF -> acc | `Empty -> loop (line + 1) acc | `Assoc(pattern, value) -> loop (line + 1) (add pattern value acc) | `Error msg -> raise (Parse_error("", line, msg)) in loop 1 [] let load file = Lwt_io.open_file ~mode:Lwt_io.input file >>= fun ic -> let rec loop lineno acc = Lwt_io.read_line_opt ic >>= fun line -> match line with | None -> Lwt.return acc | Some str -> match LTerm_resource_lexer.line (Lexing.from_string str) with | `EOF -> loop (lineno + 1) acc | `Empty -> loop (lineno + 1) acc | `Assoc(pattern, value) -> loop (lineno + 1) (add pattern value acc) | `Error msg -> Lwt.fail (Parse_error(file, lineno, msg)) in Lwt.finalize (fun () -> loop 1 []) (fun () -> Lwt_io.close ic) lambda-term-3.1.0/src/lTerm_resources.mli000066400000000000000000000053651366433625400203740ustar00rootroot00000000000000(* * lTerm_resources.mli * ------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Widgets resources *) type t (** Type of resources. *) val empty : t (** The empty set of resources. *) val get : string -> t -> string (** [get key resources] returns the key associated to the last pattern that matches [key] in [resources], or the empty string if no pattern matches [key]. *) val add : string -> string -> t -> t (** [add pattern value] returns the new set of resources with the binding [pattern -> value] at the end. *) val merge : t -> t -> t (** [merge res1 res2] merges the two given sets of resources. *) exception Error of string (** Exception raised when the contents of a resource is invalid. *) val get_bool : string -> t -> bool option (** [get_bool name resources] reads the boolean encoded in [resources]. *) val get_color : string -> t -> LTerm_style.color option (** [get_color name resources] reads the color encoded in [resources]. *) val get_style : string -> t -> LTerm_style.t (** [get_style prefix resources] reads the style encoded in [resources]. *) val get_connection : string -> t -> LTerm_draw.connection (** [get_connection name resources] *) exception Parse_error of string * int * string (** [Parse_error(source, line, msg)] is raised when a parsing error is encountered in the input. *) val parse : string -> t (** [parse str] parses a string for a list of properties. [str] must follow the format of X resources files. i.e. comments start with a [!], empty lines are ignored, and configuration lines looks-like: {[ key: value ]} *) val load : string -> t Lwt.t (** Same as {!parse} but parses the contents of a file. *) val home : string (** The home directory. *) type xdg_location = Cache | Config | Data (** The type for user-specific 'cached', 'configuration' and 'data' files. *) val xdgbd_file : loc:xdg_location -> ?allow_legacy_location:bool -> string -> string (** [xdgbd_file ~loc fn] returns the full file-name for a file [fn] in the XDG Base Directory corresponding to the variant given by [loc]. E.g. [xdgbd_file ~loc:LTerm_resources.Cache app_history] would return something like "/home/user/.cache/app_history" Follows the XDG Base Directory specification: http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html The optional parameter [allow_legacy_location], default [false], first searches if there is already a file with the desired name in the user's home directory. If it finds such a file, it returns that filename, else it resorts to regular behavior. *) lambda-term-3.1.0/src/lTerm_running_impl.ml000066400000000000000000000140121366433625400206770ustar00rootroot00000000000000open Lwt open LTerm_geom type t = LTerm_widget_base_impl.t class toplevel = LTerm_toplevel_impl.toplevel (* for focus cycling *) let rec find_focusable widget = if widget#can_focus then Some widget else find_focusable_in_list widget#children and find_focusable_in_list = function | [] -> None | child :: rest -> match find_focusable child with | Some _ as some -> some | None -> find_focusable_in_list rest (* Mouse support *) let rec pick coord widget = if not (LTerm_geom.in_rect widget#allocation coord) then None else let f () = if widget#can_focus then Some(widget, coord) else None in let w = (* search children *) List.fold_left (function None -> pick coord | Some(w, c) -> (fun _ -> Some(w, c))) None widget#children in if w = None then f() else w (* An event for the main loop. *) type 'a event = | Value of 'a (* A value from the waiter thread. *) | Event of LTerm_event.t (* A event from the terminal. *) let lambda_termrc = Filename.concat LTerm_resources.home ".lambda-termrc" let file_exists file = Lwt.catch (fun () -> Lwt_unix.access file [Unix.R_OK] >>= fun () -> return true) (function | Unix.Unix_error _ -> return false | exn -> Lwt.fail exn) let apply_resources ?cache load_resources resources_file widget = if load_resources then file_exists resources_file >>= fun has_resources -> match has_resources with | true -> LTerm_resources.load resources_file >>= fun resources -> widget#set_resources resources; begin match cache with | None -> () | Some c -> c := resources end; return () | false -> return () else return () let ref_focus widget = ref (match find_focusable widget with | Some w -> w | None -> widget) let run_modal term ?save_state ?(load_resources = true) ?(resources_file = lambda_termrc) push_event pop_event widget waiter = let widget = (widget :> t) in let resources_cache = ref LTerm_resources.empty in apply_resources ~cache:resources_cache load_resources resources_file widget >>= fun () -> (* The currently focused widget. *) let focused = ref_focus widget in (* Create a toplevel widget. *) let toplevel = new toplevel focused widget in (* Drawing function for toplevels. *) let draw_toplevel = ref (fun () -> ()) in (* Size for toplevels. *) let size_ref = ref { row1 = 0; col1 = 0; row2 = 0; col2 = 0 } in let layers = ref [toplevel] in let focuses = ref [focused] in (* Layer event handlers. *) let push_layer w = let new_focus = ref_focus w in let new_top = new toplevel new_focus w in new_top#set_queue_draw !draw_toplevel; new_top#set_allocation !size_ref; focuses := new_focus :: !focuses; layers := new_top :: !layers; new_top#set_resources !resources_cache; new_top#queue_draw in let pop_layer () = match !layers with | [_] -> failwith "Trying to destroy the only existing layer." | _ :: tl -> layers := tl; focuses := List.tl !focuses; (List.hd !layers)#queue_draw | [] -> failwith "Internal error: no idea how it happened." in (* Arm layer event handlers. *) toplevel#arm_layer_handlers push_event push_layer pop_event pop_layer; let draw ui matrix = let ctx = LTerm_draw.context matrix (LTerm_ui.size ui) in LTerm_draw.clear ctx; (* Draw the layers starting from the bottom *) let layers_rev = List.rev !layers in let focuses_rev = List.rev !focuses in List.iter2 (fun top focus -> top#draw ctx !focus) layers_rev focuses_rev; let current_focus = List.hd !focuses in match !current_focus#cursor_position with | Some coord -> let rect = !current_focus#allocation in LTerm_ui.set_cursor_visible ui true; LTerm_ui.set_cursor_position ui { row = rect.row1 + coord.row; col = rect.col1 + coord.col } | None -> LTerm_ui.set_cursor_visible ui false in LTerm_ui.create term ?save_state draw >>= fun ui -> draw_toplevel := (fun () -> LTerm_ui.draw ui); toplevel#set_queue_draw !draw_toplevel; let size = LTerm_ui.size ui in size_ref := { !size_ref with row2 = size.rows; col2 = size.cols}; toplevel#set_allocation !size_ref; (* Loop handling events. *) let waiter = waiter >|= fun x -> Value x in let rec loop () = let thread = LTerm_ui.wait ui >|= fun x -> Event x in choose [thread; waiter] >>= function | Event (LTerm_event.Resize size) -> size_ref := { !size_ref with row2 = size.rows; col2 = size.cols}; List.iter (fun top -> top#set_allocation !size_ref) !layers; loop () (* left button mouse click *) | Event ((LTerm_event.Mouse m) as ev) when LTerm_mouse.(m.button=Button1) -> begin let picked = pick LTerm_mouse.(coord m) (toplevel :> t) in match picked with | Some _ -> (* move focus and send it the event *) toplevel#move_focus_to picked; !(List.hd !focuses)#send_event ev; loop () | None -> (* nothing got focus, so drop the event *) loop () end | Event ev -> !(List.hd !focuses)#send_event ev; loop () | Value value -> cancel thread; return value in Lwt.finalize loop (fun () -> LTerm_ui.quit ui) let run term ?save_state ?load_resources ?resources_file widget waiter = run_modal term ?save_state ?load_resources ?resources_file Lwt_react.E.never Lwt_react.E.never widget waiter let prepare_simple_run () = let waiter, wakener = wait () in let push_ev, push_ev_send = Lwt_react.E.create () in let pop_ev, pop_ev_send = Lwt_react.E.create () in let exit = wakeup wakener in let push_layer w = fun () -> push_ev_send (w :> t) in let pop_layer = pop_ev_send in let do_run w = Lazy.force LTerm.stdout >>= fun term -> run_modal term push_ev pop_ev w waiter in (do_run, push_layer, pop_layer, exit) lambda-term-3.1.0/src/lTerm_scroll_impl.ml000066400000000000000000000325121366433625400205220ustar00rootroot00000000000000open LTerm_geom class t = LTerm_widget_base_impl.t let hbar = 0x2550 let vbar = 0x2551 let map_range range1 range2 offset1 = if range1 = 0 then 0 else let map_range range1 range2 offset1 = max 0. (min range2 (range2 *. offset1 /. range1)) in let rnd x = int_of_float (x +. 0.5) in rnd @@ map_range (float_of_int range1) (float_of_int range2) (float_of_int offset1) class adjustment = object(self) (* callbacks *) val offset_change_callbacks = LTerm_widget_callbacks.create () method on_offset_change ?switch (f : int -> unit) = LTerm_widget_callbacks.register switch offset_change_callbacks f val mutable range = 0 val mutable offset = 0 method range = range method set_range ?(trigger_callback=true) r = range <- max 0 r; self#set_offset ~trigger_callback offset (* ensure offset is clipped to the new range *) method offset = offset method set_offset ?(trigger_callback=true) o = let o' = max 0 (min (range-1) o) in if offset <> o' then begin offset <- o'; if trigger_callback then LTerm_widget_callbacks.exec_callbacks offset_change_callbacks o' end end class scrollable_adjustment = object(self) inherit adjustment as adj val scrollbar_change_callbacks = LTerm_widget_callbacks.create () method on_scrollbar_change ?switch (f : unit -> unit) = LTerm_widget_callbacks.register switch scrollbar_change_callbacks f method! set_offset ?(trigger_callback=true) o = adj#set_offset ~trigger_callback o; self#set_scroll_bar_offset (self#scroll_of_window self#offset) method! set_range ?(trigger_callback=true) r = adj#set_range ~trigger_callback r; self#set_scroll_bar_offset (self#scroll_of_window self#offset) val mutable scroll_window_size = 0 method private scroll_window_size = scroll_window_size method set_scroll_window_size s = scroll_window_size <- s val mutable scroll_bar_mode : [ `fixed of int | `dynamic of int ] = `fixed 5 method set_scroll_bar_mode m = scroll_bar_mode <- m method private scroll_bar_size_fixed size = let wsize = self#scroll_window_size in if wsize <= size then max 1 (wsize-1) else max 1 size method private scroll_bar_size_dynamic view_size = if range <= 1 then self#scroll_window_size else if view_size <= 0 then max 1 (self#scroll_window_size / max 1 range) else let range = float_of_int range in let scroll_size = float_of_int @@ self#scroll_window_size in let view_size = float_of_int view_size in let doc_size = view_size +. range in int_of_float @@ scroll_size *. view_size /. doc_size val mutable min_scroll_bar_size : int option = None method private min_scroll_bar_size = match min_scroll_bar_size with None -> 1 | Some(x) -> x method set_min_scroll_bar_size min = min_scroll_bar_size <- Some(min) val mutable max_scroll_bar_size : int option = None method private max_scroll_bar_size = match max_scroll_bar_size with None -> self#scroll_window_size | Some(x) -> x method set_max_scroll_bar_size max = max_scroll_bar_size <- Some(max) val mutable scroll_bar_size = 0 method private scroll_bar_size = let size = max self#min_scroll_bar_size @@ min self#max_scroll_bar_size @@ match scroll_bar_mode with | `fixed size -> self#scroll_bar_size_fixed size | `dynamic size -> self#scroll_bar_size_dynamic size in (if scroll_bar_size <> size then begin scroll_bar_size <- size; LTerm_widget_callbacks.exec_callbacks scrollbar_change_callbacks () end); size method private scroll_bar_steps = self#scroll_window_size - self#scroll_bar_size + 1 val mutable scroll_bar_offset = 0 method private set_scroll_bar_offset o = let offset = max 0 (min (self#scroll_bar_steps-1) o) in (if scroll_bar_offset <> offset then begin scroll_bar_offset <- offset; LTerm_widget_callbacks.exec_callbacks scrollbar_change_callbacks () end) method private window_of_scroll offset = map_range (self#scroll_bar_steps-1) (range-1) offset method private scroll_of_window offset = let offset = map_range (range-1) (self#scroll_bar_steps-1) offset in offset method incr = if range >= self#scroll_bar_steps then self#window_of_scroll (scroll_bar_offset+1) else (offset+1); method decr = if range >= self#scroll_bar_steps then self#window_of_scroll (scroll_bar_offset-1) else (offset-1); (* mouse click control *) (* scale whole scroll bar area into the number of steps. The scroll bar will not necessarily end up where clicked. Add a small dead_zone at far left and right *) method private mouse_scale_ratio scroll = let steps, _size = self#scroll_bar_steps, self#scroll_bar_size in let wsize = self#scroll_window_size in let dead_zone = wsize / 5 in (* ~10% at each end *) map_range (wsize - dead_zone - 1) (steps - 1) (scroll - dead_zone/2) (* place the middle of the scroll bar at the cursor. Large scroll bars will reduce the clickable area by their size. *) method private mouse_scale_middle scroll = let size = self#scroll_bar_size in scroll - (size/2) method private mouse_scale_auto scroll = if self#scroll_bar_size > self#scroll_window_size/2 then self#mouse_scale_ratio scroll else self#mouse_scale_middle scroll val mutable mouse_mode : [ `middle | `ratio | `auto ] = `middle method set_mouse_mode m = mouse_mode <- m method private scroll_of_mouse scroll = match mouse_mode with | `middle -> self#mouse_scale_middle scroll | `ratio -> self#mouse_scale_ratio scroll | `auto -> self#mouse_scale_auto scroll method mouse_scroll scroll = self#window_of_scroll @@ self#scroll_of_mouse scroll val mutable page_size = -1 val mutable document_size = -1 method calculate_range page_size document_size = document_size-page_size+1 method private update_page_and_document_sizes page doc = if page_size <> page || document_size <> doc then begin page_size <- page; document_size <- doc; let range = max 0 (self#calculate_range page_size document_size) in self#set_range range; self#set_mouse_mode `auto; self#set_scroll_bar_mode (`dynamic page_size); end method page_size = page_size method set_page_size s = self#update_page_and_document_sizes s document_size method document_size = document_size method set_document_size s = self#update_page_and_document_sizes page_size s method page_prev = self#offset - page_size method page_next = self#offset + page_size method get_render_params = scroll_bar_offset, self#scroll_bar_size, self#scroll_window_size end class virtual scrollbar rc default_event_handler (adj : #scrollable_adjustment) = object(self) inherit t rc method! can_focus = true (* style *) val mutable focused_style = LTerm_style.none val mutable unfocused_style = LTerm_style.none val mutable bar_style : [ `filled | `outline ] = `outline val mutable show_track = false method! update_resources = let rc = self#resource_class and resources = self#resources in focused_style <- LTerm_resources.get_style (rc ^ ".focused") resources; unfocused_style <- LTerm_resources.get_style (rc ^ ".unfocused") resources; bar_style <- (match LTerm_resources.get (rc ^ ".barstyle") resources with | "filled" -> `filled | "outline" | "" -> `outline | style -> Printf.ksprintf failwith "invalid scrollbar style %s" style); show_track <- (match LTerm_resources.get_bool (rc ^ ".track") resources with | Some(x) -> x | None -> false) (* virtual methods needed to abstract over vert/horz scrollbars *) method virtual private mouse_offset : LTerm_mouse.t -> rect -> int method virtual private scroll_incr_key : LTerm_key.t method virtual private scroll_decr_key : LTerm_key.t (* event handling *) method mouse_event ev = let open LTerm_mouse in let alloc = self#allocation in match ev with | LTerm_event.Mouse m when m.button=Button1 && not m.control && not m.shift && not m.meta -> let scroll = self#mouse_offset m alloc in adj#set_offset @@ adj#mouse_scroll scroll; true | _ -> false method scroll_key_event = function | LTerm_event.Key k when k = self#scroll_decr_key -> adj#set_offset adj#decr; true | LTerm_event.Key k when k = self#scroll_incr_key -> adj#set_offset adj#incr; true | _ -> false (* drawing *) method private draw_bar ctx style rect = let open LTerm_draw in let { cols; rows } = size_of_rect rect in if cols=1 || rows=1 || bar_style=`filled then let x = CamomileLibrary.UChar.of_int @@ if bar_style=`filled then 0x2588 else if cols=1 then vbar else hbar in for c=rect.col1 to rect.col2-1 do for r=rect.row1 to rect.row2-1 do draw_char ctx r c ~style (Zed_char.unsafe_of_uChar x) done done else draw_frame ctx rect ~style Light (* auto-draw *) initializer adj#on_scrollbar_change (fun () -> self#queue_draw) initializer if default_event_handler then self#on_event (fun ev -> self#mouse_event ev || self#scroll_key_event ev) end class vscrollbar ?(rc="scrollbar") ?(default_event_handler=true) ?(width=2) adj = object(self) inherit scrollbar rc default_event_handler adj as super method! size_request = { rows=0; cols=width } method private mouse_offset m alloc = m.LTerm_mouse.row - alloc.row1 val scroll_incr_key = LTerm_key.{ control = false; meta = false; shift = true; code=Down} val scroll_decr_key = LTerm_key.{ control = false; meta = false; shift = true; code=Up} method private scroll_incr_key = scroll_incr_key method private scroll_decr_key = scroll_decr_key method! set_allocation r = super#set_allocation r; adj#set_scroll_window_size (r.row2 - r.row1) method! draw ctx focused = let open LTerm_draw in let focus = (self :> t) = focused in let { cols; _ } = size ctx in let style = if focus then focused_style else unfocused_style in fill_style ctx style; let offset, scroll_bar_size, scroll_window_size = adj#get_render_params in let rect = { row1 = offset; col1 = 0; row2 = offset + scroll_bar_size; col2 = cols } in (if show_track then draw_vline ctx 0 (cols/2) scroll_window_size ~style Light); self#draw_bar ctx style rect end class hscrollbar ?(rc="scrollbar") ?(default_event_handler=true) ?(height=2) adj = object(self) inherit scrollbar rc default_event_handler adj as super method! size_request = { rows=height; cols=0 } method private mouse_offset m alloc = m.LTerm_mouse.col - alloc.col1 val scroll_incr_key = LTerm_key.{ control = false; meta = false; shift = true; code=Right} val scroll_decr_key = LTerm_key.{ control = false; meta = false; shift = true; code=Left} method private scroll_incr_key = scroll_incr_key method private scroll_decr_key = scroll_decr_key method! set_allocation r = super#set_allocation r; adj#set_scroll_window_size (r.col2 - r.col1) method! draw ctx focused = let open LTerm_draw in let focus = (self :> t) = focused in let { rows; _ } = size ctx in let style = if focus then focused_style else unfocused_style in fill_style ctx style; let offset, scroll_bar_size, scroll_window_size = adj#get_render_params in let rect = { row1 = 0; col1 = offset; row2 = rows; col2 = offset + scroll_bar_size } in (if show_track then draw_hline ctx (rows/2) 0 scroll_window_size ~style Light); self#draw_bar ctx style rect end class vslider rng = let adj = new scrollable_adjustment in object(self) inherit vscrollbar ~rc:"slider" ~default_event_handler:false ~width:1 adj initializer adj#set_mouse_mode `middle; adj#set_scroll_bar_mode (`fixed 1); adj#set_range (max 0 rng); self#on_event (fun ev -> let open LTerm_key in match ev with | LTerm_event.Key { control = false; meta = false; shift = true; code=Up} -> adj#set_offset (adj#offset-1); true | LTerm_event.Key { control = false; meta = false; shift = true; code=Down } -> adj#set_offset (adj#offset+1); true | _ -> self#mouse_event ev) method! size_request = { rows=rng; cols=1 } method offset = adj#offset method set_offset = adj#set_offset method range = adj#range method set_range = adj#set_range method on_offset_change = adj#on_offset_change end class hslider rng = let adj = new scrollable_adjustment in object(self) inherit hscrollbar ~rc:"slider" ~default_event_handler:false ~height:1 adj initializer adj#set_mouse_mode `middle; adj#set_scroll_bar_mode (`fixed 1); adj#set_range (max 0 rng); self#on_event (fun ev -> let open LTerm_key in match ev with | LTerm_event.Key { control = false; meta = false; shift = true; code=Left } -> adj#set_offset (adj#offset-1); true | LTerm_event.Key { control = false; meta = false; shift = true; code=Right } -> adj#set_offset (adj#offset+1); true | _ -> self#mouse_event ev) method! size_request = { rows=1; cols=rng } method offset = adj#offset method set_offset = adj#set_offset method range = adj#range method set_range = adj#set_range method on_offset_change = adj#on_offset_change end lambda-term-3.1.0/src/lTerm_style.ml000066400000000000000000000046021366433625400173420ustar00rootroot00000000000000(* * lTerm_style.ml * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* +-----------------------------------------------------------------+ | Colors | +-----------------------------------------------------------------+ *) type color = | Default | Index of int | RGB of int * int * int let default = Default let index n = Index n let rgb r g b = if r < 0 || r > 255 || g < 0 || g > 255 || b < 0 || b > 255 then invalid_arg "LTerm_style.rgb" else RGB(r, g, b) let black = Index 0 let red = Index 1 let green = Index 2 let yellow = Index 3 let blue = Index 4 let magenta = Index 5 let cyan = Index 6 let white = Index 7 let lblack = Index 8 let lred = Index 9 let lgreen = Index 10 let lyellow = Index 11 let lblue = Index 12 let lmagenta = Index 13 let lcyan = Index 14 let lwhite = Index 15 (* +-----------------------------------------------------------------+ | Styles | +-----------------------------------------------------------------+ *) type t = { bold : bool option; underline : bool option; blink : bool option; reverse : bool option; foreground : color option; background : color option; } let bold s = s.bold let underline s = s.underline let blink s = s.blink let reverse s = s.reverse let foreground s = s.foreground let background s = s.background let none = { bold = None; underline = None; blink = None; reverse = None; foreground = None; background = None; } let merge_field f1 f2 = match f2 with | Some _ -> f2 | None -> f1 let merge s1 s2 = { bold = merge_field s1.bold s2.bold; underline = merge_field s1.underline s2.underline; blink = merge_field s1.blink s2.blink; reverse = merge_field s1.reverse s2.reverse; foreground = merge_field s1.foreground s2.foreground; background = merge_field s1.background s2.background; } let bool = function | Some b -> b | None -> false let color = function | Some c -> c | None -> Default let equal s1 s2 = (bool s1.bold = bool s2.bold) && (bool s1.underline = bool s2.underline) && (bool s1.blink = bool s2.blink) && (bool s1.reverse = bool s2.reverse) && (color s1.foreground = color s2.foreground) && (color s1.background = color s2.background) lambda-term-3.1.0/src/lTerm_style.mli000066400000000000000000000034541366433625400175170ustar00rootroot00000000000000(* * lTerm_style.mli * --------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Text styles *) (** {6 Colors} *) type color = private | Default (** The default color of the terminal. *) | Index of int (** A color given by its index. Most terminal have at least 8 colors. *) | RGB of int * int * int (** A color given by its three component between 0 and 255. The closest color will be used. *) val default : color val index : int -> color val rgb : int -> int -> int -> color (** [rgb r g b] raises [Invalid_argument] if one of [r], [g] or [b] is not in the range [0..255]. *) (** {8 Standard colors} *) val black : color val red : color val green : color val yellow : color val blue : color val magenta : color val cyan : color val white : color (** {8 Light colors} *) val lblack : color val lred : color val lgreen : color val lyellow : color val lblue : color val lmagenta : color val lcyan : color val lwhite : color (** {6 Styles} *) (** Type of text styles. *) type t = { bold : bool option; underline : bool option; blink : bool option; reverse : bool option; foreground : color option; background : color option; } val bold : t -> bool option val underline : t -> bool option val blink : t -> bool option val reverse : t -> bool option val foreground : t -> color option val background : t -> color option val none : t (** Style with all fields set to [None]. *) val merge : t -> t -> t (** [merge s1 s2] is [s2] with all undefined fields set to ones of [s1]. *) val equal : t -> t -> bool (** [equal s1 s2] returns [true] iff [s1] and [s2] are equal after having replaced all [None] fields by [Some false] or [Some Default]. *) lambda-term-3.1.0/src/lTerm_term_stubs.c000066400000000000000000000053421366433625400202050ustar00rootroot00000000000000/* * lTerm_term_stubs.c * ------------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. */ #include #include #include #include #if defined(_WIN32) || defined(_WIN64) /* +-----------------------------------------------------------------+ | Terminal sizes on Windows | +-----------------------------------------------------------------+ */ #include #include CAMLprim value lt_term_get_size_from_fd(value fd) { CONSOLE_SCREEN_BUFFER_INFO info; value result; if (!GetConsoleScreenBufferInfo(Handle_val(fd), &info)) { win32_maperr(GetLastError()); uerror("GetConsoleScreenBufferInfo", Nothing); } result = caml_alloc_tuple(2); Field(result, 0) = Val_int(info.srWindow.Bottom - info.srWindow.Top + 1); Field(result, 1) = Val_int(info.srWindow.Right - info.srWindow.Left + 1); return result; } CAMLprim value lt_term_set_size_from_fd(value fd, value val_size) { CONSOLE_SCREEN_BUFFER_INFO info; SMALL_RECT rect; if (!GetConsoleScreenBufferInfo(Handle_val(fd), &info)) { win32_maperr(GetLastError()); uerror("GetConsoleScreenBufferInfo", Nothing); } rect; rect.Top = info.srWindow.Top; rect.Left = info.srWindow.Left; rect.Bottom = rect.Top + Int_val(Field(val_size, 0)) - 1; rect.Right = rect.Left + Int_val(Field(val_size, 1)) - 1; if (!SetConsoleWindowInfo(Handle_val(fd), TRUE, &rect)) { win32_maperr(GetLastError()); uerror("SetConsoleWindowInfo", Nothing); } return Val_unit; } #else /* +-----------------------------------------------------------------+ | Terminal sizes on Unix | +-----------------------------------------------------------------+ */ #include #include #include #include CAMLprim value lt_term_get_size_from_fd(value fd) { struct winsize size; if (ioctl(Int_val(fd), TIOCGWINSZ, &size) < 0) uerror("ioctl", Nothing); value result = caml_alloc_tuple(2); Field(result, 0) = Val_int(size.ws_row); Field(result, 1) = Val_int(size.ws_col); return result; } CAMLprim value lt_term_set_size_from_fd(value fd, value val_size) { struct winsize size; if (ioctl(Int_val(fd), TIOCGWINSZ, &size) < 0) uerror("ioctl", Nothing); int row = Int_val(Field(val_size, 0)); int col = Int_val(Field(val_size, 1)); size.ws_xpixel = size.ws_xpixel * col / size.ws_col; size.ws_ypixel = size.ws_ypixel * row / size.ws_row; size.ws_row = row; size.ws_col = col; if (ioctl(Int_val(fd), TIOCSWINSZ, &size) < 0) uerror("ioctl", Nothing); return Val_unit; } #endif lambda-term-3.1.0/src/lTerm_text.ml000066400000000000000000000003221366433625400171610ustar00rootroot00000000000000(* * lTerm_widget.ml * --------------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) include LTerm_text_impl.Make(LiteralIntf.UTF8) lambda-term-3.1.0/src/lTerm_text.mli000066400000000000000000000077241366433625400173470ustar00rootroot00000000000000(* * lTerm_text.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Styled text. *) type t = (Zed_char.t * LTerm_style.t) array (** Type of a string with styles for each characters. *) (***) val aval_width : Zed_string.width -> int (** {6 Conversions} *) val of_string : Zed_string.t -> t (** Creates a styled string from a string. All characters of the string have no style. *) val to_string : t -> Zed_string.t (** Returns the string part of a styled string. *) val of_utf8 : string -> t (** Creates a styled string from a utf8 string. All characters of the string have no style. *) val of_string_maybe_invalid : Zed_string.t -> t (** Creates a styled string from a Zed_string. All characters of the string have no style. The string may contain invalid sequences, in which case invalid bytes are escaped with the syntax [\yXX]. *) val of_utf8_maybe_invalid : string -> t (** Creates a styled string from a string. All characters of the string have no style. The string may contain invalid UTF-8 sequences, in which case invalid bytes are escaped with the syntax [\yXX]. *) val of_rope : Zed_rope.t -> t (** Creates a styled string from a rope. *) val to_rope : t -> Zed_rope.t (** Returns the string part of a styled string as a rope. *) val stylise : string -> LTerm_style.t -> t (** [stylise string style] creates a styled string with all styles set to [style]. *) (** {6 Parenthesis matching} *) val stylise_parenthesis : t -> ?paren : (Zed_char.t * Zed_char.t) list -> int -> LTerm_style.t -> unit (** [stylise_parenthesis text ?paren pos style] searchs for parenthesis group starting or ending at [pos] and apply them the style [style]. [paren] is the list of parenthesis recognized. *) (** {6 Markup strings} *) (** Markup strings are used to conveniently define styled strings. *) (** Type of an item in a markup string. *) type item = | S of Zed_utf8.t (** A UTF-8 encoded string. *) | R of Zed_rope.t (** A rope. *) | B_bold of bool (** Begins bold mode. *) | E_bold (** Ends bold mode. *) | B_underline of bool (** Begins underlined mode. *) | E_underline (** Ends underlined mode. *) | B_blink of bool (** Begins blinking mode. *) | E_blink (** Ends blinking mode. *) | B_reverse of bool (** Begins reverse video mode. *) | E_reverse (** Ends reverse video mode. *) | B_fg of LTerm_style.color (** Begins foreground color. *) | E_fg (** Ends foreground color. *) | B_bg of LTerm_style.color (** Begins background color. *) | E_bg (** Ends background color. *) type markup = item list (** Type of a markup string. *) val eval : markup -> t (** [eval makrup] evaluates a markup strings as a styled string. *) (** {6 Styled formatters} *) val make_formatter : ?read_color:(Format.tag -> LTerm_style.t) -> unit -> (unit -> t) * Format.formatter (** Create a formatter on a styled string. Returns a tuple [get_content, fmt]. Calling [get_content ()] will flush the formatter and output the resulting styled string. If a [read_color] function is provided, Format's tag are enabled and [read_color] is used to transform tags into styles. *) val pp_with_style : (LTerm_style.t -> Format.tag) -> (LTerm_style.t -> ('b, Format.formatter, unit, unit) format4 -> Format.formatter -> 'b) (** [pp_with_style f] will create a pretty printer analogous to {!stylise}, using f to encode style into tags. Will only work on a formatter with tag enabled. *) val styprintf : ?read_color:(Format.tag -> LTerm_style.t) -> ('a, Format.formatter, unit, t) format4 -> 'a (** Equivalent of {!Format.sprintf} for styled strings. *) val kstyprintf : ?read_color:(Format.tag -> LTerm_style.t) -> (t -> 'a) -> ('b, Format.formatter, unit, 'a) format4 -> 'b (** Equivalent of {!Format.ksprintf} for styled strings. *) lambda-term-3.1.0/src/lTerm_text_impl.ml000066400000000000000000000313071366433625400202110ustar00rootroot00000000000000(* * lTerm_text.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) module Make (LiteralIntf: LiteralIntf.Type) = struct open CamomileLibraryDefault.Camomile open LTerm_style open Result type t = (Zed_char.t * LTerm_style.t) array (* +-----------------------------------------------------------------+ | Conversions | +-----------------------------------------------------------------+ *) let dummy = (Zed_char.unsafe_of_char ' ', LTerm_style.none) let of_string str= Array.map (fun chr-> (chr, LTerm_style.none)) (Array.of_list (Zed_string.unsafe_explode str)) let aval_width= function | Ok {Zed_string.len=_;width}-> width | Error {Zed_string.start=_;len=_;width}-> width let of_utf8 str= let str= Zed_string.unsafe_of_utf8 str in of_string str (*let rec invalid_length str ofs acc = let ofs, len, _ = Zed_utf8.next_error str ofs in if ofs = String.length str then acc + len else invalid_length str (ofs + 1) (acc + len + 4)*) let uchar_of_hex x = if x < 10 then UChar.of_int (Char.code '0' + x) else UChar.of_int (Char.code 'a' + x - 10) let of_string_maybe_invalid str= let len= Zed_string.length str in let arr= Array.make len dummy in let rec loop ofs idx= if idx = len then arr else begin let ofs, idx= try let chr, ofs= Zed_string.extract_next str ofs in Array.unsafe_set arr idx (chr, LTerm_style.none); (ofs, idx + 1) with Zed_utf8.Invalid _-> let code= UChar.int_of (Zed_char.core (Zed_string.extract str ofs)) in Array.unsafe_set arr (idx + 0) (Zed_char.unsafe_of_char '\\', LTerm_style.none); Array.unsafe_set arr (idx + 1) (Zed_char.unsafe_of_char 'y', LTerm_style.none); Array.unsafe_set arr (idx + 2) (Zed_char.unsafe_of_uChar (uchar_of_hex (code lsr 4)) , LTerm_style.none); Array.unsafe_set arr (idx + 3) (Zed_char.unsafe_of_uChar (uchar_of_hex (code land 15)) , LTerm_style.none); ofs + 1, idx + 4 in loop ofs idx end in loop 0 0 let of_utf8_maybe_invalid str= let str= Zed_string.unsafe_of_utf8 str in of_string_maybe_invalid str let to_string txt = Zed_string.init (Array.length txt) (fun i-> fst txt.(i)) let of_rope rope = let arr = Array.make (Zed_rope.length rope) dummy in let rec loop zip idx= if Zed_rope.Zip.at_eos zip then arr else begin let chr, zip = Zed_rope.Zip.next zip in Array.unsafe_set arr idx (chr, LTerm_style.none); loop zip (idx + 1) end in loop (Zed_rope.Zip.make_f rope 0) 0 let to_rope txt = let buf = Zed_rope.Buffer.create () in Array.iter (fun (ch, _style) -> Zed_rope.Buffer.add buf ch) txt; Zed_rope.Buffer.contents buf let stylise str style = let str= Zed_string.unsafe_of_utf8 str in Array.map (fun chr-> (chr, style)) (Array.of_list (Zed_string.explode str)) (* +-----------------------------------------------------------------+ | Parenthesis matching | +-----------------------------------------------------------------+ *) let lparen = Zed_char.unsafe_of_char '(' let rparen = Zed_char.unsafe_of_char ')' let lbrace = Zed_char.unsafe_of_char '{' let rbrace = Zed_char.unsafe_of_char '}' let lbracket = Zed_char.unsafe_of_char '[' let rbracket = Zed_char.unsafe_of_char ']' type search_result = | No_match_found | No_paren_found | Match_found of int let stylise_parenthesis text ?(paren = [(lparen, rparen); (lbrace, rbrace); (lbracket, rbracket)]) pos style_paren = if Array.length text > 0 then begin let rec rsearch idx left right depth = if idx >= Array.length text then No_match_found else let ch, _ = text.(idx) in if ch = right then if depth = 0 then Match_found idx else rsearch (idx + 1) left right (depth - 1) else if ch = left then rsearch (idx + 1) left right (depth + 1) else rsearch (idx + 1) left right depth in let rec lsearch idx left right depth = if idx < 0 then No_match_found else let ch, _ = text.(idx) in if ch = left then if depth = 0 then Match_found idx else lsearch (idx - 1) left right (depth - 1) else if ch = right then lsearch (idx - 1) left right (depth + 1) else lsearch (idx - 1) left right depth in let found = if pos = Array.length text then false else let ch, _ = text.(pos) in let rec loop = function | [] -> No_paren_found | (lparen, rparen) :: rest -> if ch = lparen then rsearch (pos + 1) lparen rparen 0 else if ch = rparen then lsearch (pos - 1) lparen rparen 0 else loop rest in match loop paren with | Match_found idx -> let ch, style = text.(idx) in text.(idx) <- (ch, LTerm_style.merge style_paren style); true | No_match_found -> true | No_paren_found -> false in if not found && pos > 0 then let ch, style = text.(pos - 1) in let rec loop = function | [] -> No_paren_found | (lparen, rparen) :: rest -> if ch = lparen then rsearch (pos + 1) lparen rparen 0 else if ch = rparen then lsearch (pos - 2) lparen rparen 0 else loop rest in match loop paren with | Match_found idx -> text.(pos - 1) <- (ch, LTerm_style.merge style_paren style); let ch, style = text.(idx) in text.(idx) <- (ch, LTerm_style.merge style_paren style) | No_match_found | No_paren_found -> () end (* +-----------------------------------------------------------------+ | Markup strings | +-----------------------------------------------------------------+ *) type item = | S of LiteralIntf.string_intf | R of Zed_rope.t | B_bold of bool | E_bold | B_underline of bool | E_underline | B_blink of bool | E_blink | B_reverse of bool | E_reverse | B_fg of LTerm_style.color | E_fg | B_bg of LTerm_style.color | E_bg type markup = item list type eval_stack = { mutable q_bold : bool option list; mutable q_underline : bool option list; mutable q_blink : bool option list; mutable q_reverse : bool option list; mutable q_fg : LTerm_style.color option list; mutable q_bg : LTerm_style.color option list; } let markup_length markup = let rec loop len = function | [] -> len | S str :: rest -> loop (len + Zed_string.length (LiteralIntf.to_string_exn str)) rest | R str :: rest -> loop (len + Zed_rope.length str) rest | _ :: rest -> loop len rest in loop 0 markup let eval markup = let state = { q_bold = []; q_underline = []; q_blink = []; q_reverse = []; q_fg = []; q_bg = []; } in let arr = Array.make (markup_length markup) dummy in let rec copy_string str ofs idx style = if ofs >= Zed_string.bytes str then idx else begin let chr, ofs= Zed_string.extract_next str ofs in Array.unsafe_set arr idx (chr, style); copy_string str ofs (idx + 1) style end in let rec copy_rope zip idx style = if Zed_rope.Zip.at_eos zip then idx else begin let chr, zip = Zed_rope.Zip.next zip in Array.unsafe_set arr idx (chr, style); copy_rope zip (idx + 1) style end in let rec loop idx style = function | [] -> arr | S str :: rest -> let str= LiteralIntf.to_string_exn str in loop (copy_string str 0 idx style) style rest | R str :: rest -> loop (copy_rope (Zed_rope.Zip.make_f str 0) idx style) style rest | B_bold status :: rest -> state.q_bold <- style.bold :: state.q_bold; loop idx { style with bold = Some status } rest | E_bold :: rest -> begin match state.q_bold with | [] -> loop idx style rest | save :: l -> state.q_bold <- l; loop idx { style with bold = save } rest end | B_underline status :: rest -> state.q_underline <- style.underline :: state.q_underline; loop idx { style with underline = Some status } rest | E_underline :: rest -> begin match state.q_underline with | [] -> loop idx style rest | save :: l -> state.q_underline <- l; loop idx { style with underline = save } rest end | B_blink status :: rest -> state.q_blink <- style.blink :: state.q_blink; loop idx { style with blink = Some status } rest | E_blink :: rest -> begin match state.q_blink with | [] -> loop idx style rest | save :: l -> state.q_blink <- l; loop idx { style with blink = save } rest end | B_reverse color :: rest -> state.q_reverse <- style.reverse :: state.q_reverse; loop idx { style with reverse = Some color } rest | E_reverse :: rest -> begin match state.q_reverse with | [] -> loop idx style rest | save :: l -> state.q_reverse <- l; loop idx { style with reverse = save } rest end | B_fg color :: rest -> state.q_fg <- style.foreground :: state.q_fg; loop idx { style with foreground = Some color } rest | E_fg :: rest -> begin match state.q_fg with | [] -> loop idx style rest | save :: l -> state.q_fg <- l; loop idx { style with foreground = save } rest end | B_bg color :: rest -> state.q_bg <- style.background :: state.q_bg; loop idx { style with background = Some color } rest | E_bg :: rest -> begin match state.q_bg with | [] -> loop idx style rest | save :: l -> state.q_bg <- l; loop idx { style with background = save } rest end in loop 0 none markup (** {6 Styled formatters} *) let make_formatter ?read_color () = let style = Stack.create () in let content = ref [||] in let get_style () = if Stack.is_empty style then LTerm_style.none else Stack.top style and pop_style () = if Stack.is_empty style then () else ignore (Stack.pop style) and push_style sty = if Stack.is_empty style then Stack.push sty style else Stack.push (LTerm_style.merge (Stack.top style) sty) style in let put s pos len = let s = String.sub s pos len in content := Array.append !content (stylise s (get_style ())) in let flush () = () in let fmt = Format.make_formatter put flush in let get_content () = Format.pp_print_flush fmt () ; !content in begin match read_color with | None -> () | Some f -> Format.pp_set_tags fmt true; Format.pp_set_formatter_tag_functions fmt { Format. mark_open_tag = (fun a -> push_style (f a) ; ""); mark_close_tag = (fun _ -> pop_style (); ""); print_open_tag = (fun _ -> ()); print_close_tag = (fun _ -> ()); }[@ocaml.warning "-3"] ; end ; get_content, fmt let pp_with_style to_style = fun style fstr fmt -> let tag = to_style style in (Format.pp_open_tag[@ocaml.warning "-3"]) fmt tag; Format.kfprintf (fun fmt -> Format.pp_close_tag fmt ()[@ocaml.warning "-3"]) fmt fstr let kstyprintf ?read_color f fstr = let get_content, fmt = make_formatter ?read_color () in Format.kfprintf (fun _ -> f (get_content ())) fmt fstr let styprintf ?read_color fstr = kstyprintf ?read_color (fun x -> x) fstr end lambda-term-3.1.0/src/lTerm_toplevel_impl.ml000066400000000000000000000123031366433625400210520ustar00rootroot00000000000000open LTerm_geom open LTerm_key class t = LTerm_widget_base_impl.t (* About focus; widgets may specify an optional target widget in each direction. The focus specification is intepreted in two ways based on can_focus. can_focus=true If the currently focussed widget has a focus specification in the required direction that widget is jumped to. Otherwise a search is performed. can_focus=false Widgets with can_focus=false will never be the current focus, however, they can take part in search for a widget. When we search over such a widget, if it has an appropriate focus specification then we jump there. *) let get_focus x dir = let f = function None -> `none | Some(x) -> `set_focus(x) in match dir with | `left -> f x.left | `right -> f x.right | `up -> f x.up | `down -> f x.down let make_widget_matrix root dir = let { rows; cols } = LTerm_geom.size_of_rect root#allocation in let m = Array.make_matrix rows cols `none in let rec loop widget = let set rect widget = if widget <> `none then begin for r = rect.row1 to rect.row2 - 1 do for c = rect.col1 to rect.col2 - 1 do m.(r).(c) <- widget done done end in if widget#can_focus then begin set widget#allocation (`can_focus widget) end else begin set widget#allocation (get_focus widget#focus dir) end; List.iter loop widget#children in loop root; m let left coord = { coord with col = pred coord.col } let right coord = { coord with col = succ coord.col } let up coord = { coord with row = pred coord.row } let down coord = { coord with row = succ coord.row } let focus_to (dir,incr_dir) f root focused coord = let get_coord widget = let rect = widget#allocation in { col = (rect.col1 + rect.col2) / 2; row = (rect.row1 + rect.row2) / 2 } in match get_focus focused#focus dir with | `set_focus(widget) -> (* If the currently focused widget has a focus specification for the given direction jump directly to that widget *) Some(widget, get_coord widget) | `none -> (* Otherwise project a line in the appropriate direction until we hit a widget. *) let rect = root#allocation in let m = make_widget_matrix root dir in let rec loop coord = if coord.row < rect.row1 || coord.row >= rect.row2 || coord.col < rect.col1 || coord.col >= rect.col2 then None else match m.(coord.row).(coord.col) with | `none -> loop (incr_dir coord) | `can_focus widget when widget = focused -> loop (incr_dir coord) | `can_focus widget -> let rect = widget#allocation in Some (widget, f rect coord) | `set_focus widget -> (* note; this allows widget=focused, if specified *) Some (widget, get_coord widget) in loop coord let avg_col rect coord = { coord with col = (rect.col1 + rect.col2) / 2 } let avg_row rect coord = { coord with row = (rect.row1 + rect.row2) / 2 } let focus_left (* root focused coord *) = focus_to (`left,left) avg_col let focus_right (* root focused coord *) = focus_to (`right,right) avg_col let focus_up (* root focused coord *) = focus_to (`up,up) avg_row let focus_down (* root focused coord *) = focus_to (`down,down) avg_row class toplevel focused widget = object(self) inherit t "toplevel" as super val children = [widget] method! children = children method! draw ctx focused = widget#draw ctx focused val mutable coord = { row = 0; col = 0 } (* Coordinates of the cursor inside the screen. *) val mutable push_layer_handler = Lwt_react.E.never; val mutable pop_layer_handler = Lwt_react.E.never; method arm_layer_handlers (push_event : t Lwt_react.event) (push_handler : t -> unit) (pop_event : unit Lwt_react.event) (pop_handler : unit -> unit) = let open Lwt_react in push_layer_handler <- E.map push_handler push_event; pop_layer_handler <- E.map pop_handler pop_event method! set_allocation rect = super#set_allocation rect; widget#set_allocation rect; let rect = !focused#allocation in coord <- { row = (rect.row1 + rect.row2) / 2; col = (rect.col1 + rect.col2) / 2 } method move_focus_to = function | Some (widget, c) -> coord <- c; focused := widget; self#queue_draw | None -> () method private move_focus direction = self#move_focus_to @@ direction (self :> t) !focused coord method private process_arrows = function | LTerm_event.Key { control = false; meta = false; shift = false; code = Left } -> self#move_focus focus_left; true | LTerm_event.Key { control = false; meta = false; shift = false; code = Right } -> self#move_focus focus_right; true | LTerm_event.Key { control = false; meta = false; shift = false; code = Up } -> self#move_focus focus_up; true | LTerm_event.Key { control = false; meta = false; shift = false; code = Down } -> self#move_focus focus_down; true | _ -> false initializer widget#set_parent (Some (self :> t)); self#on_event self#process_arrows end lambda-term-3.1.0/src/lTerm_ui.ml000066400000000000000000000131531366433625400166200ustar00rootroot00000000000000(* * lTerm_ui.ml * ----------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open LTerm_geom let return, (>>=) = Lwt.return, Lwt.(>>=) (* +-----------------------------------------------------------------+ | The UI type | +-----------------------------------------------------------------+ *) (* State of an UI. *) type state = | Init (* The UI has not yet been drawn. *) | Loop (* The UI is running. *) | Stop (* The UI has been stopped. *) type t = { term : LTerm.t; (* The terminal used for the UI. *) draw : t -> LTerm_draw.matrix -> unit; (* The draw function. *) mode : LTerm.mode; (* The previous mode of the terminal. *) mutable state : state; (* State of the UI. *) restore_state : bool; (* Whether to restore the state of the terminal when quiting. *) mutable size : LTerm_geom.size; (* The current size of the UI. *) mutable matrix_a : LTerm_draw.matrix; mutable matrix_b : LTerm_draw.matrix; (* The two matrices used for the rendering. *) mutable cursor_visible : bool; (* The cursor visible state. *) mutable cursor_position : LTerm_geom.coord; (* The cursor position. *) mutable draw_queued : bool; (* Is a draw operation queued ? *) mutable drawer : unit Lwt.t; (* The thread drawing the terminal. *) mutable drawing : bool; (* Are we drawing ? *) draw_error_push : exn option -> unit; draw_error_stream : exn Lwt_stream.t; (* Stream used to send drawing error to [loop]. *) } let check ui = if ui.state = Stop then failwith "The has been quited" (* +-----------------------------------------------------------------+ | Creation/quiting | +-----------------------------------------------------------------+ *) let create term ?(save_state = true) draw = LTerm.enter_raw_mode term >>= fun mode -> (if save_state then LTerm.save_state term else return ()) >>= fun () -> let stream, push = Lwt_stream.create () in return { term = term; draw = draw; mode = mode; state = Init; restore_state = save_state; size = LTerm.size term; matrix_a = [||]; matrix_b = [||]; cursor_visible = false; cursor_position = { row = 0; col = 0 }; draw_queued = false; drawer = return (); drawing = false; draw_error_push = push; draw_error_stream = stream; } let quit ui = check ui; ui.state <- Stop; ui.drawer >>= fun () -> LTerm.leave_raw_mode ui.term ui.mode >>= fun () -> if ui.restore_state then LTerm.show_cursor ui.term >>= fun () -> LTerm.load_state ui.term else return () (* +-----------------------------------------------------------------+ | Drawing | +-----------------------------------------------------------------+ *) let immediate_draw ui = fun () -> Lwt.catch (fun () -> (* Wait a bit in order not to redraw too often. *) Lwt.pause () >>= fun () -> ui.draw_queued <- false; if ui.state = Stop then return () else begin (* Allocate the first matrix if needed. *) if ui.matrix_a = [||] then ui.matrix_a <- LTerm_draw.make_matrix ui.size; (* Draw the screen *) ui.drawing <- true; (try ui.draw ui ui.matrix_a with exn -> ui.drawing <- false; raise exn); ui.drawing <- false; (* Rendering. *) LTerm.hide_cursor ui.term >>= fun () -> LTerm.render_update ui.term ui.matrix_b ui.matrix_a >>= fun () -> begin if ui.cursor_visible then LTerm.goto ui.term ui.cursor_position >>= fun () -> LTerm.show_cursor ui.term else return () end >>= fun () -> LTerm.flush ui.term >>= fun () -> (* Swap the two matrices. *) let a = ui.matrix_a and b = ui.matrix_b in ui.matrix_a <- b; ui.matrix_b <- a; return () end) (fun exn -> ui.draw_error_push (Some exn); return ()) let draw ui = check ui; ui.state <- Loop; (* If a draw operation is already queued, do nothing. *) if not ui.draw_queued then (* Wait for draw operation to finish before starting new one *) ui.drawer <- ui.drawer >>= immediate_draw ui (* +-----------------------------------------------------------------+ | Accessors | +-----------------------------------------------------------------+ *) let size ui = check ui; ui.size let cursor_visible ui = check ui; ui.cursor_visible let set_cursor_visible ui state = check ui; if state <> ui.cursor_visible then begin ui.cursor_visible <- state; if ui.state = Loop && not ui.drawing then draw ui end let cursor_position ui = check ui; ui.cursor_position let set_cursor_position ui coord = check ui; if coord <> ui.cursor_position then begin ui.cursor_position <- coord; if ui.state = Loop && not ui.drawing then draw ui end (* +-----------------------------------------------------------------+ | Loop | +-----------------------------------------------------------------+ *) let wait ui = check ui; if ui.state = Init then draw ui; Lwt.pick [LTerm.read_event ui.term; Lwt_stream.next ui.draw_error_stream >>= Lwt.fail] >>= fun ev -> match ev with | LTerm_event.Resize size -> ui.size <- size; (* New size, discard current matrices. *) ui.matrix_a <- [||]; ui.matrix_b <- [||]; draw ui; return ev | _ -> return ev lambda-term-3.1.0/src/lTerm_ui.mli000066400000000000000000000030041366433625400167630ustar00rootroot00000000000000(* * lTerm_ui.mli * ------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** High level function for writing full-screen applications *) type t (** Type of a user interface. *) val create : LTerm.t -> ?save_state : bool -> (t -> LTerm_draw.matrix -> unit) -> t Lwt.t (** [create term ?save_state draw] creates a new user interface. [draw] is used to draw the user interface. If [save_state] is [true] (the default) then the state of the terminal is saved. *) val quit : t -> unit Lwt.t (** [quit ()] quit the given ui and restore the terminal state. *) val size : t -> LTerm_geom.size (** [size ui] returns the current size of the terminal used by the given user-interface. It is updated by {!wait}. *) val draw : t -> unit (** [draw ui] enqueue a draw operation for the given UI. *) val cursor_visible : t -> bool (** [cursor_visible ui] returns [true] if the cursor is displayed in the UI. It is initially not visible. *) val set_cursor_visible : t -> bool -> unit (** [set_cursor_visible ui visible] sets the cursor visible state. *) val cursor_position : t -> LTerm_geom.coord (** [cursor_position ui] returns the position of the cursor inside the UI. *) val set_cursor_position : t -> LTerm_geom.coord -> unit (** [set_cursor_position ui coord] sets the position of the cursor inside the UI. *) val wait : t -> LTerm_event.t Lwt.t (** [wait ui] wait for an event. *) lambda-term-3.1.0/src/lTerm_unix.ml000066400000000000000000001222641366433625400171720ustar00rootroot00000000000000(* * lTerm_unix.ml * ------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile open LTerm_key let return, (>>=), (>|=) = Lwt.return, Lwt.(>>=), Lwt.(>|=) external get_sigwinch : unit -> int option = "lt_unix_get_sigwinch" external get_system_encoding : unit -> string = "lt_unix_get_system_encoding" let sigwinch = get_sigwinch () (* Obtained by running the folliwing makefile in the "localedata" directory of the glibc: {[ include SUPPORTED all: @echo $(SUPPORTED-LOCALES) | sed 's/ /\n/g' | awk -F/ '$$1 ~ /[.]/ { next; }; { print " | \""$$1"\" -> \""$$2"\"" }' ]} *) let encoding_of_lang = function | "aa_DJ" -> "ISO-8859-1" | "aa_ER" -> "UTF-8" | "aa_ER@saaho" -> "UTF-8" | "aa_ET" -> "UTF-8" | "af_ZA" -> "ISO-8859-1" | "am_ET" -> "UTF-8" | "an_ES" -> "ISO-8859-15" | "ar_AE" -> "ISO-8859-6" | "ar_BH" -> "ISO-8859-6" | "ar_DZ" -> "ISO-8859-6" | "ar_EG" -> "ISO-8859-6" | "ar_IN" -> "UTF-8" | "ar_IQ" -> "ISO-8859-6" | "ar_JO" -> "ISO-8859-6" | "ar_KW" -> "ISO-8859-6" | "ar_LB" -> "ISO-8859-6" | "ar_LY" -> "ISO-8859-6" | "ar_MA" -> "ISO-8859-6" | "ar_OM" -> "ISO-8859-6" | "ar_QA" -> "ISO-8859-6" | "ar_SA" -> "ISO-8859-6" | "ar_SD" -> "ISO-8859-6" | "ar_SY" -> "ISO-8859-6" | "ar_TN" -> "ISO-8859-6" | "ar_YE" -> "ISO-8859-6" | "az_AZ" -> "UTF-8" | "as_IN" -> "UTF-8" | "ast_ES" -> "ISO-8859-15" | "be_BY" -> "CP1251" | "be_BY@latin" -> "UTF-8" | "bem_ZM" -> "UTF-8" | "ber_DZ" -> "UTF-8" | "ber_MA" -> "UTF-8" | "bg_BG" -> "CP1251" | "bn_BD" -> "UTF-8" | "bn_IN" -> "UTF-8" | "bo_CN" -> "UTF-8" | "bo_IN" -> "UTF-8" | "br_FR" -> "ISO-8859-1" | "br_FR@euro" -> "ISO-8859-15" | "bs_BA" -> "ISO-8859-2" | "byn_ER" -> "UTF-8" | "ca_AD" -> "ISO-8859-15" | "ca_ES" -> "ISO-8859-1" | "ca_ES@euro" -> "ISO-8859-15" | "ca_FR" -> "ISO-8859-15" | "ca_IT" -> "ISO-8859-15" | "crh_UA" -> "UTF-8" | "cs_CZ" -> "ISO-8859-2" | "csb_PL" -> "UTF-8" | "cv_RU" -> "UTF-8" | "cy_GB" -> "ISO-8859-14" | "da_DK" -> "ISO-8859-1" | "de_AT" -> "ISO-8859-1" | "de_AT@euro" -> "ISO-8859-15" | "de_BE" -> "ISO-8859-1" | "de_BE@euro" -> "ISO-8859-15" | "de_CH" -> "ISO-8859-1" | "de_DE" -> "ISO-8859-1" | "de_DE@euro" -> "ISO-8859-15" | "de_LU" -> "ISO-8859-1" | "de_LU@euro" -> "ISO-8859-15" | "dv_MV" -> "UTF-8" | "dz_BT" -> "UTF-8" | "el_GR" -> "ISO-8859-7" | "el_CY" -> "ISO-8859-7" | "en_AG" -> "UTF-8" | "en_AU" -> "ISO-8859-1" | "en_BW" -> "ISO-8859-1" | "en_CA" -> "ISO-8859-1" | "en_DK" -> "ISO-8859-1" | "en_GB" -> "ISO-8859-1" | "en_HK" -> "ISO-8859-1" | "en_IE" -> "ISO-8859-1" | "en_IE@euro" -> "ISO-8859-15" | "en_IN" -> "UTF-8" | "en_NG" -> "UTF-8" | "en_NZ" -> "ISO-8859-1" | "en_PH" -> "ISO-8859-1" | "en_SG" -> "ISO-8859-1" | "en_US" -> "ISO-8859-1" | "en_ZA" -> "ISO-8859-1" | "en_ZM" -> "UTF-8" | "en_ZW" -> "ISO-8859-1" | "es_AR" -> "ISO-8859-1" | "es_BO" -> "ISO-8859-1" | "es_CL" -> "ISO-8859-1" | "es_CO" -> "ISO-8859-1" | "es_CR" -> "ISO-8859-1" | "es_DO" -> "ISO-8859-1" | "es_EC" -> "ISO-8859-1" | "es_ES" -> "ISO-8859-1" | "es_ES@euro" -> "ISO-8859-15" | "es_GT" -> "ISO-8859-1" | "es_HN" -> "ISO-8859-1" | "es_MX" -> "ISO-8859-1" | "es_NI" -> "ISO-8859-1" | "es_PA" -> "ISO-8859-1" | "es_PE" -> "ISO-8859-1" | "es_PR" -> "ISO-8859-1" | "es_PY" -> "ISO-8859-1" | "es_SV" -> "ISO-8859-1" | "es_US" -> "ISO-8859-1" | "es_UY" -> "ISO-8859-1" | "es_VE" -> "ISO-8859-1" | "et_EE" -> "ISO-8859-1" | "eu_ES" -> "ISO-8859-1" | "eu_ES@euro" -> "ISO-8859-15" | "fa_IR" -> "UTF-8" | "ff_SN" -> "UTF-8" | "fi_FI" -> "ISO-8859-1" | "fi_FI@euro" -> "ISO-8859-15" | "fil_PH" -> "UTF-8" | "fo_FO" -> "ISO-8859-1" | "fr_BE" -> "ISO-8859-1" | "fr_BE@euro" -> "ISO-8859-15" | "fr_CA" -> "ISO-8859-1" | "fr_CH" -> "ISO-8859-1" | "fr_FR" -> "ISO-8859-1" | "fr_FR@euro" -> "ISO-8859-15" | "fr_LU" -> "ISO-8859-1" | "fr_LU@euro" -> "ISO-8859-15" | "fur_IT" -> "UTF-8" | "fy_NL" -> "UTF-8" | "fy_DE" -> "UTF-8" | "ga_IE" -> "ISO-8859-1" | "ga_IE@euro" -> "ISO-8859-15" | "gd_GB" -> "ISO-8859-15" | "gez_ER" -> "UTF-8" | "gez_ER@abegede" -> "UTF-8" | "gez_ET" -> "UTF-8" | "gez_ET@abegede" -> "UTF-8" | "gl_ES" -> "ISO-8859-1" | "gl_ES@euro" -> "ISO-8859-15" | "gu_IN" -> "UTF-8" | "gv_GB" -> "ISO-8859-1" | "ha_NG" -> "UTF-8" | "he_IL" -> "ISO-8859-8" | "hi_IN" -> "UTF-8" | "hne_IN" -> "UTF-8" | "hr_HR" -> "ISO-8859-2" | "hsb_DE" -> "ISO-8859-2" | "ht_HT" -> "UTF-8" | "hu_HU" -> "ISO-8859-2" | "hy_AM" -> "UTF-8" | "id_ID" -> "ISO-8859-1" | "ig_NG" -> "UTF-8" | "ik_CA" -> "UTF-8" | "is_IS" -> "ISO-8859-1" | "it_CH" -> "ISO-8859-1" | "it_IT" -> "ISO-8859-1" | "it_IT@euro" -> "ISO-8859-15" | "iu_CA" -> "UTF-8" | "iw_IL" -> "ISO-8859-8" | "ka_GE" -> "GEORGIAN-PS" | "kk_KZ" -> "PT154" | "kl_GL" -> "ISO-8859-1" | "km_KH" -> "UTF-8" | "kn_IN" -> "UTF-8" | "kok_IN" -> "UTF-8" | "ks_IN" -> "UTF-8" | "ks_IN@devanagari" -> "UTF-8" | "ku_TR" -> "ISO-8859-9" | "kw_GB" -> "ISO-8859-1" | "ky_KG" -> "UTF-8" | "lb_LU" -> "UTF-8" | "lg_UG" -> "ISO-8859-10" | "li_BE" -> "UTF-8" | "li_NL" -> "UTF-8" | "lij_IT" -> "UTF-8" | "lo_LA" -> "UTF-8" | "lt_LT" -> "ISO-8859-13" | "lv_LV" -> "ISO-8859-13" | "mai_IN" -> "UTF-8" | "mg_MG" -> "ISO-8859-15" | "mhr_RU" -> "UTF-8" | "mi_NZ" -> "ISO-8859-13" | "mk_MK" -> "ISO-8859-5" | "ml_IN" -> "UTF-8" | "mn_MN" -> "UTF-8" | "mr_IN" -> "UTF-8" | "ms_MY" -> "ISO-8859-1" | "mt_MT" -> "ISO-8859-3" | "my_MM" -> "UTF-8" | "nan_TW@latin" -> "UTF-8" | "nb_NO" -> "ISO-8859-1" | "nds_DE" -> "UTF-8" | "nds_NL" -> "UTF-8" | "ne_NP" -> "UTF-8" | "nl_AW" -> "UTF-8" | "nl_BE" -> "ISO-8859-1" | "nl_BE@euro" -> "ISO-8859-15" | "nl_NL" -> "ISO-8859-1" | "nl_NL@euro" -> "ISO-8859-15" | "nn_NO" -> "ISO-8859-1" | "nr_ZA" -> "UTF-8" | "nso_ZA" -> "UTF-8" | "oc_FR" -> "ISO-8859-1" | "om_ET" -> "UTF-8" | "om_KE" -> "ISO-8859-1" | "or_IN" -> "UTF-8" | "os_RU" -> "UTF-8" | "pa_IN" -> "UTF-8" | "pa_PK" -> "UTF-8" | "pap_AN" -> "UTF-8" | "pl_PL" -> "ISO-8859-2" | "ps_AF" -> "UTF-8" | "pt_BR" -> "ISO-8859-1" | "pt_PT" -> "ISO-8859-1" | "pt_PT@euro" -> "ISO-8859-15" | "ro_RO" -> "ISO-8859-2" | "ru_RU" -> "ISO-8859-5" | "ru_UA" -> "KOI8-U" | "rw_RW" -> "UTF-8" | "sa_IN" -> "UTF-8" | "sc_IT" -> "UTF-8" | "sd_IN" -> "UTF-8" | "sd_IN@devanagari" -> "UTF-8" | "se_NO" -> "UTF-8" | "shs_CA" -> "UTF-8" | "si_LK" -> "UTF-8" | "sid_ET" -> "UTF-8" | "sk_SK" -> "ISO-8859-2" | "sl_SI" -> "ISO-8859-2" | "so_DJ" -> "ISO-8859-1" | "so_ET" -> "UTF-8" | "so_KE" -> "ISO-8859-1" | "so_SO" -> "ISO-8859-1" | "sq_AL" -> "ISO-8859-1" | "sq_MK" -> "UTF-8" | "sr_ME" -> "UTF-8" | "sr_RS" -> "UTF-8" | "sr_RS@latin" -> "UTF-8" | "ss_ZA" -> "UTF-8" | "st_ZA" -> "ISO-8859-1" | "sv_FI" -> "ISO-8859-1" | "sv_FI@euro" -> "ISO-8859-15" | "sv_SE" -> "ISO-8859-1" | "sw_KE" -> "UTF-8" | "sw_TZ" -> "UTF-8" | "ta_IN" -> "UTF-8" | "te_IN" -> "UTF-8" | "tg_TJ" -> "KOI8-T" | "th_TH" -> "TIS-620" | "ti_ER" -> "UTF-8" | "ti_ET" -> "UTF-8" | "tig_ER" -> "UTF-8" | "tk_TM" -> "UTF-8" | "tl_PH" -> "ISO-8859-1" | "tn_ZA" -> "UTF-8" | "tr_CY" -> "ISO-8859-9" | "tr_TR" -> "ISO-8859-9" | "ts_ZA" -> "UTF-8" | "tt_RU" -> "UTF-8" | "tt_RU@iqtelif" -> "UTF-8" | "ug_CN" -> "UTF-8" | "uk_UA" -> "KOI8-U" | "ur_PK" -> "UTF-8" | "uz_UZ" -> "ISO-8859-1" | "uz_UZ@cyrillic" -> "UTF-8" | "ve_ZA" -> "UTF-8" | "vi_VN" -> "UTF-8" | "wa_BE" -> "ISO-8859-1" | "wa_BE@euro" -> "ISO-8859-15" | "wae_CH" -> "UTF-8" | "wo_SN" -> "UTF-8" | "xh_ZA" -> "ISO-8859-1" | "yi_US" -> "CP1255" | "yo_NG" -> "UTF-8" | "yue_HK" -> "UTF-8" | "zh_CN" -> "GB2312" | "zh_HK" -> "BIG5-HKSCS" | "zh_SG" -> "GB2312" | "zh_TW" -> "BIG5" | "zu_ZA" -> "ISO-8859-1" | _ -> "ASCII" let system_encoding = match get_system_encoding () with | "" -> begin match try Some (Sys.getenv "LANG") with Not_found -> None with | None -> "ASCII" | Some lang -> match try Some (String.index lang '.') with Not_found -> None with | None -> encoding_of_lang lang | Some idx -> String.sub lang (idx + 1) (String.length lang - idx - 1) end | enc -> enc (* +-----------------------------------------------------------------+ | Parsing of encoded characters | +-----------------------------------------------------------------+ *) class output_single (cell : UChar.t option ref) = object method put char = cell := Some char method flush () = () method close_out () = () end let parse_char encoding st first_byte = let cell = ref None in let output = new CharEncoding.convert_uchar_output encoding (new output_single cell) in let rec loop st = match !cell with | Some char -> return char | None -> Lwt_stream.next st >>= fun byte -> assert (output#output (Bytes.make 1 byte) 0 1 = 1); output#flush (); loop st in Lwt.catch (fun () -> assert (output#output (Bytes.make 1 first_byte) 0 1 = 1); Lwt_stream.parse st loop) (function | CharEncoding.Malformed_code | Lwt_stream.Empty -> return (UChar.of_char first_byte) | exn -> Lwt.fail exn) (* +-----------------------------------------------------------------+ | Input of escape sequence | +-----------------------------------------------------------------+ *) exception Not_a_sequence let parse_escape escape_time st = let buf = Buffer.create 32 in (* Read one character and add it to [buf]: *) let get () = Lwt.pick [Lwt_stream.get st; Lwt_unix.sleep escape_time >>= fun () -> return None] >>= fun ch -> match ch with | None -> (* If the rest is not immediatly available, conclude that this is not an escape sequence but just the escape key: *) Lwt.fail Not_a_sequence | Some('\x00' .. '\x1f' | '\x80' .. '\xff') -> (* Control characters and non-ascii characters are not part of escape sequences. *) Lwt.fail Not_a_sequence | Some ch -> Buffer.add_char buf ch; return ch in let rec loop () = get () >>= function | '0' .. '9' | ';' | '[' -> loop () | _ -> return (Buffer.contents buf) in get () >>= function | '[' | 'O' -> loop () | _ -> Lwt.fail Not_a_sequence (* +-----------------------------------------------------------------+ | Escape sequences mapping | +-----------------------------------------------------------------+ *) let controls = [| Char(UChar.of_char ' '); Char(UChar.of_char 'a'); Char(UChar.of_char 'b'); Char(UChar.of_char 'c'); Char(UChar.of_char 'd'); Char(UChar.of_char 'e'); Char(UChar.of_char 'f'); Char(UChar.of_char 'g'); Char(UChar.of_char 'h'); Tab; Enter; Char(UChar.of_char 'k'); Char(UChar.of_char 'l'); Char(UChar.of_char 'm'); Char(UChar.of_char 'n'); Char(UChar.of_char 'o'); Char(UChar.of_char 'p'); Char(UChar.of_char 'q'); Char(UChar.of_char 'r'); Char(UChar.of_char 's'); Char(UChar.of_char 't'); Char(UChar.of_char 'u'); Char(UChar.of_char 'v'); Char(UChar.of_char 'w'); Char(UChar.of_char 'x'); Char(UChar.of_char 'y'); Char(UChar.of_char 'z'); Escape; Char(UChar.of_char '\\'); Char(UChar.of_char ']'); Char(UChar.of_char '^'); Char(UChar.of_char '_'); |] let sequences = [| "[1~", { control = false; meta = false; shift = false; code = Home }; "[2~", { control = false; meta = false; shift = false; code = Insert }; "[3~", { control = false; meta = false; shift = false; code = Delete }; "[4~", { control = false; meta = false; shift = false; code = End }; "[5~", { control = false; meta = false; shift = false; code = Prev_page }; "[6~", { control = false; meta = false; shift = false; code = Next_page }; "[7~", { control = false; meta = false; shift = false; code = Home }; "[8~", { control = false; meta = false; shift = false; code = End }; "[11~", { control = false; meta = false; shift = false; code = F1 }; "[12~", { control = false; meta = false; shift = false; code = F2 }; "[13~", { control = false; meta = false; shift = false; code = F3 }; "[14~", { control = false; meta = false; shift = false; code = F4 }; "[15~", { control = false; meta = false; shift = false; code = F5 }; "[17~", { control = false; meta = false; shift = false; code = F6 }; "[18~", { control = false; meta = false; shift = false; code = F7 }; "[19~", { control = false; meta = false; shift = false; code = F8 }; "[20~", { control = false; meta = false; shift = false; code = F9 }; "[21~", { control = false; meta = false; shift = false; code = F10 }; "[23~", { control = false; meta = false; shift = false; code = F11 }; "[24~", { control = false; meta = false; shift = false; code = F12 }; "[1^", { control = true; meta = false; shift = false; code = Home }; "[2^", { control = true; meta = false; shift = false; code = Insert }; "[3^", { control = true; meta = false; shift = false; code = Delete }; "[4^", { control = true; meta = false; shift = false; code = End }; "[5^", { control = true; meta = false; shift = false; code = Prev_page }; "[6^", { control = true; meta = false; shift = false; code = Next_page }; "[7^", { control = true; meta = false; shift = false; code = Home }; "[8^", { control = true; meta = false; shift = false; code = End }; "[11^", { control = true; meta = false; shift = false; code = F1 }; "[12^", { control = true; meta = false; shift = false; code = F2 }; "[13^", { control = true; meta = false; shift = false; code = F3 }; "[14^", { control = true; meta = false; shift = false; code = F4 }; "[15^", { control = true; meta = false; shift = false; code = F5 }; "[17^", { control = true; meta = false; shift = false; code = F6 }; "[18^", { control = true; meta = false; shift = false; code = F7 }; "[19^", { control = true; meta = false; shift = false; code = F8 }; "[20^", { control = true; meta = false; shift = false; code = F9 }; "[21^", { control = true; meta = false; shift = false; code = F10 }; "[23^", { control = true; meta = false; shift = false; code = F11 }; "[24^", { control = true; meta = false; shift = false; code = F12 }; "[1$", { control = false; meta = false; shift = true; code = Home }; "[2$", { control = false; meta = false; shift = true; code = Insert }; "[3$", { control = false; meta = false; shift = true; code = Delete }; "[4$", { control = false; meta = false; shift = true; code = End }; "[5$", { control = false; meta = false; shift = true; code = Prev_page }; "[6$", { control = false; meta = false; shift = true; code = Next_page }; "[7$", { control = false; meta = false; shift = true; code = Home }; "[8$", { control = false; meta = false; shift = true; code = End }; "[1@", { control = true; meta = false; shift = true; code = Home }; "[2@", { control = true; meta = false; shift = true; code = Insert }; "[3@", { control = true; meta = false; shift = true; code = Delete }; "[4@", { control = true; meta = false; shift = true; code = End }; "[5@", { control = true; meta = false; shift = true; code = Prev_page }; "[6@", { control = true; meta = false; shift = true; code = Next_page }; "[7@", { control = true; meta = false; shift = true; code = Home }; "[8@", { control = true; meta = false; shift = true; code = End }; "[25~", { control = false; meta = false; shift = true; code = F3 }; "[26~", { control = false; meta = false; shift = true; code = F4 }; "[28~", { control = false; meta = false; shift = true; code = F5 }; "[29~", { control = false; meta = false; shift = true; code = F6 }; "[31~", { control = false; meta = false; shift = true; code = F7 }; "[32~", { control = false; meta = false; shift = true; code = F8 }; "[33~", { control = false; meta = false; shift = true; code = F9 }; "[34~", { control = false; meta = false; shift = true; code = F10 }; "[23$", { control = false; meta = false; shift = true; code = F11 }; "[24$", { control = false; meta = false; shift = true; code = F12 }; "[25^", { control = true; meta = false; shift = true; code = F3 }; "[26^", { control = true; meta = false; shift = true; code = F4 }; "[28^", { control = true; meta = false; shift = true; code = F5 }; "[29^", { control = true; meta = false; shift = true; code = F6 }; "[31^", { control = true; meta = false; shift = true; code = F7 }; "[32^", { control = true; meta = false; shift = true; code = F8 }; "[33^", { control = true; meta = false; shift = true; code = F9 }; "[34^", { control = true; meta = false; shift = true; code = F10 }; "[23@", { control = true; meta = false; shift = true; code = F11 }; "[24@", { control = true; meta = false; shift = true; code = F12 }; "[Z", { control = false; meta = false; shift = true; code = Tab }; "[A", { control = false; meta = false; shift = false; code = Up }; "[B", { control = false; meta = false; shift = false; code = Down }; "[C", { control = false; meta = false; shift = false; code = Right }; "[D", { control = false; meta = false; shift = false; code = Left }; "[a", { control = false; meta = false; shift = true; code = Up }; "[b", { control = false; meta = false; shift = true; code = Down }; "[c", { control = false; meta = false; shift = true; code = Right }; "[d", { control = false; meta = false; shift = true; code = Left }; "A", { control = false; meta = false; shift = false; code = Up }; "B", { control = false; meta = false; shift = false; code = Down }; "C", { control = false; meta = false; shift = false; code = Right }; "D", { control = false; meta = false; shift = false; code = Left }; "OA", { control = false; meta = false; shift = false; code = Up }; "OB", { control = false; meta = false; shift = false; code = Down }; "OC", { control = false; meta = false; shift = false; code = Right }; "OD", { control = false; meta = false; shift = false; code = Left }; "Oa", { control = true; meta = false; shift = false; code = Up }; "Ob", { control = true; meta = false; shift = false; code = Down }; "Oc", { control = true; meta = false; shift = false; code = Right }; "Od", { control = true; meta = false; shift = false; code = Left }; "OP", { control = false; meta = false; shift = false; code = F1 }; "OQ", { control = false; meta = false; shift = false; code = F2 }; "OR", { control = false; meta = false; shift = false; code = F3 }; "OS", { control = false; meta = false; shift = false; code = F4 }; "O2P", { control = false; meta = false; shift = true; code = F1 }; "O2Q", { control = false; meta = false; shift = true; code = F2 }; "O2R", { control = false; meta = false; shift = true; code = F3 }; "O2S", { control = false; meta = false; shift = true; code = F4 }; "O3P", { control = false; meta = true; shift = false; code = F1 }; "O3Q", { control = false; meta = true; shift = false; code = F2 }; "O3R", { control = false; meta = true; shift = false; code = F3 }; "O3S", { control = false; meta = true; shift = false; code = F4 }; "O4P", { control = false; meta = true; shift = true; code = F1 }; "O4Q", { control = false; meta = true; shift = true; code = F2 }; "O4R", { control = false; meta = true; shift = true; code = F3 }; "O4S", { control = false; meta = true; shift = true; code = F4 }; "O5P", { control = true; meta = false; shift = false; code = F1 }; "O5Q", { control = true; meta = false; shift = false; code = F2 }; "O5R", { control = true; meta = false; shift = false; code = F3 }; "O5S", { control = true; meta = false; shift = false; code = F4 }; "O6P", { control = true; meta = false; shift = true; code = F1 }; "O6Q", { control = true; meta = false; shift = true; code = F2 }; "O6R", { control = true; meta = false; shift = true; code = F3 }; "O6S", { control = true; meta = false; shift = true; code = F4 }; "O7P", { control = true; meta = true; shift = false; code = F1 }; "O7Q", { control = true; meta = true; shift = false; code = F2 }; "O7R", { control = true; meta = true; shift = false; code = F3 }; "O7S", { control = true; meta = true; shift = false; code = F4 }; "O8P", { control = true; meta = true; shift = true; code = F1 }; "O8Q", { control = true; meta = true; shift = true; code = F2 }; "O8R", { control = true; meta = true; shift = true; code = F3 }; "O8S", { control = true; meta = true; shift = true; code = F4 }; "[[A", { control = false; meta = false; shift = false; code = F1 }; "[[B", { control = false; meta = false; shift = false; code = F2 }; "[[C", { control = false; meta = false; shift = false; code = F3 }; "[[D", { control = false; meta = false; shift = false; code = F4 }; "[[E", { control = false; meta = false; shift = false; code = F5 }; "[H", { control = false; meta = false; shift = false; code = Home }; "[F", { control = false; meta = false; shift = false; code = End }; "OH", { control = false; meta = false; shift = false; code = Home }; "OF", { control = false; meta = false; shift = false; code = End }; "H", { control = false; meta = false; shift = false; code = Home }; "F", { control = false; meta = false; shift = false; code = End }; "[1;2A", { control = false; meta = false; shift = true; code = Up }; "[1;2B", { control = false; meta = false; shift = true; code = Down }; "[1;2C", { control = false; meta = false; shift = true; code = Right }; "[1;2D", { control = false; meta = false; shift = true; code = Left }; "[1;3A", { control = false; meta = true; shift = false; code = Up }; "[1;3B", { control = false; meta = true; shift = false; code = Down }; "[1;3C", { control = false; meta = true; shift = false; code = Right }; "[1;3D", { control = false; meta = true; shift = false; code = Left }; "[1;4A", { control = false; meta = true; shift = true; code = Up }; "[1;4B", { control = false; meta = true; shift = true; code = Down }; "[1;4C", { control = false; meta = true; shift = true; code = Right }; "[1;4D", { control = false; meta = true; shift = true; code = Left }; "[1;5A", { control = true; meta = false; shift = false; code = Up }; "[1;5B", { control = true; meta = false; shift = false; code = Down }; "[1;5C", { control = true; meta = false; shift = false; code = Right }; "[1;5D", { control = true; meta = false; shift = false; code = Left }; "[1;6A", { control = true; meta = false; shift = true; code = Up }; "[1;6B", { control = true; meta = false; shift = true; code = Down }; "[1;6C", { control = true; meta = false; shift = true; code = Right }; "[1;6D", { control = true; meta = false; shift = true; code = Left }; "[1;7A", { control = true; meta = true; shift = false; code = Up }; "[1;7B", { control = true; meta = true; shift = false; code = Down }; "[1;7C", { control = true; meta = true; shift = false; code = Right }; "[1;7D", { control = true; meta = true; shift = false; code = Left }; "[1;8A", { control = true; meta = true; shift = true; code = Up }; "[1;8B", { control = true; meta = true; shift = true; code = Down }; "[1;8C", { control = true; meta = true; shift = true; code = Right }; "[1;8D", { control = true; meta = true; shift = true; code = Left }; "[1;2P", { control = false; meta = false; shift = true; code = F1 }; "[1;2Q", { control = false; meta = false; shift = true; code = F2 }; "[1;2R", { control = false; meta = false; shift = true; code = F3 }; "[1;2S", { control = false; meta = false; shift = true; code = F4 }; "[1;3P", { control = false; meta = true; shift = false; code = F1 }; "[1;3Q", { control = false; meta = true; shift = false; code = F2 }; "[1;3R", { control = false; meta = true; shift = false; code = F3 }; "[1;3S", { control = false; meta = true; shift = false; code = F4 }; "[1;4P", { control = false; meta = true; shift = true; code = F1 }; "[1;4Q", { control = false; meta = true; shift = true; code = F2 }; "[1;4R", { control = false; meta = true; shift = true; code = F3 }; "[1;4S", { control = false; meta = true; shift = true; code = F4 }; "[1;5P", { control = true; meta = false; shift = false; code = F1 }; "[1;5Q", { control = true; meta = false; shift = false; code = F2 }; "[1;5R", { control = true; meta = false; shift = false; code = F3 }; "[1;5S", { control = true; meta = false; shift = false; code = F4 }; "[1;6P", { control = true; meta = false; shift = true; code = F1 }; "[1;6Q", { control = true; meta = false; shift = true; code = F2 }; "[1;6R", { control = true; meta = false; shift = true; code = F3 }; "[1;6S", { control = true; meta = false; shift = true; code = F4 }; "[1;7P", { control = true; meta = true; shift = false; code = F1 }; "[1;7Q", { control = true; meta = true; shift = false; code = F2 }; "[1;7R", { control = true; meta = true; shift = false; code = F3 }; "[1;7S", { control = true; meta = true; shift = false; code = F4 }; "[1;8P", { control = true; meta = true; shift = true; code = F1 }; "[1;8Q", { control = true; meta = true; shift = true; code = F2 }; "[1;8R", { control = true; meta = true; shift = true; code = F3 }; "[1;8S", { control = true; meta = true; shift = true; code = F4 }; "O1;2P", { control = false; meta = false; shift = true; code = F1 }; "O1;2Q", { control = false; meta = false; shift = true; code = F2 }; "O1;2R", { control = false; meta = false; shift = true; code = F3 }; "O1;2S", { control = false; meta = false; shift = true; code = F4 }; "O1;3P", { control = false; meta = true; shift = false; code = F1 }; "O1;3Q", { control = false; meta = true; shift = false; code = F2 }; "O1;3R", { control = false; meta = true; shift = false; code = F3 }; "O1;3S", { control = false; meta = true; shift = false; code = F4 }; "O1;4P", { control = false; meta = true; shift = true; code = F1 }; "O1;4Q", { control = false; meta = true; shift = true; code = F2 }; "O1;4R", { control = false; meta = true; shift = true; code = F3 }; "O1;4S", { control = false; meta = true; shift = true; code = F4 }; "O1;5P", { control = true; meta = false; shift = false; code = F1 }; "O1;5Q", { control = true; meta = false; shift = false; code = F2 }; "O1;5R", { control = true; meta = false; shift = false; code = F3 }; "O1;5S", { control = true; meta = false; shift = false; code = F4 }; "O1;6P", { control = true; meta = false; shift = true; code = F1 }; "O1;6Q", { control = true; meta = false; shift = true; code = F2 }; "O1;6R", { control = true; meta = false; shift = true; code = F3 }; "O1;6S", { control = true; meta = false; shift = true; code = F4 }; "O1;7P", { control = true; meta = true; shift = false; code = F1 }; "O1;7Q", { control = true; meta = true; shift = false; code = F2 }; "O1;7R", { control = true; meta = true; shift = false; code = F3 }; "O1;7S", { control = true; meta = true; shift = false; code = F4 }; "O1;8P", { control = true; meta = true; shift = true; code = F1 }; "O1;8Q", { control = true; meta = true; shift = true; code = F2 }; "O1;8R", { control = true; meta = true; shift = true; code = F3 }; "O1;8S", { control = true; meta = true; shift = true; code = F4 }; "[15;2~", { control = false; meta = false; shift = true; code = F5 }; "[17;2~", { control = false; meta = false; shift = true; code = F6 }; "[18;2~", { control = false; meta = false; shift = true; code = F7 }; "[19;2~", { control = false; meta = false; shift = true; code = F8 }; "[20;2~", { control = false; meta = false; shift = true; code = F9 }; "[21;2~", { control = false; meta = false; shift = true; code = F10 }; "[23;2~", { control = false; meta = false; shift = true; code = F11 }; "[24;2~", { control = false; meta = false; shift = true; code = F12 }; "[15;3~", { control = false; meta = true; shift = false; code = F5 }; "[17;3~", { control = false; meta = true; shift = false; code = F6 }; "[18;3~", { control = false; meta = true; shift = false; code = F7 }; "[19;3~", { control = false; meta = true; shift = false; code = F8 }; "[20;3~", { control = false; meta = true; shift = false; code = F9 }; "[21;3~", { control = false; meta = true; shift = false; code = F10 }; "[23;3~", { control = false; meta = true; shift = false; code = F11 }; "[24;3~", { control = false; meta = true; shift = false; code = F12 }; "[15;4~", { control = false; meta = true; shift = true; code = F5 }; "[17;4~", { control = false; meta = true; shift = true; code = F6 }; "[18;4~", { control = false; meta = true; shift = true; code = F7 }; "[19;4~", { control = false; meta = true; shift = true; code = F8 }; "[20;4~", { control = false; meta = true; shift = true; code = F9 }; "[21;4~", { control = false; meta = true; shift = true; code = F10 }; "[23;4~", { control = false; meta = true; shift = true; code = F11 }; "[24;4~", { control = false; meta = true; shift = true; code = F12 }; "[15;5~", { control = true; meta = false; shift = false; code = F5 }; "[17;5~", { control = true; meta = false; shift = false; code = F6 }; "[18;5~", { control = true; meta = false; shift = false; code = F7 }; "[19;5~", { control = true; meta = false; shift = false; code = F8 }; "[20;5~", { control = true; meta = false; shift = false; code = F9 }; "[21;5~", { control = true; meta = false; shift = false; code = F10 }; "[23;5~", { control = true; meta = false; shift = false; code = F11 }; "[24;5~", { control = true; meta = false; shift = false; code = F12 }; "[15;6~", { control = true; meta = false; shift = true; code = F5 }; "[17;6~", { control = true; meta = false; shift = true; code = F6 }; "[18;6~", { control = true; meta = false; shift = true; code = F7 }; "[19;6~", { control = true; meta = false; shift = true; code = F8 }; "[20;6~", { control = true; meta = false; shift = true; code = F9 }; "[21;6~", { control = true; meta = false; shift = true; code = F10 }; "[23;6~", { control = true; meta = false; shift = true; code = F11 }; "[24;6~", { control = true; meta = false; shift = true; code = F12 }; "[15;7~", { control = true; meta = true; shift = false; code = F5 }; "[17;7~", { control = true; meta = true; shift = false; code = F6 }; "[18;7~", { control = true; meta = true; shift = false; code = F7 }; "[19;7~", { control = true; meta = true; shift = false; code = F8 }; "[20;7~", { control = true; meta = true; shift = false; code = F9 }; "[21;7~", { control = true; meta = true; shift = false; code = F10 }; "[23;7~", { control = true; meta = true; shift = false; code = F11 }; "[24;7~", { control = true; meta = true; shift = false; code = F12 }; "[15;8~", { control = true; meta = true; shift = true; code = F5 }; "[17;8~", { control = true; meta = true; shift = true; code = F6 }; "[18;8~", { control = true; meta = true; shift = true; code = F7 }; "[19;8~", { control = true; meta = true; shift = true; code = F8 }; "[20;8~", { control = true; meta = true; shift = true; code = F9 }; "[21;8~", { control = true; meta = true; shift = true; code = F10 }; "[23;8~", { control = true; meta = true; shift = true; code = F11 }; "[24;8~", { control = true; meta = true; shift = true; code = F12 }; "[1;2H", { control = false; meta = false; shift = true; code = Home }; "[1;2F", { control = false; meta = false; shift = true; code = End }; "[1;3H", { control = false; meta = true; shift = false; code = Home }; "[1;3F", { control = false; meta = true; shift = false; code = End }; "[1;4H", { control = false; meta = true; shift = true; code = Home }; "[1;4F", { control = false; meta = true; shift = true; code = End }; "[1;5H", { control = true; meta = false; shift = false; code = Home }; "[1;5F", { control = true; meta = false; shift = false; code = End }; "[1;6H", { control = true; meta = false; shift = true; code = Home }; "[1;6F", { control = true; meta = false; shift = true; code = End }; "[1;7H", { control = true; meta = true; shift = false; code = Home }; "[1;7F", { control = true; meta = true; shift = false; code = End }; "[1;8H", { control = true; meta = true; shift = true; code = Home }; "[1;8F", { control = true; meta = true; shift = true; code = End }; "[2;2~", { control = false; meta = false; shift = true; code = Insert }; "[3;2~", { control = false; meta = false; shift = true; code = Delete }; "[5;2~", { control = false; meta = false; shift = true; code = Prev_page }; "[6;2~", { control = false; meta = false; shift = true; code = Next_page }; "[2;3~", { control = false; meta = true; shift = false; code = Insert }; "[3;3~", { control = false; meta = true; shift = false; code = Delete }; "[5;3~", { control = false; meta = true; shift = false; code = Prev_page }; "[6;3~", { control = false; meta = true; shift = false; code = Next_page }; "[2;4~", { control = false; meta = true; shift = true; code = Insert }; "[3;4~", { control = false; meta = true; shift = true; code = Delete }; "[5;4~", { control = false; meta = true; shift = true; code = Prev_page }; "[6;4~", { control = false; meta = true; shift = true; code = Next_page }; "[2;5~", { control = true; meta = false; shift = false; code = Insert }; "[3;5~", { control = true; meta = false; shift = false; code = Delete }; "[5;5~", { control = true; meta = false; shift = false; code = Prev_page }; "[6;5~", { control = true; meta = false; shift = false; code = Next_page }; "[2;6~", { control = true; meta = false; shift = true; code = Insert }; "[3;6~", { control = true; meta = false; shift = true; code = Delete }; "[5;6~", { control = true; meta = false; shift = true; code = Prev_page }; "[6;6~", { control = true; meta = false; shift = true; code = Next_page }; "[2;7~", { control = true; meta = true; shift = false; code = Insert }; "[3;7~", { control = true; meta = true; shift = false; code = Delete }; "[5;7~", { control = true; meta = true; shift = false; code = Prev_page }; "[6;7~", { control = true; meta = true; shift = false; code = Next_page }; "[2;8~", { control = true; meta = true; shift = true; code = Insert }; "[3;8~", { control = true; meta = true; shift = true; code = Delete }; "[5;8~", { control = true; meta = true; shift = true; code = Prev_page }; "[6;8~", { control = true; meta = true; shift = true; code = Next_page }; (* iTerm2 *) "[1;9A", { control = false; meta = true; shift = false; code = Up }; "[1;9B", { control = false; meta = true; shift = false; code = Down }; "[1;9C", { control = false; meta = true; shift = false; code = Right }; "[1;9D", { control = false; meta = true; shift = false; code = Left }; |] let () = Array.sort (fun (seq1, _) (seq2, _) -> String.compare seq1 seq2) sequences let find_sequence seq = let rec loop a b = if a = b then None else let c = (a + b) / 2 in let k, v = Array.unsafe_get sequences c in match String.compare seq k with | d when d < 0 -> loop a c | d when d > 0 -> loop (c + 1) b | _ -> Some v in loop 0 (Array.length sequences) let rec parse_event ?(escape_time = 0.1) encoding stream = Lwt_stream.next stream >>= fun byte -> match byte with | '\x1b' -> begin (* Escape sequences *) Lwt.catch (fun () -> (* Try to parse an escape seqsuence *) Lwt_stream.parse stream (parse_escape escape_time) >>= function | "[M" -> begin (* Mouse report *) let open LTerm_mouse in Lwt_stream.next stream >|= Char.code >>= fun mask -> Lwt_stream.next stream >|= Char.code >>= fun x -> Lwt_stream.next stream >|= Char.code >>= fun y -> try if mask = 0b00100011 then raise Exit; return (LTerm_event.Mouse { control = mask land 0b00010000 <> 0; meta = mask land 0b00001000 <> 0; shift = false; row = y - 33; col = x - 33; button = (match mask land 0b11000111 with | 0b00000000 -> Button1 | 0b00000001 -> Button2 | 0b00000010 -> Button3 | 0b01000000 -> Button4 | 0b01000001 -> Button5 | 0b01000010 -> Button6 | 0b01000011 -> Button7 | 0b01000100 -> Button8 | 0b01000101 -> Button9 | _ -> raise Exit); }) with Exit -> parse_event encoding stream end | seq -> match find_sequence seq with | Some key -> return (LTerm_event.Key key) | None -> return (LTerm_event.Sequence ("\x1b" ^ seq))) (function | Not_a_sequence -> begin (* If it is not, test if it is META+key. *) Lwt.pick [Lwt_stream.peek stream; Lwt_unix.sleep escape_time >>= fun () -> return None] >>= fun ch -> match ch with | None -> return (LTerm_event.Key { control = false; meta = false; shift = false; code = Escape }) | Some byte -> begin match byte with | '\x1b' -> begin (* Escape sequences *) Lwt.catch (fun () -> begin Lwt_stream.parse stream (fun stream -> Lwt_stream.junk stream >>= fun () -> Lwt.pick [Lwt_stream.peek stream; Lwt_unix.sleep escape_time >>= fun () -> return None] >>= fun ch -> match ch with | None -> Lwt.fail Not_a_sequence | Some _ -> parse_escape escape_time stream) end >>= fun seq -> match find_sequence seq with | Some key -> return (LTerm_event.Key { key with meta = true }) | None -> return (LTerm_event.Sequence ("\x1b\x1b" ^ seq))) (function | Not_a_sequence -> return (LTerm_event.Key { control = false; meta = false; shift = false; code = Escape }) | exn -> Lwt.fail exn) end | '\x00' .. '\x1b' -> (* Control characters *) Lwt_stream.junk stream >>= fun () -> let code = controls.(Char.code byte) in return (LTerm_event.Key { control = (match code with Char _ -> true | _ -> false); meta = true; shift = false; code }) | '\x7f' -> (* Backspace *) Lwt_stream.junk stream >>= fun () -> return (LTerm_event.Key { control = false; meta = true; shift = false; code = Backspace }) | '\x00' .. '\x7f' -> (* Other ascii characters *) Lwt_stream.junk stream >>= fun () -> return(LTerm_event.Key { control = false; meta = true; shift = false; code = Char(UChar.of_char byte) }) | byte' -> Lwt_stream.junk stream >>= fun () -> parse_char encoding stream byte' >>= fun code -> return (LTerm_event.Key { control = false; meta = true; shift = false; code = Char code }) end end | exn -> Lwt.fail exn) end | '\x00' .. '\x1f' -> (* Control characters *) let code = controls.(Char.code byte) in return (LTerm_event.Key { control = (match code with Char _ -> true | _ -> false); meta = false; shift = false; code }) | '\x7f' -> (* Backspace *) return (LTerm_event.Key { control = false; meta = false; shift = false; code = Backspace }) | '\x00' .. '\x7f' -> (* Other ascii characters *) return (LTerm_event.Key { control = false; meta = false; shift = false; code = Char(UChar.of_char byte) }) | _ -> (* Encoded characters *) parse_char encoding stream byte >>= fun code -> return (LTerm_event.Key { control = false; meta = false; shift = false; code = Char code }) lambda-term-3.1.0/src/lTerm_unix.mli000066400000000000000000000017221366433625400173360ustar00rootroot00000000000000(* * lTerm_unix.mli * -------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Unix specific functions *) open CamomileLibraryDefault.Camomile val sigwinch : int option (** The number of the signal used to indicate that the terminal size have changed. It is [None] on windows. *) val system_encoding : string (** The encoding used by the system. *) val parse_event : ?escape_time : float -> CharEncoding.t -> char Lwt_stream.t -> LTerm_event.t Lwt.t (** [parse_event encoding stream] parses one event from the given input stream. [encoding] is the character encoding used to decode non-ascii characters. It must be a converter from the stream encoding to "UCS-4BE". If an invalid sequence is encountered in the input, it fallbacks to Latin-1. [escape_time] is the time waited before returning the escape key. It defaults to [0.1]. *) lambda-term-3.1.0/src/lTerm_unix_stubs.c000066400000000000000000000025711366433625400202220ustar00rootroot00000000000000/* * lTerm_unix_stubs.c * ------------------ * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. */ #include "lTerm_config.h" #include #include #if defined(_WIN32) || defined(_WIN64) #include #include CAMLprim value lt_unix_get_sigwinch() { return Val_int(0); } CAMLprim value lt_unix_get_system_encoding() { return caml_copy_string(""); } #else #include #include #if defined(SYS_openbsd) # include #else # include #endif CAMLprim value lt_unix_get_sigwinch() { #ifdef SIGWINCH value result = caml_alloc_tuple(1); Field(result, 0) = Val_int(SIGWINCH); return result; #else return Val_int(0); #endif } CAMLprim value lt_unix_get_system_encoding() { /* Set the locale according to environment variables: */ const char *locale = setlocale(LC_CTYPE, ""); /* Get the codeset used by current locale: */ #if defined(SYS_openbsd) const char *codeset = locale_charset(); #elif defined(__ANDROID__) && __ANDROID_API__ < 26 const char *codeset = NULL; #else const char *codeset = nl_langinfo(CODESET); #endif /* Reset the locale: */ setlocale(LC_CTYPE, locale); /* If the encoding cannot be determined, just use ascii: */ return caml_copy_string(codeset ? codeset : "ASCII"); } #endif lambda-term-3.1.0/src/lTerm_vi.ml000066400000000000000000002453421366433625400166300ustar00rootroot00000000000000(* * lTerm_vi.ml * ------------ * Copyright : (c) 2020, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) module Concurrent = struct module Thread= struct include Lwt let run= Lwt_unix.run [@@ocaml.warning "-3"] let sleep= Lwt_unix.sleep end module MsgBox= struct include Lwt_mvar let get= Lwt_mvar.take let create= Lwt_mvar.create_empty end end module Query = struct (* (* left right *) | Left of int (* h *) | Right of int (* l *) | Right_nl of int (* l, including newline *) | Line_FirstChar of int (* 0 *) | Line_FirstNonBlank of int (* ^ *) | Line_LastChar of int (* $ *) | Line_LastChar_nl of int (* $ *) | Line_LastNonBlank of int (* g_ *) | Line_LastNonBlank_nl of int (* g_ *) (* up down *) | Upward of int (* k *) | Downward of int (* j *) | GotoLine of int (* gg or G *) | GotoLine_first (* gg *) | GotoLine_last (* G *) (* word *) | Word of int (* w *) | WORD of int (* W *) | Word_end of int (* e *) | WORD_end of int (* E *) | Word_back of int (* b *) | WORD_back of int (* B *) | Word_back_end of int (* ge *) | WORD_back_end of int (* gE *) (* line *) | Line (* occurrence *) | Occurrence_inline of string | Occurrence_inline_back of string | Occurrence_inline_till of string | Occurrence_inline_till_back of string (* text object *) | Sentence_backword of int (* ( *) | Sentence_forward of int (* ) *) | Paragraph_backward of int (* { *) | Paragraph_forward of int (* } *) (* text object selection *) | Word_include of int (* aw *) | Word_inner of int (* iw *) | WORD_include of int (* aW *) | WORD_inner of int (* iW *) | Sentence_include of int (* as *) | Sentence_inner of int (* is *) | Paragraph_include of int (* ap *) | Paragraph_inner of int (* ip *) | Parenthesis_include of int (* a( a) *) | Parenthesis_inner of int (* i( i) *) | Bracket_include of int (* a[ a] *) | Bracket_inner of int (* i[ i] *) | AngleBracket_include of int (* a< a> *) | AngleBracket_inner of int (* i< i> *) | Brace_include of int (* a{ a} *) | Brace_inner of int (* i{ i} *) | Quote_include of (string * int) | Quote_inner of (string * int) (* match *) | Match *) let left n ctx= (* h *) let n= max 0 n in let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in let line_len= Zed_lines.line_length lines line_idx in let column= Zed_edit.column ctx in let dest= (column - n) |> max 0 |> min line_len in let positon= Zed_edit.position ctx in let delta= column - dest in (positon - delta, delta) let right ?(newline=false) n ctx= (* l *) let n= max 0 n in let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in let line_len= max 0 @@ let len= Zed_lines.line_length lines line_idx in if newline then len else len - 1 in let column= Zed_edit.column ctx in let dest= (column + n) |> max 0 |> min line_len in let positon= Zed_edit.position ctx in let delta= dest - column in (positon + delta, delta) let line_FirstChar _n ctx= (* 0 *) let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in let start= Zed_lines.line_start lines line_idx in let column= Zed_edit.column ctx in (start, column - start) let line_LastChar ?(newline=false) n ctx= (* ^ *) let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in let count= Zed_lines.count lines in let line_idx= if n > 1 then min count @@ line_idx + (n - 1) else line_idx in let stop= Zed_lines.line_stop lines line_idx in if newline then stop else max 0 (stop - 1) open CamomileLibraryDefault.Camomile let get_category ?(nl_as_sp=false) uchar= if uchar = Zed_utf8.extract "\n" 0 && nl_as_sp then `Zs else UCharInfo.general_category uchar let get_boundary multi_line ctx= let edit= Zed_edit.edit ctx in if multi_line then (0, Zed_rope.length (Zed_edit.text edit)) else let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in (Zed_lines.line_start lines line_idx , Zed_lines.line_stop lines line_idx) let is_space= function | `Cc | `Zs | `Zl | `Zp | `Mn -> true | _-> false let is_not_space c= not (is_space c) let category_equal c1 c2= match c1, c2 with | `Ll, `Lu | `Lu, `Ll-> true | _-> c1 = c2 let category_equal_blank c1 c2= let b1= is_space c1 and b2= is_space c2 in b1 = b2 let next_category ?(nl_as_sp=true) ?(is_equal=category_equal) ~pos ~stop text = let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let zip= Zed_rope.Zip.make_f text pos in let rec skip_curr zip pos= if pos < stop then let zchar, zip= Zed_rope.Zip.next zip in let category= get_category ~nl_as_sp (Zed_char.core zchar) in if is_equal category start_category then skip_curr zip (pos + 1) else pos else pos in skip_curr zip pos let prev_category ?(nl_as_sp=true) ?(is_equal=category_equal) ~pos ~start text = let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let zip= Zed_rope.Zip.make_f text pos in let rec skip_curr zip pos= if pos > start then let zchar, zip= Zed_rope.Zip.prev zip in let category= get_category ~nl_as_sp (Zed_char.core zchar) in if is_equal category start_category then skip_curr zip (pos - 1) else pos else pos in (skip_curr zip pos) - 1 let goto_line ctx index= let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let index= min index (Zed_lines.count lines) in Zed_lines.line_start lines index let next_line ctx delta= let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let lines= Zed_edit.lines edit in let index = Zed_edit.line ctx in let cursor= Zed_edit.cursor ctx in let count= Zed_lines.count lines in if index = Zed_lines.count lines then Zed_rope.length text - 1 else begin let stop = if index + delta >= count then Zed_rope.length text else Zed_lines.line_start lines (index + delta + 1) - 1 in let wanted_idx= Zed_lines.get_idx_by_width lines (min count (index + delta)) (Zed_cursor.get_wanted_column cursor) in max (Zed_lines.line_start lines (index + delta)) (min wanted_idx (stop-1)) end let prev_line ctx delta= let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let cursor= Zed_edit.cursor ctx in let index = Zed_cursor.get_line cursor in if index - delta < 0 then 0 else let stop = Zed_lines.line_start lines (index-delta+1) - 1 in let wanted_idx= Zed_lines.get_idx_by_width lines (index - delta) (Zed_cursor.get_wanted_column cursor) in max (Zed_lines.line_start lines (index - delta)) (min wanted_idx (stop-1)) let next_word' ?(multi_line=true) ~next_category ~pos ~stop text= let nl_as_sp= multi_line in let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let next= next_category ~nl_as_sp ~pos ~stop text in if is_space start_category then next (* currently at a space, just skip spaces *) else if next < stop then (* skip potential subsequent spaces after skip current word*) let zchar= Zed_rope.get text next in let core= Zed_char.core zchar in if is_space (get_category ~nl_as_sp core) then (* skip subsequent spaces *) next_category ~nl_as_sp ~pos:next ~stop text else next else stop let next_word ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal in next_word' ?multi_line ~next_category ~pos ~stop text let next_WORD ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal_blank in next_word' ?multi_line ~next_category ~pos ~stop text let line_FirstNonBlank _n ctx= (* ^ *) let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let lines= Zed_edit.lines edit and line_idx= Zed_edit.line ctx in let line_len= Zed_lines.line_length lines line_idx in let start, stop= get_boundary false ctx in if line_len > 0 then if is_space (get_category (Zed_char.core (Zed_rope.get text start))) then min (stop-1) (next_word ~multi_line:false ~pos:start ~stop text) else start else 0 let prev_word' ?(multi_line=true) ~prev_category ~pos ~start text= if pos <= start then start else let nl_as_sp= multi_line in let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core and before_start= let zchar= Zed_rope.get text (pos - 1) in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let prev= prev_category ~nl_as_sp ~pos ~start text in 1 + if category_equal start_category before_start then if is_space start_category then prev_category ~nl_as_sp ~pos:prev ~start text else prev else if is_space before_start then let prev= prev_category ~nl_as_sp ~pos:prev ~start text in if prev <= start then prev else prev_category ~nl_as_sp ~pos:prev ~start text else prev_category ~nl_as_sp ~pos:prev ~start text let prev_word ?multi_line ~pos ~start text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal in prev_word' ?multi_line ~prev_category ~pos ~start text let prev_WORD ?multi_line ~pos ~start text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal_blank in prev_word' ?multi_line ~prev_category ~pos ~start text let next_word_end' ?(multi_line=true) ~next_category ~pos ~stop text= let pos= if pos >= (stop-1) then stop else let nl_as_sp= multi_line in let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core and after_start= let zchar= Zed_rope.get text (pos + 1) in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let next= next_category ~nl_as_sp ~pos ~stop text in if next >= stop then stop else if category_equal start_category after_start && is_not_space start_category then next else let next= next_category ~nl_as_sp ~pos:next ~stop text in if next >= stop then stop else if is_space start_category || is_not_space after_start then next else next_category ~nl_as_sp ~pos:next ~stop text in max 0 @@ pos - 1 let next_word_end ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal in next_word_end' ?multi_line ~next_category ~pos ~stop text let next_WORD_end ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal_blank in next_word_end' ?multi_line ~next_category ~pos ~stop text let prev_word_end' ?(multi_line=true) ~prev_category ~pos ~start text= if pos <= start then start else let nl_as_sp= multi_line in let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let prev= prev_category ~nl_as_sp ~pos ~start text in if prev <= start then start else if is_space start_category then prev else let before_category= let zchar= Zed_rope.get text prev in let core= Zed_char.core zchar in get_category ~nl_as_sp core in if is_space before_category then prev_category ~nl_as_sp ~pos:prev ~start text else prev let prev_word_end ?multi_line ~pos ~start text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal in prev_word_end' ?multi_line ~prev_category ~pos ~start text let prev_WORD_end ?multi_line ~pos ~start text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal_blank in prev_word_end' ?multi_line ~prev_category ~pos ~start text let occurrence_char ~pos ~stop chr text= try let zip= Zed_rope.Zip.make_f text pos in let next= Zed_rope.Zip.find_f (fun c-> Zed_char.compare chr c = 0) zip in let next_pos= Zed_rope.Zip.offset next in if next_pos < stop then Some next_pos else None with _-> None let occurrence_char_back ~pos ~start chr text= try let zip= Zed_rope.Zip.make_f text pos in let prev= Zed_rope.Zip.find_b (fun c-> Zed_char.compare chr c = 0) zip in let prev_pos= Zed_rope.Zip.offset prev in if prev_pos > start then Some (prev_pos - 1) else None with _-> None let occurrence ~pos ~stop ~cmp text= try let zip= Zed_rope.Zip.make_f text pos in let next= Zed_rope.Zip.find_f cmp zip in let next_pos= Zed_rope.Zip.offset next in if next_pos < stop then Some (next_pos, Zed_rope.get text next_pos) else None with _-> None let occurrence_back ~pos ~start ~cmp text= try let zip= Zed_rope.Zip.make_f text pos in let prev= Zed_rope.Zip.find_b cmp zip in let prev_pos= Zed_rope.Zip.offset prev in if prev_pos > start then Some (prev_pos - 1, Zed_rope.get text (prev_pos - 1)) else None with _-> None let occurrence_pare_raw ~pos ~level ~start ~stop pair text= let left, right= pair in let rec find_left level pos= if pos >= start then if level > 0 then match occurrence_char_back ~pos ~start left text with | Some pos-> find_left (level-1) (pos - 1) | None-> None else Some (pos+1) else None in let rec find_right level pos= if pos < stop then if level > 0 then match occurrence_char ~pos ~stop right text with | Some pos-> find_right (level-1) (pos - 1) | None-> None else Some (pos-1) else None in if level > 0 then match find_left level (pos+1) with | Some left-> (match find_right level pos with | Some right-> Some (left, right) | None-> None) | None-> None else None let occurrence_pare ~pos ~level ~start ~stop pair text= let left, right= pair in let equal a b= Zed_char.compare a b = 0 in let cmp c= equal c left || equal c right in let rec find_left level pos= if level > 0 then if pos >= start then match occurrence_back ~pos ~start ~cmp text with | Some (pos, c)-> if equal c left then find_left (level-1) (pos - 1) else find_left (level+1) (pos - 1) | None-> None else None else Some (pos+1) in let rec find_right level pos= if level > 0 then if pos < stop then match occurrence ~pos ~stop ~cmp text with | Some (pos, c)-> if equal c right then find_right (level-1) (pos + 1) else find_right (level+1) (pos + 1) | None-> None else None else Some (pos-1) in if level > 0 && pos >= start && pos < stop then let init_pos= if equal (Zed_rope.get text pos) left then pos+1 else if equal (Zed_rope.get text pos) right then pos else pos+1 in match find_left level init_pos with | Some left-> (match find_right 1 (left+1) with | Some right-> Some (left, right) | None-> None) | None-> None else None let item_match ~start ~stop pos text= match Zed_rope.get text pos |> Zed_char.to_utf8 with | "("-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "(", Zed_char.of_utf8 ")") text with | Some (_, right)-> Some right | None-> None) | ")"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "(", Zed_char.of_utf8 ")") text with | Some (left, _)-> Some left | None-> None) | "["-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "[", Zed_char.of_utf8 "]") text with | Some (_, right)-> Some right | None-> None) | "]"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "[", Zed_char.of_utf8 "]") text with | Some (left, _)-> Some left | None-> None) | "<"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "<", Zed_char.of_utf8 ">") text with | Some (_, right)-> Some right | None-> None) | ">"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "<", Zed_char.of_utf8 ">") text with | Some (left, _)-> Some left | None-> None) | "{"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "{", Zed_char.of_utf8 "}") text with | Some (_, right)-> Some right | None-> None) | "}"-> (match occurrence_pare ~pos ~level:1 ~start ~stop (Zed_char.of_utf8 "{", Zed_char.of_utf8 "}") text with | Some (left, _)-> Some left | None-> None) | _-> None let include_word' ?(multi_line=true) ~next_category ~pos ~stop text= if Zed_rope.length text = 0 then None else if pos >= stop then None else let nl_as_sp= multi_line in let start_category= let zchar= Zed_rope.get text pos in let core= Zed_char.core zchar in get_category ~nl_as_sp core in let pos_begin= if is_space start_category then let next= next_category ~nl_as_sp ~pos ~stop text in if next < stop then Some next else None else let prev= prev_category ~nl_as_sp ~pos ~start:0 text in if prev >= pos - 1 then Some pos else Some (prev + 1) in match pos_begin with | Some pos_begin-> let pos_end= next_word' ~multi_line ~next_category ~pos:pos_begin ~stop text - 1 in Some (pos_begin, pos_end) | None-> None let include_word ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal in include_word' ?multi_line ~next_category ~pos ~stop text let include_WORD ?multi_line ~pos ~stop text= let next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal_blank in include_word' ?multi_line ~next_category ~pos ~stop text let inner_word' ?(multi_line=true) ~prev_category ~next_category ~pos ~stop text = if Zed_rope.length text = 0 then None else let nl_as_sp= multi_line in let pos_begin= if pos = 0 then 0 else prev_category ~nl_as_sp ~pos ~start:0 text + 1 and pos_end= next_category ~nl_as_sp ~pos ~stop text - 1 in Some (pos_begin, pos_end) let inner_word ?multi_line ~pos ~stop text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal and next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal in inner_word' ?multi_line ~prev_category ~next_category ~pos ~stop text let inner_WORD ?multi_line ~pos ~stop text= let prev_category ~nl_as_sp= prev_category ~nl_as_sp ~is_equal:category_equal_blank and next_category ~nl_as_sp= next_category ~nl_as_sp ~is_equal:category_equal_blank in inner_word' ?multi_line ~prev_category ~next_category ~pos ~stop text end module Vi = Mew_vi.Core.Make (Concurrent) include Vi let of_lterm_code : LTerm_key.code -> Mew_vi.Key.code= function | Char chr-> Char (Zed_utf8.escaped_char chr) | Enter -> Enter | Escape -> Escape | Tab -> Tab | Up -> Up | Down -> Down | Left -> Left | Right -> Right | F1 -> F1 | F2 -> F2 | F3 -> F3 | F4 -> F4 | F5 -> F5 | F6 -> F6 | F7 -> F7 | F8 -> F8 | F9 -> F9 | F10 -> F10 | F11 -> F11 | F12 -> F12 | Next_page -> Next_page | Prev_page -> Prev_page | Home -> Home | End -> End | Insert -> Insert | Delete -> Delete | Backspace -> Backspace let of_vi_code : Mew_vi.Key.code -> LTerm_key.code= function | Char bin -> Char (Zed_utf8.extract bin 0) | Enter -> Enter | Escape -> Escape | Tab -> Tab | Up -> Up | Down -> Down | Left -> Left | Right -> Right | F1 -> F1 | F2 -> F2 | F3 -> F3 | F4 -> F4 | F5 -> F5 | F6 -> F6 | F7 -> F7 | F8 -> F8 | F9 -> F9 | F10 -> F10 | F11 -> F11 | F12 -> F12 | Next_page -> Next_page | Prev_page -> Prev_page | Home -> Home | End -> End | Insert -> Insert | Delete -> Delete | Backspace -> Backspace let of_lterm_key lterm_key= { Mew_vi.Key.control= lterm_key.LTerm_key.control; meta= lterm_key.meta; shift= lterm_key.shift; code= of_lterm_code lterm_key.code; } let of_vi_key vi_key= { LTerm_key.control= vi_key.Mew_vi.Key.control; meta= vi_key.meta; shift= vi_key.shift; code= of_vi_code vi_key.code; } open LTerm_read_line_base open Lwt let perform vi_edit ctx exec action= let list_make elm n= let rec create acc n= if n > 0 then create (elm::acc) (n-1) else acc in create [] n in let list_dup elm n= let rec create acc n= if n > 0 then create (elm::acc) (n-1) else acc in create [] n |> List.concat in let delete ~register ?(line=false) ?boundary start len= let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let eot= Zed_rope.length text in let lines= Zed_edit.lines edit in let boundary_start, boundary_end= match boundary with | Some (b, e)-> b, e | None-> 0, eot in let _ori_start, _ori_len, _ori_stop= start, len, start+len in let start, len, stop= let start= max boundary_start _ori_start in let stop= min boundary_end _ori_stop in let len= stop - start in start, len, stop in if len > 0 then let end_pos= if stop >= eot then let end_pos= max 0 @@ start - 1 in if eot > 0 then if (=) (Zed_char.core (Zed_rope.get text end_pos)) (Zed_utf8.extract "\n" 0) then max 0 @@ end_pos - 1 else end_pos else end_pos else if (=) (Zed_char.core (Zed_rope.get text stop)) (Zed_utf8.extract "\n" 0) then max (start - 1) Zed_lines.(line_start lines (line_index lines start)) else start in let content= let str= Zed_rope.sub text start len |> Zed_rope.to_string |> Zed_string.to_utf8 in if line then Vi.Interpret.Register.Line str else Vi.Interpret.Register.Seq str in vi_edit#set_register register content; vi_edit#set_register "\"" content; let del_len= if line && stop < eot then len + 1 else len in exec [ Edit (Zed (Zed_edit.Goto start)); Edit (Zed (Zed_edit.Kill_next_chars del_len)); Edit (Zed (Zed_edit.Goto end_pos)) ] else return (ContinueLoop []) in let change ~register ?(line=false) ?boundary start len= let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let eot= Zed_rope.length text in let boundary_start, boundary_end= match boundary with | Some (b, e)-> b, e | None-> 0, eot in let _ori_start, _ori_len, _ori_stop= start, len, start+len in let start, len, _stop= let start= max boundary_start _ori_start in let stop= min boundary_end _ori_stop in let len= stop - start in start, len, stop in if len > 0 then let content= let str= Zed_rope.sub text start len |> Zed_rope.to_string |> Zed_string.to_utf8 in if line then Vi.Interpret.Register.Line str else Vi.Interpret.Register.Seq str in vi_edit#set_register register content; vi_edit#set_register "\"" content; exec [ Edit (Zed (Zed_edit.Goto start)); Edit (Zed (Zed_edit.Kill_next_chars len)); Edit (Zed (Zed_edit.Goto start)) ] else return (ContinueLoop []) in let yank ~register ?(line=false) start len= let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let content= let str= Zed_rope.sub text start len |> Zed_rope.to_string |> Zed_string.to_utf8 in if line then Vi.Interpret.Register.Line str else Vi.Interpret.Register.Seq str in vi_edit#set_register register content; vi_edit#set_register "\"" content; Zed_edit.copy_sequence ctx start len; return (ContinueLoop []) in let setup_pos ()= let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let text_len= Zed_rope.length text in (if text_len > 0 then let step= if pos >= text_len then pos - 1 else pos in let step= if (=) (Zed_char.core (Zed_rope.get text step)) (Zed_utf8.extract "\n" 0) then max 0 @@ step - 1 else step in exec [Edit (Zed (Zed_edit.Goto step))] else exec [Edit (Zed (Zed_edit.Goto_bol))]) in let pare_include pair level action= let text= Zed_edit.text (Zed_edit.edit ctx) in let pos= Zed_edit.position ctx in let start= 0 and stop= Zed_rope.length text in (match Query.occurrence_pare ~pos ~level ~start ~stop pair text with | Some (left, right)-> action left (right+1 - left) | None-> return (ContinueLoop [])) in let pare_inner pair level action= let text= Zed_edit.text (Zed_edit.edit ctx) in let pos= Zed_edit.position ctx in let start= 0 and stop= Zed_rope.length text in (match Query.occurrence_pare ~pos ~level ~start ~stop pair text with | Some (left, right)-> action (left+1) (right - (left+1)) | None-> return (ContinueLoop [])) in match action with | Vi_action.Insert (insert, count)-> (match insert with | Newline_below _s-> exec @@ (Edit (Zed (Zed_edit.Goto_eol))):: (list_make (Edit (Zed (Zed_edit.Newline))) count) | Newline_above _s-> exec @@ list_dup [ Edit (Zed (Zed_edit.Goto_bol)); Edit (Zed (Zed_edit.Newline)); Edit (Zed (Zed_edit.Prev_line)); ] count | _-> return (ContinueLoop [])) | Motion (motion, count)-> (match motion with | Left-> let rec left n= if n > 0 then let pos, _delta= Query.left n ctx in exec (list_make (Edit (Zed (Zed_edit.Goto pos))) 1) >>= (function | Result _ as r-> return r | ContinueLoop _-> left (n-1)) else return (ContinueLoop []) in left count | Right-> let rec right n= if n > 0 then let pos, _delta= Query.right n ctx in exec (list_make (Edit (Zed (Zed_edit.Goto pos))) 1) >>= (function | Result _ as r-> return r | ContinueLoop _-> right (n-1)) else return (ContinueLoop []) in right count | Right_nl-> let newline= true in let rec right n= if n > 0 then let pos, _delta= Query.right ~newline n ctx in exec (list_make (Edit (Zed (Zed_edit.Goto pos))) 1) >>= (function | Result _ as r-> return r | ContinueLoop _-> right (n-1)) else return (ContinueLoop []) in right count | Upward-> let pos= Query.prev_line ctx count in exec [Edit (Zed (Zed_edit.Set_pos pos))] | Downward-> let pos= Query.next_line ctx count in exec [Edit (Zed (Zed_edit.Set_pos pos))] | Word-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let rec next_word n= let pos= Zed_edit.position ctx in if n > 0 && pos < stop then let next= min (stop - 1) (Query.next_word ~pos ~stop text) in exec [Edit (Zed (Zed_edit.Goto next))] >>= (function | Result _ as r-> return r | ContinueLoop _-> next_word (n-1)) else return (ContinueLoop []) in next_word count | WORD-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let rec next_word n= let pos= Zed_edit.position ctx in if n > 0 && pos < stop then let next= min (stop - 1) (Query.next_WORD ~pos ~stop text) in exec [Edit (Zed (Zed_edit.Goto next))] >>= (function | Result _ as r-> return r | ContinueLoop _-> next_word (n-1)) else return (ContinueLoop []) in next_word count | Word_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let rec prev_word n= let pos= min (stop - 1) (Zed_edit.position ctx) in if n > 0 && pos > start then let prev= max start (Query.prev_word ~pos ~start text) in exec (list_make (Edit (Zed (Zed_edit.Goto prev))) 1) >>= (function | Result _ as r-> return r | ContinueLoop _-> prev_word (n-1)) else return (ContinueLoop []) in prev_word count | WORD_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let rec prev_word n= let pos= min (stop - 1) (Zed_edit.position ctx) in if n > 0 && pos > start then let prev= max start (Query.prev_WORD ~pos ~start text) in exec [Edit (Zed (Zed_edit.Goto prev))] >>= (function | Result _ as r-> return r | ContinueLoop _-> prev_word (n-1)) else return (ContinueLoop []) in prev_word count | Word_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let rec next_word n= let pos= Zed_edit.position ctx in if n > 0 && pos < stop then let next= min (stop - 1) (Query.next_word_end ~pos ~stop text) in exec [Edit (Zed (Zed_edit.Goto next))] >>= (function | Result _ as r-> return r | ContinueLoop _-> next_word (n-1)) else return (ContinueLoop []) in next_word count | WORD_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let rec next_word n= let pos= Zed_edit.position ctx in if n > 0 && pos < stop then let next= min (stop - 1) (Query.next_WORD_end ~pos ~stop text) in exec [Edit (Zed (Zed_edit.Goto next))] >>= (function | Result _ as r-> return r | ContinueLoop _-> next_word (n-1)) else return (ContinueLoop []) in next_word count | Word_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let rec prev_word n= let pos= min (stop - 1) (Zed_edit.position ctx) in if n > 0 && pos > start then let prev= max start (Query.prev_word_end ~pos ~start text) in exec [Edit (Zed (Zed_edit.Goto prev))] >>= (function | Result _ as r-> return r | ContinueLoop _-> prev_word (n-1)) else return (ContinueLoop []) in prev_word count | WORD_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let rec prev_word n= let pos= min (stop - 1) (Zed_edit.position ctx) in if n > 0 && pos > start then let prev= max start (Query.prev_WORD_end ~pos ~start text) in exec [Edit (Zed (Zed_edit.Goto prev))] >>= (function | Result _ as r-> return r | ContinueLoop _-> prev_word (n-1)) else return (ContinueLoop []) in prev_word count | Line_FirstChar-> exec (list_make (Edit (Zed Zed_edit.Goto_bol)) count) | Line_FirstNonBlank-> let nonblank= Query.line_FirstNonBlank 1 ctx in exec [Edit (Zed (Zed_edit.Goto nonblank))] | Line_LastChar-> let rec lastChar n= if n > 0 then let pos= Query.line_LastChar n ctx in exec [Edit (Zed (Zed_edit.Goto pos))] >>= (function | Result _ as r-> return r | ContinueLoop _-> lastChar (n-1)) else return (ContinueLoop []) in lastChar count | Line_LastChar_nl-> let newline= true in let rec lastChar n= if n > 0 then let pos= Query.line_LastChar ~newline n ctx in exec [Edit (Zed (Zed_edit.Goto pos))] >>= (function | Result _ as r-> return r | ContinueLoop _-> lastChar (n-1)) else return (ContinueLoop []) in lastChar count | GotoLine-> let pos= Query.goto_line ctx count in exec [Edit (Zed (Zed_edit.Set_pos pos))] | GotoLine_first-> exec [Edit (Zed (Zed_edit.Goto_bot))] | GotoLine_last-> exec [ Edit (Zed (Zed_edit.Goto_eot)); Edit (Zed (Zed_edit.Prev_char)) ] | Occurrence_inline chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some pos-> exec [ Edit (Zed (Zed_edit.Goto pos)) ] | None-> return (ContinueLoop [])) | Occurrence_inline_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos-1) count with | Some pos-> exec [ Edit (Zed (Zed_edit.Goto pos)) ] | None-> return (ContinueLoop [])) | Occurrence_inline_till chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some pos-> exec [ Edit (Zed (Zed_edit.Goto (pos-1))) ] | None-> return (ContinueLoop [])) | Occurrence_inline_till_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos-1) count with | Some pos-> exec [ Edit (Zed (Zed_edit.Goto (pos+1))) ] | None-> return (ContinueLoop [])) | Match-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.item_match ~start:0 ~stop pos text with | Some pos-> exec [ Edit (Zed (Zed_edit.Goto pos)) ] | None-> return (ContinueLoop [])) | _-> return (ContinueLoop [])) | Delete (register, motion, count)-> let delete= delete ~register in (match motion with | Left-> let pos, delta= Query.left count ctx in delete pos delta | Right-> let newline=true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in delete pos delta | Right_nl-> let newline= true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in exec [ Edit (Zed (Zed_edit.Goto pos)); Edit (Zed (Zed_edit.Kill_next_chars delta)); ] | Upward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let dest= max 0 (line - count) in let line_delta = line - dest in if line_delta > 0 then let pos_start= Zed_lines.line_start lines dest and pos_end= Zed_lines.line_stop lines line in let pos_delta= pos_end - pos_start in delete ~line:true pos_start pos_delta else return (ContinueLoop []) | Downward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line_count= Zed_lines.count lines in let line= Zed_edit.line ctx in let dest= min line_count (line + count) in let line_delta = dest - line in if line_delta > 0 then let pos_start= Zed_lines.line_start lines line and pos_end= Zed_lines.line_stop lines dest in let pos_end= if dest < line_count then pos_end + 1 else pos_end in let pos_delta= pos_end - pos_start in delete ~line:true pos_start pos_delta else return (ContinueLoop []) | Line-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line_count= Zed_lines.count lines in let line= Zed_edit.line ctx in let dest= min line_count (line + count - 1) in let pos_start= Zed_lines.line_start lines line and pos_end= Zed_lines.line_stop lines dest in let pos_delta= pos_end - pos_start in delete ~line:true pos_start pos_delta | Word-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in delete pos delta | WORD-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in delete pos delta | Word_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_word ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in delete prev_pos delta | WORD_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_WORD ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in delete prev_pos delta | Word_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in delete pos delta | WORD_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in delete pos delta | Word_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_word_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in delete dest delta | WORD_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_WORD_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in delete dest delta | Line_FirstChar-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let pos= Zed_edit.position ctx in let start= Zed_lines.line_start lines line in delete start (pos - start) | Line_FirstNonBlank-> let pos= Zed_edit.position ctx in let nonblank= Query.line_FirstNonBlank 1 ctx in (if nonblank < pos then delete nonblank (pos - nonblank) else delete pos (nonblank - pos)) | Line_LastChar-> let pos= Zed_edit.position ctx in let next= Query.line_LastChar count ctx in delete pos (next+1 - pos) | Line_LastChar_nl-> let newline= true in let pos= Zed_edit.position ctx in let next= Query.line_LastChar ~newline count ctx in delete pos (next+1 - pos) | Parenthesis_include-> pare_include Zed_char.(of_utf8 "(", of_utf8 ")") count delete | Parenthesis_inner-> pare_inner Zed_char.(of_utf8 "(", of_utf8 ")") count delete | Bracket_include-> pare_include Zed_char.(of_utf8 "[", of_utf8 "]") count delete | Bracket_inner-> pare_inner Zed_char.(of_utf8 "[", of_utf8 "]") count delete | AngleBracket_include-> pare_include Zed_char.(of_utf8 "<", of_utf8 ">") count delete | AngleBracket_inner-> pare_inner Zed_char.(of_utf8 "<", of_utf8 ">") count delete | Brace_include-> pare_include Zed_char.(of_utf8 "{", of_utf8 "}") count delete | Brace_inner-> pare_inner Zed_char.(of_utf8 "{", of_utf8 "}") count delete | Occurrence_inline chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some pos-> let start= Zed_edit.position ctx in let delta= pos+1 - start in delete start delta | None-> return (ContinueLoop [])) | Occurrence_inline_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos-1) count with | Some pos-> let stop= Zed_edit.position ctx in let delta= stop - pos in delete pos delta | None-> return (ContinueLoop [])) | Occurrence_inline_till chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos+1) count with | Some dest-> delete pos (dest - pos) | None-> return (ContinueLoop [])) | Occurrence_inline_till_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some dest-> delete (dest+1) (pos-1 - dest) | None-> return (ContinueLoop [])) | Match-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.item_match ~start:0 ~stop pos text with | Some dest-> (if dest > pos then delete pos (dest+1 - pos) else delete dest (pos+1 - dest)) | None-> return (ContinueLoop [])) | Word_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_word ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos-1 else pos-1 in if n >= 1 then match Query.include_word ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> delete word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | WORD_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos else pos-1 in if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> delete word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Word_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_word ~pos ~stop text with | Some (word_begin, word_end)-> delete word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | WORD_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_WORD ~pos ~stop text with | Some (word_begin, word_end)-> delete word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Quote_inner chr-> let quote= Zed_char.of_utf8 chr in pare_inner (quote, quote) 1 delete | Quote_include chr-> let quote= Zed_char.of_utf8 chr in pare_include (quote, quote) count delete | _-> return (ContinueLoop [])) | Change (register, motion, count)-> let change= change ~register in (match motion with | Left-> let pos, delta= Query.left count ctx in change pos delta | Right-> let newline= true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in change pos delta | Right_nl-> let newline= true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in exec [ Edit (Zed (Zed_edit.Goto pos)); Edit (Zed (Zed_edit.Kill_next_chars delta)); ] | Upward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let dest= max 0 (line - count) in let line_delta = line - dest in if line_delta > 0 then let pos_start= Zed_lines.line_start lines dest and pos_end= Zed_lines.line_stop lines line in let pos_delta= pos_end - pos_start in change ~line:true pos_start pos_delta else return (ContinueLoop []) | Downward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line_count= Zed_lines.count lines in let line= Zed_edit.line ctx in let dest= min line_count (line + count) in let line_delta = dest - line in if line_delta > 0 then let pos_start= Zed_lines.line_start lines line and pos_end= Zed_lines.line_stop lines dest in let pos_end= if dest < line_count then pos_end + 1 else pos_end in let pos_delta= pos_end - pos_start in change ~line:true pos_start pos_delta else return (ContinueLoop []) | Word-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in change pos delta | WORD-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in change pos delta | Word_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_word ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in change prev_pos delta | WORD_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_WORD ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in change prev_pos delta | Word_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in change pos delta | WORD_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in change pos delta | Word_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_word_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in change dest delta | WORD_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_WORD_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in change dest delta | Line_FirstChar-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let pos= Zed_edit.position ctx in let start= Zed_lines.line_start lines line in change start (pos - start) | Line_FirstNonBlank-> let pos= Zed_edit.position ctx in let nonblank= Query.line_FirstNonBlank 1 ctx in (if nonblank < pos then change nonblank (pos - nonblank) else change pos (nonblank - pos)) | Line_LastChar-> let pos= Zed_edit.position ctx in let next= Query.line_LastChar count ctx in change pos (next+1 - pos) | Line_LastChar_nl-> let newline= true in let pos= Zed_edit.position ctx in let next= Query.line_LastChar ~newline count ctx in change pos (next+1 - pos) | Parenthesis_include-> pare_include Zed_char.(of_utf8 "(", of_utf8 ")") count change | Parenthesis_inner-> pare_inner Zed_char.(of_utf8 "(", of_utf8 ")") count change | Bracket_include-> pare_include Zed_char.(of_utf8 "[", of_utf8 "]") count change | Bracket_inner-> pare_inner Zed_char.(of_utf8 "[", of_utf8 "]") count change | AngleBracket_include-> pare_include Zed_char.(of_utf8 "<", of_utf8 ">") count change | AngleBracket_inner-> pare_inner Zed_char.(of_utf8 "<", of_utf8 ">") count change | Brace_include-> pare_include Zed_char.(of_utf8 "{", of_utf8 "}") count change | Brace_inner-> pare_inner Zed_char.(of_utf8 "{", of_utf8 "}") count change | Occurrence_inline chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some pos-> let start= Zed_edit.position ctx in let delta= pos+1 - start in change start delta | None-> return (ContinueLoop [])) | Occurrence_inline_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos-1) count with | Some pos-> let stop= Zed_edit.position ctx in let delta= stop - pos in change pos delta | None-> return (ContinueLoop [])) | Occurrence_inline_till chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos+1) count with | Some dest-> change pos (dest - pos) | None-> return (ContinueLoop [])) | Occurrence_inline_till_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some dest-> change (dest+1) (pos-1 - dest) | None-> return (ContinueLoop [])) | Match-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.item_match ~start:0 ~stop pos text with | Some dest-> (if dest > pos then change pos (dest+1 - pos) else change dest (pos+1 - dest)) | None-> return (ContinueLoop [])) | Word_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_word ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos-1 else pos-1 in if n >= 1 then match Query.include_word ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> change word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | WORD_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos else pos-1 in if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> change word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Word_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_word ~pos ~stop text with | Some (word_begin, word_end)-> change word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | WORD_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_WORD ~pos ~stop text with | Some (word_begin, word_end)-> change word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Quote_inner chr-> let quote= Zed_char.of_utf8 chr in pare_inner (quote, quote) 1 change | Quote_include chr-> let quote= Zed_char.of_utf8 chr in pare_include (quote, quote) count change | _-> return (ContinueLoop [])) | Yank (register, motion, count)-> let yank= yank ~register in (match motion with | Left-> let pos, delta= Query.left count ctx in yank pos delta | Right-> let newline=true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in yank pos delta | Right_nl-> let newline= true in let pos, delta= Query.right ~newline count ctx in let pos= pos - delta in yank pos delta | Upward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let dest= max 0 (line - count) in let line_delta = line - dest in if line_delta > 0 then let pos_start= Zed_lines.line_start lines dest and pos_end= Zed_lines.line_stop lines line in let pos_delta= pos_end - pos_start in yank ~line:true pos_start pos_delta else return (ContinueLoop []) | Downward-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line_count= Zed_lines.count lines in let line= Zed_edit.line ctx in let dest= min line_count (line + count) in let line_delta = dest - line in if line_delta > 0 then let pos_start= Zed_lines.line_start lines line and pos_end= Zed_lines.line_stop lines dest in let pos_end= if dest < line_count then pos_end + 1 else pos_end in let pos_delta= pos_end - pos_start in yank ~line:true pos_start pos_delta else return (ContinueLoop []) | Line-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line_count= Zed_lines.count lines in let line= Zed_edit.line ctx in let dest= min line_count (line + count - 1) in let pos_start= Zed_lines.line_start lines line and pos_end= Zed_lines.line_stop lines dest in let pos_delta= pos_end - pos_start in yank ~line:true pos_start pos_delta | Word-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in yank pos delta | WORD-> let pos= Zed_edit.position ctx in let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= if count > 1 then Query.get_boundary true ctx else Query.get_boundary false ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD ~pos ~stop text) in next_word next (n-1) else pos in let next_pos = next_word pos count in let delta= next_pos - pos in yank pos delta | Word_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_word ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in yank prev_pos delta | WORD_back-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= max start (Query.prev_WORD ~pos ~start text) in prev_word prev (n-1) else pos in let prev_pos= prev_word pos count in let delta= pos - prev_pos in yank prev_pos delta | Word_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_word_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in yank pos delta | WORD_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let _start, stop= Query.get_boundary true ctx in let pos= Zed_edit.position ctx in let rec next_word pos n= if n > 0 && pos < stop then let next= (Query.next_WORD_end ~pos ~stop text) in next_word next (n-1) else pos in let next_pos= next_word pos count in let delta= next_pos + 1 - pos in yank pos delta | Word_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_word_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in yank dest delta | WORD_back_end-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in if Zed_rope.length text <= 0 then return (ContinueLoop []) else let start, stop= Query.get_boundary true ctx in let pos= min (stop - 1) (Zed_edit.position ctx) in let rec prev_word pos n= if n > 0 && pos > start then let prev= (Query.prev_WORD_end ~pos ~start text) in prev_word prev (n-1) else pos in let dest= prev_word pos count in let delta= pos - dest + 1 in yank dest delta | Line_FirstChar-> let edit= Zed_edit.edit ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let pos= Zed_edit.position ctx in let start= Zed_lines.line_start lines line in yank start (pos - start) | Line_FirstNonBlank-> let pos= Zed_edit.position ctx in let nonblank= Query.line_FirstNonBlank 1 ctx in if nonblank < pos then yank nonblank (pos - nonblank) else yank nonblank (pos - nonblank) | Line_LastChar-> let pos= Zed_edit.position ctx in let next= Query.line_LastChar count ctx in yank pos (next+1 - pos) | Line_LastChar_nl-> let newline= true in let pos= Zed_edit.position ctx in let next= Query.line_LastChar ~newline count ctx in yank pos (next+1 - pos) | Parenthesis_include-> pare_include Zed_char.(of_utf8 "(", of_utf8 ")") count yank | Parenthesis_inner-> pare_inner Zed_char.(of_utf8 "(", of_utf8 ")") count yank | Bracket_include-> pare_include Zed_char.(of_utf8 "[", of_utf8 "]") count yank | Bracket_inner-> pare_inner Zed_char.(of_utf8 "[", of_utf8 "]") count yank | AngleBracket_include-> pare_include Zed_char.(of_utf8 "<", of_utf8 ">") count yank | AngleBracket_inner-> pare_inner Zed_char.(of_utf8 "<", of_utf8 ">") count yank | Brace_include-> pare_include Zed_char.(of_utf8 "{", of_utf8 "}") count yank | Brace_inner-> pare_inner Zed_char.(of_utf8 "{", of_utf8 "}") count yank | Occurrence_inline chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some pos-> let start= Zed_edit.position ctx in let delta= pos+1 - start in yank start delta | None-> return (ContinueLoop [])) | Occurrence_inline_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx + 1 in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos-1) count with | Some pos-> let stop= Zed_edit.position ctx in let delta= stop - pos in yank pos delta | None-> return (ContinueLoop [])) | Occurrence_inline_till chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let stop= Zed_lines.line_stop lines line in let rec query_n chr pos n= if n < 1 then None else let next= Query.occurrence_char ~pos ~stop chr text in if n = 1 then next else match next with | Some next-> query_n chr (next+1) (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) (pos+1) count with | Some dest-> yank pos (dest - pos) | None-> return (ContinueLoop [])) | Occurrence_inline_till_back chr-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let lines= Zed_edit.lines edit in let line= Zed_edit.line ctx in let start= Zed_lines.line_start lines line in let rec query_n chr pos n= if n < 1 then None else let prev= Query.occurrence_char_back ~pos ~start chr text in if n = 1 then prev else match prev with | Some prev-> query_n chr prev (n-1) | None-> None in (match query_n (Zed_char.of_utf8 chr) pos count with | Some dest-> yank (dest+1) (pos-1 - dest) | None-> return (ContinueLoop [])) | Match-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.item_match ~start:0 ~stop pos text with | Some dest-> if dest > pos then yank pos (dest+1 - pos) else yank dest (pos+1 - dest) | None-> return (ContinueLoop [])) | Word_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_word ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos-1 else pos-1 in if n >= 1 then match Query.include_word ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> Zed_edit.copy_sequence ctx word_begin (word_end+1 - word_begin); return (ContinueLoop []) | None-> return (ContinueLoop [])) | WORD_include-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in let move_n pos n= let rec move_n pos n= if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (_word_begin, word_end)-> move_n (word_end+1) (n-1) | None-> pos else pos-1 in if n >= 1 then match Query.include_WORD ~stop ~pos text with | Some (word_begin, word_end)-> let word_end= move_n (word_end+1) (n - 1) in Some (word_begin, word_end) | None-> None else None in (match move_n pos count with | Some (word_begin, word_end)-> yank word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Word_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_word ~pos ~stop text with | Some (word_begin, word_end)-> yank word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | WORD_inner-> let edit= Zed_edit.edit ctx in let text= Zed_edit.text edit in let pos= Zed_edit.position ctx in let stop= Zed_rope.length text in (match Query.inner_WORD ~pos ~stop text with | Some (word_begin, word_end)-> yank word_begin (word_end+1 - word_begin) | None-> return (ContinueLoop [])) | Quote_inner chr-> let quote= Zed_char.of_utf8 chr in pare_inner (quote, quote) 1 yank | Quote_include chr-> let quote= Zed_char.of_utf8 chr in pare_include (quote, quote) count yank | _-> return (ContinueLoop [])) | Undo count-> exec @@ list_dup [ Edit (Zed (Zed_edit.Undo)); ] count >>= (fun r-> setup_pos () >>= fun _-> return r) | Paste_before (register, count)-> let action_paste= let open Vi.Interpret.Register in match vi_edit#get_register register with | Some (Seq str)-> [ Edit (Zed (Zed_edit.Insert_str (Zed_string.of_utf8 str))); Edit (Zed (Zed_edit.Prev_char)); ] | Some (Line str)-> [ Edit (Zed (Zed_edit.Goto_bol)); Edit (Zed (Zed_edit.Insert_str (Zed_string.of_utf8 (str ^ "\n")))); Edit (Zed (Zed_edit.Prev_line)); Edit (Zed (Zed_edit.Goto_eol)); Edit (Zed (Zed_edit.Prev_char)); ] | None-> [] in exec @@ list_dup action_paste count | Paste_after (register, count)-> let action_paste= let open Vi.Interpret.Register in match vi_edit#get_register register with | Some (Seq str)-> let actions= [ Edit (Zed (Zed_edit.Insert_str (Zed_string.of_utf8 str))); Edit (Zed (Zed_edit.Prev_char)); ] in if Zed_edit.at_eol ctx then actions else Edit (Zed (Zed_edit.Next_char)) :: actions | Some (Line str)-> [ Edit (Zed (Zed_edit.Goto_eol)); Edit (Zed (Zed_edit.Insert_str (Zed_string.of_utf8 ("\n" ^ (String.sub str 0 (String.length str)))))); Edit (Zed (Zed_edit.Goto_eol)); Edit (Zed (Zed_edit.Prev_char)); ] | None-> [] in exec @@ list_dup action_paste count | Join count-> exec @@ (list_make (Edit (Zed (Zed_edit.Join_line))) count) | DeleteSelected register-> let delete= delete ~register in let edit= Zed_edit.edit ctx in if Zed_edit.get_selection edit then let a = Zed_edit.position ctx and b = Zed_cursor.get_position (Zed_edit.mark edit) in let a = min a b and b = max a b in delete a (b+1 - a) else return (ContinueLoop []) | YankSelected register-> let yank= yank ~register in let edit= Zed_edit.edit ctx in if Zed_edit.get_selection edit then let a = Zed_edit.position ctx and b = Zed_cursor.get_position (Zed_edit.mark edit) in let a = min a b and b = max a b in yank a (b+1 - a) else return (ContinueLoop []) | ChangeMode mode-> let edit= Zed_edit.edit ctx in (match mode with | Insert-> Zed_edit.set_selection edit false | Normal-> Zed_edit.set_selection edit false | Visual-> Zed_edit.set_mark ctx | Commandline-> Zed_edit.set_selection edit false); return (ContinueLoop []) lambda-term-3.1.0/src/lTerm_vi.mli000066400000000000000000000306721366433625400167770ustar00rootroot00000000000000(* * lTerm_vi.mli * ------------ * Copyright : (c) 2020, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) module Concurrent : sig module Thread : sig type 'a t = 'a Lwt.t val bind : 'a t -> ('a -> 'b t) -> 'b t val return : 'a -> 'a t val both : 'a t -> 'b t -> ('a * 'b) t val join : unit t list -> unit t val pick : 'a t list -> 'a t val choose : 'a t list -> 'a t val async : (unit -> unit t) -> unit val cancel : 'a t -> unit val sleep : float -> unit t val run : 'a t -> 'a end module MsgBox : sig type 'a t = 'a Lwt_mvar.t val create : unit -> 'a t val put : 'a t -> 'a -> unit Lwt.t val get : 'a t -> 'a Lwt.t end end module Query : sig val left : int -> 'a Zed_edit.context -> int * int val right : ?newline:bool -> int -> 'a Zed_edit.context -> int * int val line_FirstChar : 'a -> 'b Zed_edit.context -> int * int val line_LastChar : ?newline:bool -> int -> 'a Zed_edit.context -> int val get_category : ?nl_as_sp:bool -> CamomileLibrary.UChar.t -> CamomileLibraryDefault.Camomile.UCharInfo.general_category_type val get_boundary : bool -> 'a Zed_edit.context -> int * int val is_space : [> `Cc | `Mn | `Zl | `Zp | `Zs ] -> bool val is_not_space : [> `Cc | `Mn | `Zl | `Zp | `Zs ] -> bool val category_equal : ([> `Ll | `Lu ] as 'a) -> 'a -> bool val category_equal_blank : [> `Cc | `Mn | `Zl | `Zp | `Zs ] -> [> `Cc | `Mn | `Zl | `Zp | `Zs ] -> bool val next_category : ?nl_as_sp:bool -> ?is_equal:(CamomileLibraryDefault.Camomile.UCharInfo.general_category_type -> CamomileLibraryDefault.Camomile.UCharInfo.general_category_type -> bool) -> pos:int -> stop:int -> Zed_rope.t -> int val prev_category : ?nl_as_sp:bool -> ?is_equal:(CamomileLibraryDefault.Camomile.UCharInfo.general_category_type -> CamomileLibraryDefault.Camomile.UCharInfo.general_category_type -> bool) -> pos:int -> start:int -> Zed_rope.t -> int val goto_line : 'a Zed_edit.context -> int -> int val next_line : 'a Zed_edit.context -> int -> int val prev_line : 'a Zed_edit.context -> int -> int val next_word' : ?multi_line:bool -> next_category:(nl_as_sp:bool -> pos:int -> stop:int -> Zed_rope.t -> int) -> pos:int -> stop:int -> Zed_rope.t -> int val next_word : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> int val next_WORD : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> int val line_FirstNonBlank : 'a -> 'b Zed_edit.context -> int val prev_word' : ?multi_line:bool -> prev_category:(nl_as_sp:bool -> pos:int -> start:int -> Zed_rope.t -> int) -> pos:int -> start:int -> Zed_rope.t -> int val prev_word : ?multi_line:bool -> pos:int -> start:int -> Zed_rope.t -> int val prev_WORD : ?multi_line:bool -> pos:int -> start:int -> Zed_rope.t -> int val next_word_end' : ?multi_line:bool -> next_category:(nl_as_sp:bool -> pos:int -> stop:int -> Zed_rope.t -> int) -> pos:int -> stop:int -> Zed_rope.t -> int val next_word_end : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> int val next_WORD_end : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> int val prev_word_end' : ?multi_line:bool -> prev_category:(nl_as_sp:bool -> pos:int -> start:int -> Zed_rope.t -> int) -> pos:int -> start:int -> Zed_rope.t -> int val prev_word_end : ?multi_line:bool -> pos:int -> start:int -> Zed_rope.t -> int val prev_WORD_end : ?multi_line:bool -> pos:int -> start:int -> Zed_rope.t -> int val occurrence_char : pos:int -> stop:int -> Zed_char.t -> Zed_rope.t -> int option val occurrence_char_back : pos:int -> start:int -> Zed_char.t -> Zed_rope.t -> int option val occurrence : pos:int -> stop:int -> cmp:(Zed_char.t -> bool) -> Zed_rope.t -> (int * Zed_char.t) option val occurrence_back : pos:int -> start:int -> cmp:(Zed_char.t -> bool) -> Zed_rope.t -> (int * Zed_char.t) option val occurrence_pare_raw : pos:int -> level:int -> start:int -> stop:int -> Zed_char.t * Zed_char.t -> Zed_rope.t -> (int * int) option val occurrence_pare : pos:int -> level:int -> start:int -> stop:int -> Zed_char.t * Zed_char.t -> Zed_rope.t -> (int * int) option val item_match : start:int -> stop:int -> int -> Zed_rope.t -> int option val include_word' : ?multi_line:bool -> next_category:(nl_as_sp:bool -> pos:int -> stop:int -> Zed_rope.t -> int) -> pos:int -> stop:int -> Zed_rope.t -> (int * int) option val include_word : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> (int * int) option val include_WORD : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> (int * int) option val inner_word' : ?multi_line:bool -> prev_category:(nl_as_sp:bool -> pos:int -> start:int -> Zed_rope.t -> int) -> next_category:(nl_as_sp:bool -> pos:int -> stop:'a -> Zed_rope.t -> int) -> pos:int -> stop:'a -> Zed_rope.t -> (int * int) option val inner_word : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> (int * int) option val inner_WORD : ?multi_line:bool -> pos:int -> stop:int -> Zed_rope.t -> (int * int) option end module Vi : sig module Edit_action = Mew_vi.Edit_action module Vi_action = Mew_vi.Vi_action module Base : sig module Key : sig type t = Mew_vi.Modal.Key.t type code = Mew_vi.Modal.Key.code type modifier = Mew_vi.Modal.Key.modifier type modifiers = Mew_vi.Modal.Key.modifiers val create : code:code -> modifiers:modifiers -> t val create_modifiers : modifier list -> modifiers val code : t -> code val modifiers : t -> modifiers val modifier : key:t -> modifier:modifier -> bool val compare : t -> t -> int val to_string : t -> string val equal : t -> t -> bool val hash : t -> int end module Mode : sig module KeyTrie : Trie.Intf with type path = Key.t list type name = Mew_vi.Modal.Name.t type action = | Switch of name | Key of Key.t | KeySeq of Key.t Queue.t | Custom of (unit -> unit) type t = { name : name; timeout : float option; bindings : action KeyTrie.node; } module Modes : Map.S with type key= name type modes = t Modes.t val name : t -> name val timeout : t -> float option val bindings : t -> action KeyTrie.node val compare : t -> t -> int val default_mode : 'a Modes.t -> name * 'a val bind : t -> KeyTrie.path -> action -> unit val unbind : t -> KeyTrie.path -> unit end val ( >>= ) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t class edit : < default_mode : 'a * Mode.t; modes : Mode.t Mode.Modes.t; timeout : float; .. > -> object val mutable curr_mode : Mode.t val i : Key.t Lwt_mvar.t val o : Key.t Lwt_mvar.t method bindings : Mode.action Mode.KeyTrie.node method getMode : Mode.t method i : Key.t Lwt_mvar.t method keyin : Key.t -> unit Lwt.t method o : Key.t Lwt_mvar.t method setMode : Mode.name -> unit method timeout : float end class state : Mode.t Mew_vi.Modal.Mode.Modes.t -> object val mutable default_mode : Mew_vi.Modal.Mode.Modes.key * Mode.t val mutable timeout : float method default_mode : Mew_vi.Modal.Mode.Modes.key * Mode.t method edit : edit method modes : Mode.t Mode.Modes.t method timeout : float end end module Interpret : sig module Register : sig type t= string type content= Seq of string | Line of string val compare_content : content -> content -> int end module RegisterMap : Map.S with type key = Register.t val ( >>= ) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t type register= string option type count= int option type keyseq= Base.Key.t list module Resolver : sig type t= config -> status -> keyseq -> result and config= { mode: Mew_vi.Mode.Name.t React.signal; set_mode: ?step:React.step -> Mew_vi.Mode.Name.t -> unit; keyseq: keyseq React.signal; set_keyseq: ?step:React.step -> keyseq -> unit; mutable resolver_insert: t; mutable resolver_normal: t; mutable resolver_visual: t; mutable resolver_command: t; } and status= { register: register; count: count; } and result= | Accept of (Edit_action.t * keyseq * Mew_vi.Mode.Name.t) | Continue of (t * status * keyseq) | Rejected of keyseq val resolver_dummy : t val resolver_insert : t module Common : sig val try_count : t -> t val try_motion : Mew_vi.Mode.name -> t end module Normal : sig val try_change_mode : t val try_modify : t val try_insert : t val try_motion_modify_insert : t val resolver_normal : t end module Visual : sig val try_change_mode : t val try_motion : t val try_modify : t val try_motion_modify : t val resolver_visual : t end val make_config : ?mode:Mew_vi.Mode.Name.t -> ?keyseq:keyseq -> ?resolver_insert:t -> ?resolver_normal:t -> ?resolver_visual:t -> ?resolver_command:t -> unit -> config val interpret : ?resolver:t -> ?keyseq:keyseq -> config -> status -> Base.Key.t Lwt_mvar.t -> Edit_action.t Lwt_mvar.t -> unit -> 'a Lwt.t end end end class edit : state -> object val action_output : Vi.Edit_action.t Lwt_mvar.t val mutable curr_mode : Vi.Base.Mode.t val i : Mew_vi.Key.t Lwt_mvar.t val o : Mew_vi.Key.t Lwt_mvar.t val config : Vi.Interpret.Resolver.config method action_output : Vi.Edit_action.t Lwt_mvar.t method bindings : Vi.Base.Mode.action Vi.Base.Mode.KeyTrie.node method getMode : Vi.Base.Mode.t method i : Mew_vi.Key.t Lwt_mvar.t method keyin : Mew_vi.Key.t -> unit Lwt.t method o : Mew_vi.Key.t Lwt_mvar.t method setMode : Vi.Base.Mode.name -> unit method timeout : float method get_register : string -> Vi.Interpret.Register.content option method set_register : string -> Vi.Interpret.Register.content -> unit end and state : object val mutable default_mode : Vi.Base.Mode.name * Vi.Base.Mode.t val mutable timeout : float method default_mode : Vi.Base.Mode.name * Vi.Base.Mode.t method edit : Vi.Base.edit method modes : Vi.Base.Mode.t Vi.Base.Mode.Modes.t method timeout : float method get_register : string -> Vi.Interpret.Register.content option method set_register : string -> Vi.Interpret.Register.content -> unit method get_registers : Vi.Interpret.Register.content Vi.Interpret.RegisterMap.t method set_registers : Vi.Interpret.Register.content Vi.Interpret.RegisterMap.t -> unit method vi_edit : edit end val of_lterm_code : LTerm_key.code -> Mew_vi.Key.code val of_vi_code : Mew_vi.Key.code -> LTerm_key.code val of_lterm_key : LTerm_key.t -> Mew_vi.Key.t val of_vi_key : Mew_vi.Key.t -> LTerm_key.t open LTerm_read_line_base val perform : edit -> 'a Zed_edit.context -> (action list -> 'b loop_result Lwt.t) -> Vi.Vi_action.t -> 'b loop_result Lwt.t lambda-term-3.1.0/src/lTerm_widget.ml000066400000000000000000000003241366433625400174620ustar00rootroot00000000000000(* * lTerm_widget.ml * --------------- * Copyright : (c) 2019, ZAN DoYe * Licence : BSD3 * * This file is a part of Lambda-Term. *) include LTerm_widget_impl.Make(LiteralIntf.UTF8) lambda-term-3.1.0/src/lTerm_widget.mli000066400000000000000000000402021366433625400176320ustar00rootroot00000000000000(* * lTerm_widget.mli * ---------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Widgets for creating applications *) (** {6 Base class} *) (** The base class. The parameter is the initial resource class. The resource class is the first part of all resource keys used by the widget. For examples, buttons use the resources ["button.focused.foreground"], ["button.unfocused.bold"], ... so their resource class is ["button"]. *) class t : string -> object method children : t list (** The children of the widget. *) method parent : t option (** The parent of the widget, if any. *) method set_parent : t option -> unit (** Sets the parent of the widget. This also affect {!queue_draw}. *) method can_focus : bool (** Whether the widget can receive the focus or not. *) method focus : t option LTerm_geom.directions (** Specify a target widget to the left, right, up and/or down when changing focus. *) method set_focus : t option LTerm_geom.directions -> unit (** Sets the target widgets when changing focus. *) method queue_draw : unit (** Enqueue a redraw operation. If the widget has a parent, this is the same as calling the {!queue_draw} method of the parent, otherwise this does nothing. *) method set_queue_draw : (unit -> unit) -> unit (** [set_queue_draw f] sets the function called when the {!queue_draw} method is invoked, for this widget and all its children. *) method draw : LTerm_draw.context -> t -> unit (** [draw ctx focused] draws the widget on the given context. [focused] is the focused widget. *) method cursor_position : LTerm_geom.coord option (** Method invoked when the widget has the focus, it returns the position of the cursor inside the widget if it should be displayed. *) method allocation : LTerm_geom.rect (** The zone occuped by the widget. *) method set_allocation : LTerm_geom.rect -> unit (** Sets the zone occuped by the widget. *) method send_event : LTerm_event.t -> unit (** Send an event to the widget. If the widget cannot process the event, it is sent to the parent and so on. *) method on_event : ?switch : LTerm_widget_callbacks.switch -> (LTerm_event.t -> bool) -> unit (** [on_event ?switch f] calls [f] each time an event is received. If [f] returns [true], the event is not passed to other callbacks. *) method size_request : LTerm_geom.size (** The size wanted by the widget. *) method resources : LTerm_resources.t (** The set of resources used by the widget. *) method set_resources : LTerm_resources.t -> unit (** Sets the resources of the widget and of all its children. *) method resource_class : string (** The resource class of the widget. *) method set_resource_class : string -> unit (** Sets the resource class of the widget. This can be used to set an alternative style for the widget. *) method update_resources : unit (** Method invoked when the resources or the resource class of the widget change. The default function does nothing. *) end (** {6 Labels} *) (** A widget displaying a text. *) class label : string -> object inherit t method text : string (** The text of the label. *) method set_alignment : LTerm_geom.horz_alignment -> unit (** Set text alignment. *) method set_text : string -> unit end (** {6 Containers} *) exception Out_of_range (** Type of widgets displaying a list of widget. *) class type box = object inherit t method add : ?position : int -> ?expand : bool -> #t -> unit (** [add ?position ?expand widget] adds a widget to the box. If [expand] is [true] (the default) then [widget] will occupy as much space as possible. If [position] is not specified then the widget is appended to the end of the widget list. It raises {!Out_of_range} if the given position is negative or exceed the number of widgets. *) method remove : #t -> unit (** [remove widget] remove a widget from the box. *) end (** A widget displaying a list of widgets, listed horizontally. *) class hbox : box (** A widget displaying a list of widgets, listed vertically. *) class vbox : box (** A widget displayiing another widget in a box. *) class frame : object inherit t method set : #t -> unit (** Set the widget that is inside the frame. *) method empty : unit (** Remove the child of the frame. *) method set_label : ?alignment:LTerm_geom.horz_alignment -> string -> unit (** Set label rendered in the top row of the frame *) end (** A widget displaying a frame around child widget. Unlike {!frame}, the child widget is not expanded to take all available space; instead the child is centered and frame is drawn around it. This is a utility class for creation of modal dialogs and similar widgets. *) class modal_frame : object inherit frame end (** A widget used for layout control within boxes *) class spacing : ?rows:int -> ?cols:int -> unit -> t (** {6 Lines} *) (** A horizontal line. *) class hline : t (** A vertical line. *) class vline : t (** {6 Buttons} *) (** Normal button. *) class button : ?brackets:(string * string) -> string -> object inherit t method label : string (** The text displayed on the button. *) method label_zed : Zed_string.t (** The text displayed on the button. *) method set_label : string -> unit method on_click : ?switch : LTerm_widget_callbacks.switch -> (unit -> unit) -> unit (** [on_click ?switch f] calls [f] when the button is clicked. *) end (** Checkbutton. A button that can be in active or inactive state. *) class checkbutton : string -> bool -> object inherit t method label : string (** The text displayed on the checkbutton. *) method label_zed : Zed_string.t (** The text displayed on the button. *) method state : bool (** The state of checkbutton; [true] means checked and [false] means unchecked. *) method set_label : string -> unit method on_click : ?switch : LTerm_widget_callbacks.switch -> (unit -> unit) -> unit (** [on_click ?switch f] calls [f] when the button state is changed. *) end class type ['a] radio = object method on : unit method off : unit method id : 'a end (** Radio group. Radio group governs the set of {!radio} objects. At each given moment of time only one of the objects in the "on" state and the rest are in the "off" state. *) class ['a] radiogroup : object method on_state_change : ?switch : LTerm_widget_callbacks.switch -> ('a option -> unit) -> unit (** [on_state_change ?switch f] calls [f] when the state of the group is changed. *) method state : 'a option (** The state of the group. Contains [Some id] with the id of "on" object in the group or None if no objects were added to the group yet. *) method register_object : 'a radio -> unit (** Adds radio object to the group *) method switch_to : 'a -> unit (** [switch_to id] switches radio group to the state [Some id], calls {!radio.on} method of the object with the given id and {!radio.off} method of all other objects added to the group. *) end (** Radiobutton. The button which implements {!radio} object contract, so can be added to {!radiogroup}. *) class ['a] radiobutton : 'a radiogroup -> string -> 'a -> object inherit t method state : bool (** The state of the button; [true] if button is "on" and [false] if the button is "off". *) method on : unit (** Switches the button state to "on". Affects only how the button is drawn, does not change the state of the group the button is added to. Use {!radiogroup.switch_to} instead. *) method off : unit (** Switches the button state to "off". Affects only how the button is drawn, does not change the state of the group the button is added to. Use {!radiogroup.switch_to} instead. *) method label : string (** The text displayed on the radiobutton. *) method label_zed : Zed_string.t (** The text displayed on the button. *) method set_label : string -> unit method id : 'a (** The id of the button. *) method on_click : ?switch:LTerm_widget_callbacks.switch -> (unit -> unit) -> unit (** [on_click ?switch f] calls [f] when the button is clicked. You probably want to use {!radiogroup.on_state_change} instead. *) end (** {6 Scrollbars} *) (** Adjustable integer value from (0..range-1) *) class adjustment : object method range : int (** range of adjustment *) method set_range : ?trigger_callback:bool -> int -> unit (** set range of adjustment. *) method offset : int (** offset from (0..range-1) *) method set_offset : ?trigger_callback:bool -> int -> unit (** Set offset clipped to range. *) method on_offset_change : ?switch:LTerm_widget_callbacks.switch -> (int -> unit) -> unit (** [on_offset_change ?switch f] calls f when the offset changes. *) end (** Interface between an adjustment and a scrollbar widget. *) class type scrollable_adjustment = object inherit adjustment method incr : int (** Return offset incremented by one step If range > number of scroll bar steps then step>=1. *) method decr : int (** Return offset decremented by one step *) method mouse_scroll : int -> int (** [adj#mouse_scroll offset] computes the scroll bar based on a click [offset] units from the top/left *) method set_scroll_bar_mode : [ `fixed of int | `dynamic of int ] -> unit (** Configure how the size of the scrollbar is calculated. [`fixed x] sets the size to x. [`dynamic 0] sets the size to reflect the ratio between the range and scroll window size. [`dynamic x] (x>0) interprets [x] as the viewable size and sets the size of the scroll bar to reflect the amount of content displayed relative to range. *) method set_mouse_mode : [ `middle | `ratio | `auto ] -> unit (** Configure how a mouse coordinate is converted to a scroll bar offest. [`middle] sets the middle of the scrollbar to the position clicked. [`ratio] computes the offset relative to the scroll bar and scroll window sizes, with a 10% deadzone at the extremities. [`auto] chooses [`middle] mode if the scroll bar size is less than half the window size and [`ratio] otherwise. *) method set_min_scroll_bar_size : int -> unit (** Set the minimum scroll bar size (default:1) *) method set_max_scroll_bar_size : int -> unit (** Set the maximum scroll bar size (default: scroll window size *) method on_scrollbar_change : ?switch:LTerm_widget_callbacks.switch -> (unit -> unit) -> unit (** [on_scrollbar_change ?switch f] calls f when the scrollbar is changed and needs to be re-drawn. *) end (* Automatic configuration of the scrollbar. The [set_page_size] and [set_document_size] methods will configure the scrollbar to reflect the currently viewed area of a document. [calculate_range] can be overriden to configure how much extra space is shown at the end of a document. By default the last line of a document will be shown at the bottom of the viewable area using [range = document_size - page_size + 1] *) class type scrollable_document = object method page_size : int (** Viewable size *) method set_page_size : int -> unit (** Set viewable size *) method document_size : int (** Document size *) method set_document_size : int -> unit (** Set document size *) method page_next : int (** Offset of next page *) method page_prev : int (** Offset of previous page *) method calculate_range : int -> int -> int (** [calculate_range page_size document_size] returns the range used by the scrollbar. *) end (** Interface used by the scrollbar widget to configure the scrollbar and get parameters needed for rendering *) class type scrollable_private = object method set_scroll_window_size : int -> unit (** The attached scroll bar needs to provide its window size during [set_allocation] *) method get_render_params : int * int * int (** Provide the scroll bar with rendering parameters *) end (** Main object implementing scroll logic for coordination between a scrollable wigdet and a scrollbar widget. [scrollable_adjustment] implements the main logic and provides a lowlevel interface for controlling how mouse events are translated to scroll offsets ([set_mouse_mode]) and the size of the scrollbar ([set_scroll_bar_mode]). [scrollable_document] provides a higher level interface for configuring the operation of the scrollbar where the scrollbar is used to reflect the area of a page within a potentially larger document. [scrollbar_private] is an internal interface between the [scrollable] object and a [scrollbar] used to exchange parameters needed to perform rendering. *) class scrollable : object inherit scrollable_adjustment inherit scrollable_document inherit scrollable_private end (** Events exposed by scrollbar widgets. These may be applied to other widgets if required. *) class type default_scroll_events = object method mouse_event : LTerm_event.t -> bool method scroll_key_event : LTerm_event.t -> bool end (** Vertical scrollbar widget. [rc] is the resource class of the widget. [".(un)focused"] sets the (un)focused style of the widget. [".barstyle"] can be [filled] or [outline]. [".track"] is a bool to display a central track line. [default_event_handler] when true (the default) installs the [mouse_event] and [scroll_key_event] handlers. [width] (resp. [height]) defines the prefered thickness of the scrollbar. *) class vscrollbar : ?rc:string -> ?default_event_handler:bool -> ?width:int -> #scrollable -> object inherit t inherit default_scroll_events end (** Horizontal scrollbar widget. *) class hscrollbar : ?rc:string -> ?default_event_handler:bool -> ?height:int -> #scrollable -> object inherit t inherit default_scroll_events end (** Vertical slider widget. *) class vslider : int -> object inherit t inherit adjustment inherit default_scroll_events end (** Horizontal slider widget. *) class hslider : int -> object inherit t inherit adjustment inherit default_scroll_events end (** {6 Running in a terminal} *) val run : LTerm.t -> ?save_state : bool -> ?load_resources : bool -> ?resources_file : string -> #t -> 'a Lwt.t -> 'a Lwt.t (** [run term ?save_state widget w] runs on the given terminal using [widget] as main widget. It returns when [w] terminates. If [save_state] is [true] (the default) then the state of the terminal is saved and restored when [w] terminates. If [load_resources] is [true] (the default) then [resources_file] (which default to ".lambda-termrc" in the home directory) is loaded and the result is set to [w]. *) val run_modal : LTerm.t -> ?save_state : bool -> ?load_resources : bool -> ?resources_file : string -> t Lwt_react.event -> unit Lwt_react.event -> #t -> 'a Lwt.t -> 'a Lwt.t (** This function works in the same way as {!run} but also takes two {!Lwt_react.event} parameters. The first one should contain {!LTerm_widget.t} widget and makes it new topmost layer in UI. The second message removes the topmost level from UI. All layers are redrawn, from bottom to up, but only the topmost layer gets keyboard events delivered to it. This allows to implement things like modal dialogs. *) val prepare_simple_run : unit -> (#t -> 'a Lwt.t) * (#t -> unit -> unit) * (?step:React.step -> unit -> unit) * ('a -> unit) (** [prepare_simple_run ()] returns a tuple [(do_run, push_layer, pop_layer, exit)] -- functions useful for creating simple UI. [do_run w] where w is a widget runs the given widget in a terminal over stdout, loading resources from [.lambda-termrc], saving state and restoring it on exit from ui. Example: [do_run my_frame] [push_layer w] where w is a widget is a callback to add w as a new modal layer to UI. Example: [button#on_click (push_layer my_modal_dialog)]. [pop_layer] is a callback to destroy the topmost modal layer. Example: [cancel_button#on_click pop_layer]. [exit] is a callback to exit the UI. Example: [exit_button#on_click exit] *) lambda-term-3.1.0/src/lTerm_widget_base_impl.ml000066400000000000000000000055371366433625400215100ustar00rootroot00000000000000(* * lTerm_widget_base_impl.ml * --------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open LTerm_widget_callbacks open LTerm_geom class t initial_resource_class : object method children : t list method parent : t option method set_parent : t option -> unit method can_focus : bool method focus : t option LTerm_geom.directions method set_focus : t option LTerm_geom.directions -> unit method queue_draw : unit method set_queue_draw : (unit -> unit) -> unit method draw : LTerm_draw.context -> t -> unit method cursor_position : coord option method allocation : rect method set_allocation : rect -> unit method send_event : LTerm_event.t -> unit method on_event : ?switch : switch -> (LTerm_event.t -> bool) -> unit method size_request : size method resources : LTerm_resources.t method set_resources : LTerm_resources.t -> unit method resource_class : string method set_resource_class : string -> unit method update_resources : unit end = object(self) method children : t list = [] method can_focus = false val mutable focus = LTerm_geom.({ left=None; right=None; up=None; down=None }) method focus = focus method set_focus f = let check = function None -> () | Some(x) -> if not ((x : t)#can_focus) then failwith "set_focus: target widget must have can_focus=true" in check f.left; check f.right; check f.up; check f.down; focus <- f val mutable parent : t option = None method parent = parent method set_parent opt = parent <- opt val mutable queue_draw = ignore method queue_draw = queue_draw () method set_queue_draw f = queue_draw <- f; List.iter (fun w -> w#set_queue_draw f) self#children method draw (_ : LTerm_draw.context) (_focused : t) = () method cursor_position = None val mutable allocation = { row1 = 0; col1 = 0; row2 = 0; col2 = 0 } method allocation = allocation method set_allocation rect = allocation <- rect val event_filters = LTerm_widget_callbacks.create () method send_event ev = if not (exec_filters event_filters ev) then match parent with | Some widget -> widget#send_event ev | None -> () method on_event ?switch f = register switch event_filters f val size_request = { rows = 0; cols = 0 } method size_request = size_request val mutable resource_class = initial_resource_class method resource_class = resource_class method set_resource_class rc = resource_class <- rc; self#update_resources val mutable resources = LTerm_resources.empty method resources = resources method set_resources res = resources <- res; self#update_resources; List.iter (fun w -> w#set_resources res) self#children method update_resources = () end lambda-term-3.1.0/src/lTerm_widget_callbacks.ml000066400000000000000000000031051366433625400214610ustar00rootroot00000000000000(* * lTerm_widget_callbacks.ml * --------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) let section = Lwt_log.Section.make "lambda-term(widget_callbacks)" (* +-----------------------------------------------------------------+ | Callbacks | +-----------------------------------------------------------------+ *) type switch = { mutable switch_state : (unit -> unit) list option } type 'a callbacks = 'a LTerm_dlist.t let create () = LTerm_dlist.create () let register switch_opt seq f = match switch_opt with | None -> ignore (LTerm_dlist.add_l f seq) | Some switch -> match switch.switch_state with | Some l -> let node = LTerm_dlist.add_l f seq in switch.switch_state <- Some ((fun () -> LTerm_dlist.remove node) :: l) | None -> () let stop switch = match switch.switch_state with | Some l -> switch.switch_state <- None; List.iter (fun f -> f ()) l | None -> () let exec_callbacks seq x = LTerm_dlist.iter_l (fun f -> try f x with exn -> ignore (Lwt_log.error ~section ~exn "callback failed with")) seq let exec_filters seq x = LTerm_dlist.fold_l (fun f acc -> if acc then true else begin try f x with exn -> ignore (Lwt_log.error ~section ~exn "filter failed with"); false end) seq false lambda-term-3.1.0/src/lTerm_widget_callbacks.mli000066400000000000000000000010501366433625400216270ustar00rootroot00000000000000(* * lTerm_widget_callbacks.mli * ---------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) type switch (** Switches are used to stop signals. *) type 'a callbacks val create : unit -> 'a callbacks val register : switch option -> 'a callbacks -> 'a -> unit (** *) val stop : switch -> unit (** *) val exec_callbacks : ('a -> unit) callbacks -> 'a -> unit (** [apply_callbacks callbacks x] *) val exec_filters : ('a -> bool) callbacks -> 'a -> bool lambda-term-3.1.0/src/lTerm_widget_impl.ml000066400000000000000000000161731366433625400205140ustar00rootroot00000000000000(* * lTerm_widget.ml * --------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) module Make (LiteralIntf: LiteralIntf.Type) = struct open LTerm_geom open LTerm_draw (* +-----------------------------------------------------------------+ | The widget class | +-----------------------------------------------------------------+ *) class t = LTerm_widget_base_impl.t (* +-----------------------------------------------------------------+ | Labels | +-----------------------------------------------------------------+ *) let newline = Zed_char.unsafe_of_char '\n' let text_size str = let rec loop ofs rows cols max_cols = if ofs = Zed_string.bytes str then { rows; cols = max cols max_cols } else let chr, ofs = Zed_string.extract_next str ofs in if chr = newline then if ofs = Zed_string.bytes str then { rows; cols = max cols max_cols } else loop ofs (rows + 1) 0 (max cols max_cols) else let width= max (Zed_char.width chr) 0 in loop ofs rows (cols + width) max_cols in loop 0 1 0 0 class label initial_text = object(self) inherit t "label" val mutable text = LiteralIntf.to_string_exn initial_text val mutable size_request = text_size (LiteralIntf.to_string_exn initial_text) method! size_request = size_request val mutable style = LTerm_style.none method! update_resources = style <- LTerm_resources.get_style self#resource_class self#resources method text = LiteralIntf.of_string text method set_text t = let t= LiteralIntf.to_string_exn t in text <- t; size_request <- text_size t; self#queue_draw val mutable alignment = H_align_center method set_alignment a = alignment <- a method! draw ctx _focused = let { rows ; _ } = LTerm_draw.size ctx in let row = (rows - size_request.rows) / 2 in LTerm_draw.fill_style ctx style; LTerm_draw.draw_string_aligned ctx row alignment text end (* +-----------------------------------------------------------------+ | Boxes | +-----------------------------------------------------------------+ *) module LTerm_containers = LTerm_containers_impl.Make(LiteralIntf) exception Out_of_range = LTerm_containers.Out_of_range class type box = LTerm_containers.box class hbox = LTerm_containers.hbox class vbox = LTerm_containers.vbox class frame = LTerm_containers.frame class modal_frame = LTerm_containers.modal_frame (* +-----------------------------------------------------------------+ | Spacing for layout control (aka glue) | +-----------------------------------------------------------------+ *) class spacing ?(rows=0) ?(cols=0) () = object inherit t "glue" val size_request = { rows; cols } method! size_request = size_request end (* +-----------------------------------------------------------------+ | Lines | +-----------------------------------------------------------------+ *) class hline = object(self) inherit t "hline" val size_request = { rows = 1; cols = 0 } method! size_request = size_request val mutable style = LTerm_style.none val mutable connection = LTerm_draw.Light method! update_resources = let rc = self#resource_class and resources = self#resources in style <- LTerm_resources.get_style rc resources; connection <- LTerm_resources.get_connection (rc ^ ".connection") resources method! draw ctx _focused = let { rows ; _ } = LTerm_draw.size ctx in LTerm_draw.fill_style ctx style; draw_hline ctx (rows / 2) 0 (LTerm_draw.size ctx).cols connection end class vline = object(self) inherit t "vline" val size_request = { rows = 0; cols = 1 } method! size_request = size_request val mutable style = LTerm_style.none val mutable connection = LTerm_draw.Light method! update_resources = let rc = self#resource_class and resources = self#resources in style <- LTerm_resources.get_style rc resources; connection <- LTerm_resources.get_connection (rc ^ ".connection") resources method! draw ctx _focused = let { cols ; _ } = LTerm_draw.size ctx in LTerm_draw.fill_style ctx style; draw_vline ctx 0 (cols / 2) (LTerm_draw.size ctx).rows connection end (* +-----------------------------------------------------------------+ | Buttons | +-----------------------------------------------------------------+ *) module LTerm_buttons = LTerm_buttons_impl.Make(LiteralIntf) class button = LTerm_buttons.button class checkbutton = LTerm_buttons.checkbutton class type ['a] radio = ['a] LTerm_buttons.radio class ['a] radiogroup = ['a] LTerm_buttons.radiogroup class ['a] radiobutton = ['a] LTerm_buttons.radiobutton (* +-----------------------------------------------------------------+ | Scrollbars | +-----------------------------------------------------------------+ *) class adjustment = LTerm_scroll_impl.adjustment (** Interface between an adjustment and a scrollbar widget. *) class type scrollable_adjustment = object inherit adjustment method incr : int method decr : int method mouse_scroll : int -> int method set_scroll_bar_mode : [ `fixed of int | `dynamic of int ] -> unit method set_mouse_mode : [ `middle | `ratio | `auto ] -> unit method set_min_scroll_bar_size : int -> unit method set_max_scroll_bar_size : int -> unit method on_scrollbar_change : ?switch:LTerm_widget_callbacks.switch -> (unit -> unit) -> unit end class type scrollable_document = object method page_size : int method set_page_size : int -> unit method document_size : int method set_document_size : int -> unit method page_next : int method page_prev : int method calculate_range : int -> int -> int end class type scrollable_private = object method set_scroll_window_size : int -> unit method get_render_params : int * int * int end class type default_scroll_events = object method mouse_event : LTerm_event.t -> bool method scroll_key_event : LTerm_event.t -> bool end class scrollable = LTerm_scroll_impl.scrollable_adjustment class vscrollbar = LTerm_scroll_impl.vscrollbar class hscrollbar = LTerm_scroll_impl.hscrollbar class vslider = LTerm_scroll_impl.vslider class hslider = LTerm_scroll_impl.hslider (* +-----------------------------------------------------------------+ | Running in a terminal | +-----------------------------------------------------------------+ *) let run = LTerm_running_impl.run let run_modal = LTerm_running_impl.run_modal let prepare_simple_run = LTerm_running_impl.prepare_simple_run end lambda-term-3.1.0/src/lTerm_windows.ml000066400000000000000000000125621366433625400177000ustar00rootroot00000000000000(* * lTerm_windows.ml * ---------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) open CamomileLibraryDefault.Camomile let (>|=) = Lwt.(>|=) external get_acp : unit -> int = "lt_windows_get_acp" external get_console_cp : unit -> int = "lt_windows_get_console_cp" external set_console_cp : int -> unit = "lt_windows_set_console_cp" external get_console_output_cp : unit -> int = "lt_windows_get_console_output_cp" external set_console_output_cp : int -> unit = "lt_windows_set_console_output_cp" type input = | Resize | Key of LTerm_key.t | Mouse of LTerm_mouse.t external read_console_input_job : Unix.file_descr -> input Lwt_unix.job = "lt_windows_read_console_input_job" let controls = [| UChar.of_char ' '; UChar.of_char 'a'; UChar.of_char 'b'; UChar.of_char 'c'; UChar.of_char 'd'; UChar.of_char 'e'; UChar.of_char 'f'; UChar.of_char 'g'; UChar.of_char 'h'; UChar.of_char 'i'; UChar.of_char 'j'; UChar.of_char 'k'; UChar.of_char 'l'; UChar.of_char 'm'; UChar.of_char 'n'; UChar.of_char 'o'; UChar.of_char 'p'; UChar.of_char 'q'; UChar.of_char 'r'; UChar.of_char 's'; UChar.of_char 't'; UChar.of_char 'u'; UChar.of_char 'v'; UChar.of_char 'w'; UChar.of_char 'x'; UChar.of_char 'y'; UChar.of_char 'z'; UChar.of_char '['; UChar.of_char '\\'; UChar.of_char ']'; UChar.of_char '^'; UChar.of_char '_'; |] let read_console_input fd = Lwt_unix.check_descriptor fd; Lwt_unix.run_job ?async_method:None (read_console_input_job (Lwt_unix.unix_file_descr fd)) >|= function | Key({ LTerm_key.code = LTerm_key.Char ch ; _ } as key) when UChar.code ch < 32 -> Key { key with LTerm_key.code = LTerm_key.Char controls.(UChar.code ch) } | input -> input type text_attributes = { foreground : int; background : int; } type console_screen_buffer_info = { size : LTerm_geom.size; cursor_position : LTerm_geom.coord; attributes : text_attributes; window : LTerm_geom.rect; maximum_window_size : LTerm_geom.size; } external get_console_screen_buffer_info : Unix.file_descr -> console_screen_buffer_info = "lt_windows_get_console_screen_buffer_info" let get_console_screen_buffer_info fd = Lwt_unix.check_descriptor fd; get_console_screen_buffer_info (Lwt_unix.unix_file_descr fd) type console_mode = { cm_echo_input : bool; cm_insert_mode : bool; cm_line_input : bool; cm_mouse_input : bool; cm_processed_input : bool; cm_quick_edit_mode : bool; cm_window_input : bool; } external get_console_mode : Unix.file_descr -> console_mode = "lt_windows_get_console_mode" external set_console_mode : Unix.file_descr -> console_mode -> unit = "lt_windows_set_console_mode" let get_console_mode fd = Lwt_unix.check_descriptor fd; get_console_mode (Lwt_unix.unix_file_descr fd) let set_console_mode fd mode = Lwt_unix.check_descriptor fd; set_console_mode (Lwt_unix.unix_file_descr fd) mode external get_console_cursor_info : Unix.file_descr -> int * bool = "lt_windows_get_console_cursor_info" external set_console_cursor_info : Unix.file_descr -> int -> bool -> unit = "lt_windows_set_console_cursor_info" let get_console_cursor_info fd = Lwt_unix.check_descriptor fd; get_console_cursor_info (Lwt_unix.unix_file_descr fd) let set_console_cursor_info fd size visible = Lwt_unix.check_descriptor fd; set_console_cursor_info (Lwt_unix.unix_file_descr fd) size visible external set_console_cursor_position : Unix.file_descr -> LTerm_geom.coord -> unit = "lt_windows_set_console_cursor_position" let set_console_cursor_position fd coord = Lwt_unix.check_descriptor fd; set_console_cursor_position (Lwt_unix.unix_file_descr fd) coord external set_console_text_attribute : Unix.file_descr -> text_attributes -> unit = "lt_windows_set_console_text_attribute" let set_console_text_attribute fd attrs = Lwt_unix.check_descriptor fd; set_console_text_attribute (Lwt_unix.unix_file_descr fd) attrs type char_info = { ci_char : Zed_char.t; ci_foreground : int; ci_background : int; } type char_info_raw = { cir_char : UChar.t; cir_foreground : int; cir_background : int; } let char_info_to_raw ci= Zed_char.to_array ci.ci_char |> Array.map (fun char-> { cir_char= char; cir_foreground= ci.ci_foreground; cir_background= ci.ci_background }) external write_console_output : Unix.file_descr -> char_info_raw array array -> LTerm_geom.size -> LTerm_geom.coord -> LTerm_geom.rect -> LTerm_geom.rect = "lt_windows_write_console_output" let chars_to_raw chars= Array.map (fun line-> List.map (fun ci-> char_info_to_raw ci) (Array.to_list line) |> Array.concat) chars let write_console_output fd chars size coord rect = Lwt_unix.check_descriptor fd; if Array.length chars <> size.LTerm_geom.rows then invalid_arg "LTerm_windows.write_console_output"; Array.iter (fun line -> if Array.length line <> size.LTerm_geom.cols then invalid_arg "LTerm_windows.write_console_output") chars; let chars= chars_to_raw chars in write_console_output (Lwt_unix.unix_file_descr fd) chars size coord rect external fill_console_output_character : Unix.file_descr -> UChar.t -> int -> LTerm_geom.coord -> int = "lt_windows_fill_console_output_character" let fill_console_output_character fd char count coord = Lwt_unix.check_descriptor fd; fill_console_output_character (Lwt_unix.unix_file_descr fd) char count coord lambda-term-3.1.0/src/lTerm_windows.mli000066400000000000000000000100351366433625400200420ustar00rootroot00000000000000(* * lTerm_windows.mli * ----------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (** Windows specific functions *) (** All these functions return [Lwt_sys.Not_available] on Unix. *) open CamomileLibrary (** {6 Codepage functions} *) val get_acp : unit -> int (** Returns the current ANSI codepage. *) val get_console_cp : unit -> int (** Returns the input codepage used by the console attached to the current process. *) val set_console_cp : int -> unit (** Sets the input codepage used by the console attached to the current process. *) val get_console_output_cp : unit -> int (** Returns the output codepage used by the console attached to the current process. *) val set_console_output_cp : int -> unit (** Sets the output codepage used by the console attached to the current process. *) (** {6 Console input} *) type input = | Resize | Key of LTerm_key.t | Mouse of LTerm_mouse.t val read_console_input : Lwt_unix.file_descr -> input Lwt.t (** [read_console_input fd] reads one input from the given file descriptor. *) (** {6 Console info} *) (** Type of text attributes. *) type text_attributes = { foreground : int; (** The foreground color. Only bits 0 to 3 matters, other are ignored. *) background : int; (** The background color. Only bits 0 to 3 matters, other are ignored. *) } (** Type of informations about a console. *) type console_screen_buffer_info = { size : LTerm_geom.size; (** The size of the console buffer. *) cursor_position : LTerm_geom.coord; (** The line and column of the cursor. *) attributes : text_attributes; (** Text attributes. *) window : LTerm_geom.rect; (** The displayed windows in the console buffer. *) maximum_window_size : LTerm_geom.size; (** The maximum window size for the current screen. *) } val get_console_screen_buffer_info : Lwt_unix.file_descr -> console_screen_buffer_info (** [get_console_screen_buffer_info fd] returns the current informations about the given console. *) (** {6 Console modes} *) (** Console modes. *) type console_mode = { cm_echo_input : bool; cm_insert_mode : bool; cm_line_input : bool; cm_mouse_input : bool; cm_processed_input : bool; cm_quick_edit_mode : bool; cm_window_input : bool; } val get_console_mode : Lwt_unix.file_descr -> console_mode (** Returns the mode of the given console. *) val set_console_mode : Lwt_unix.file_descr -> console_mode -> unit (** Sets the mode of the given console. *) (** {6 Console cursor} *) val get_console_cursor_info : Lwt_unix.file_descr -> int * bool (** Returns the size and visible status of the cursor on the given console. The size is a percentage between 1 and 100. *) val set_console_cursor_info : Lwt_unix.file_descr -> int -> bool -> unit (** [set_console_cursor_info fd size visible] sets the size and visible status of the cursor on the given console. *) val set_console_cursor_position : Lwt_unix.file_descr -> LTerm_geom.coord -> unit (** Move the cursor to the specified location in the screen buffer. *) (** {6 Text attributes} *) val set_console_text_attribute : Lwt_unix.file_descr -> text_attributes -> unit (** [set_console_text_attribute fd attributes] *) (** {6 Rendering} *) type char_info = { ci_char : Zed_char.t; (** The unicode character. *) ci_foreground : int; (** The foreground color. *) ci_background : int; (** The background color. *) } val write_console_output : Lwt_unix.file_descr -> char_info array array -> LTerm_geom.size -> LTerm_geom.coord -> LTerm_geom.rect -> LTerm_geom.rect (** [write_console_output fd chars size coord rect] writes the given matrix of characters with their attributes on the given console at given position. *) val fill_console_output_character : Lwt_unix.file_descr -> UChar.t -> int -> LTerm_geom.coord -> int (** [fill_console_output_character fd char count coord] writes [count] times [char] starting at [coord] on the given console. *) lambda-term-3.1.0/src/lTerm_windows_stubs.c000066400000000000000000000362011366433625400207260ustar00rootroot00000000000000/* * lTerm_windows_stubs.c * --------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. */ /* Windows specific stubs */ #include #include #include #include #if defined(_WIN32) || defined(_WIN64) #include /* +-----------------------------------------------------------------+ | Codepage functions | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_get_acp() { return Val_int(GetACP()); } CAMLprim value lt_windows_get_console_cp() { return Val_int(GetConsoleCP()); } CAMLprim value lt_windows_set_console_cp(value cp) { if (!SetConsoleCP(Int_val(cp))) { win32_maperr(GetLastError()); uerror("SetConsoleCP", Nothing); } return Val_unit; } CAMLprim value lt_windows_get_console_output_cp() { return Val_int(GetConsoleOutputCP()); } CAMLprim value lt_windows_set_console_output_cp(value cp) { if (!SetConsoleOutputCP(Int_val(cp))) { win32_maperr(GetLastError()); uerror("SetConsoleOutputCP", Nothing); } return Val_unit; } /* +-----------------------------------------------------------------+ | Console input | +-----------------------------------------------------------------+ */ static WORD code_table[] = { VK_RETURN, VK_ESCAPE, VK_TAB, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8, VK_F9, VK_F10, VK_F11, VK_F12, VK_NEXT, VK_PRIOR, VK_HOME, VK_END, VK_INSERT, VK_DELETE, VK_BACK }; struct job_read_console_input { struct lwt_unix_job job; HANDLE handle; INPUT_RECORD input; DWORD error_code; }; #define Job_read_console_input_val(v) *(struct job_read_console_input**)Data_custom_val(v) static void worker_read_console_input(struct job_read_console_input *job) { DWORD event_count; INPUT_RECORD *input = &(job->input); WORD code; int i; DWORD bs; for (;;) { if (!ReadConsoleInputW(job->handle, input, 1, &event_count)) { job->error_code = GetLastError(); return; } switch (input->EventType) { case KEY_EVENT: if (input->Event.KeyEvent.bKeyDown) { if (input->Event.KeyEvent.uChar.UnicodeChar) return; code = input->Event.KeyEvent.wVirtualKeyCode; for (i = 0; i < sizeof(code_table)/sizeof(code_table[0]); i++) if (code == code_table[i]) return; } break; case MOUSE_EVENT: { bs = input->Event.MouseEvent.dwButtonState; if (!(input->Event.MouseEvent.dwEventFlags & MOUSE_MOVED) && bs & (FROM_LEFT_1ST_BUTTON_PRESSED | FROM_LEFT_2ND_BUTTON_PRESSED | FROM_LEFT_3RD_BUTTON_PRESSED | FROM_LEFT_4TH_BUTTON_PRESSED | RIGHTMOST_BUTTON_PRESSED)) return; break; } case WINDOW_BUFFER_SIZE_EVENT: return; } } } static value result_read_console_input(struct job_read_console_input *job) { INPUT_RECORD * input; DWORD cks, bs; WORD code; int i; CAMLparam0(); CAMLlocal3(result, x, y); int error_code = job->error_code; input = &(job->input); lwt_unix_free_job(&job->job); if (error_code) { win32_maperr(error_code); uerror("ReadConsoleInput", Nothing); } switch (input->EventType) { case KEY_EVENT: { result = caml_alloc(1, 0); x = caml_alloc_tuple(4); Field(result, 0) = x; cks = input->Event.KeyEvent.dwControlKeyState; Field(x, 0) = Val_bool((cks & LEFT_CTRL_PRESSED) | (cks & RIGHT_CTRL_PRESSED)); Field(x, 1) = Val_bool((cks & LEFT_ALT_PRESSED) | (cks & RIGHT_ALT_PRESSED)); Field(x, 2) = Val_bool(cks & SHIFT_PRESSED); code = input->Event.KeyEvent.wVirtualKeyCode; for (i = 0; i < sizeof(code_table)/sizeof(code_table[0]); i++) if (code == code_table[i]) { Field(x, 3) = Val_int(i); CAMLreturn(result); } y = caml_alloc_tuple(1); Field(y, 0) = Val_int(input->Event.KeyEvent.uChar.UnicodeChar); Field(x, 3) = y; CAMLreturn(result); } case MOUSE_EVENT: { result = caml_alloc(1, 1); x = caml_alloc_tuple(6); Field(result, 0) = x; cks = input->Event.MouseEvent.dwControlKeyState; Field(x, 0) = Val_bool((cks & LEFT_CTRL_PRESSED) | (cks & RIGHT_CTRL_PRESSED)); Field(x, 1) = Val_bool((cks & LEFT_ALT_PRESSED) | (cks & RIGHT_ALT_PRESSED)); Field(x, 2) = Val_bool(cks & SHIFT_PRESSED); Field(x, 4) = Val_int(input->Event.MouseEvent.dwMousePosition.Y); Field(x, 5) = Val_int(input->Event.MouseEvent.dwMousePosition.X); bs = input->Event.MouseEvent.dwButtonState; if (bs & FROM_LEFT_1ST_BUTTON_PRESSED) Field(x, 3) = Val_int(0); else if (bs & FROM_LEFT_2ND_BUTTON_PRESSED) Field(x, 3) = Val_int(1); else if (bs & FROM_LEFT_3RD_BUTTON_PRESSED) Field(x, 3) = Val_int(2); else if (bs & FROM_LEFT_4TH_BUTTON_PRESSED) Field(x, 3) = Val_int(3); else Field(x, 3) = Val_int(4); CAMLreturn(result); } case WINDOW_BUFFER_SIZE_EVENT: CAMLreturn(Val_int(0)); } CAMLreturn(Val_int(0)); } CAMLprim value lt_windows_read_console_input_job(value val_fd) { CAMLparam1(val_fd); LWT_UNIX_INIT_JOB(job, read_console_input, 0); job->handle = Handle_val(val_fd); job->error_code = 0; CAMLreturn(lwt_unix_alloc_job(&(job->job))); } /* +-----------------------------------------------------------------+ | Console informations | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_get_console_screen_buffer_info(value val_fd) { CAMLparam1(val_fd); CAMLlocal2(result, x); CONSOLE_SCREEN_BUFFER_INFO info; int color; if (!GetConsoleScreenBufferInfo(Handle_val(val_fd), &info)) { win32_maperr(GetLastError()); uerror("GetConsoleScreenBufferInfo", Nothing); } result = caml_alloc_tuple(5); x = caml_alloc_tuple(2); Field(x, 0) = Val_int(info.dwSize.Y); Field(x, 1) = Val_int(info.dwSize.X); Field(result, 0) = x; x = caml_alloc_tuple(2); Field(x, 0) = Val_int(info.dwCursorPosition.Y); Field(x, 1) = Val_int(info.dwCursorPosition.X); Field(result, 1) = x; x = caml_alloc_tuple(2); color = 0; if (info.wAttributes & FOREGROUND_RED) color |= 1; if (info.wAttributes & FOREGROUND_GREEN) color |= 2; if (info.wAttributes & FOREGROUND_BLUE) color |= 4; if (info.wAttributes & FOREGROUND_INTENSITY) color |= 8; Field(x, 0) = Val_int(color); color = 0; if (info.wAttributes & BACKGROUND_RED) color |= 1; if (info.wAttributes & BACKGROUND_GREEN) color |= 2; if (info.wAttributes & BACKGROUND_BLUE) color |= 4; if (info.wAttributes & BACKGROUND_INTENSITY) color |= 8; Field(x, 1) = Val_int(color); Field(result, 2) = x; x = caml_alloc_tuple(4); Field(x, 0) = Val_int(info.srWindow.Top); Field(x, 1) = Val_int(info.srWindow.Left); Field(x, 2) = Val_int(info.srWindow.Bottom + 1); Field(x, 3) = Val_int(info.srWindow.Right + 1); Field(result, 3) = x; x = caml_alloc_tuple(2); Field(x, 0) = Val_int(info.dwMaximumWindowSize.Y); Field(x, 1) = Val_int(info.dwMaximumWindowSize.X); Field(result, 4) = x; CAMLreturn(result); } /* +-----------------------------------------------------------------+ | Console mode | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_get_console_mode(value val_fd) { DWORD mode; value result; if (!GetConsoleMode(Handle_val(val_fd), &mode)) { win32_maperr(GetLastError()); uerror("GetConsoleMode", Nothing); } result = caml_alloc_tuple(7); Field(result, 0) = Val_bool(mode & ENABLE_ECHO_INPUT); Field(result, 1) = Val_bool(mode & ENABLE_INSERT_MODE); Field(result, 2) = Val_bool(mode & ENABLE_LINE_INPUT); Field(result, 3) = Val_bool(mode & ENABLE_MOUSE_INPUT); Field(result, 4) = Val_bool(mode & ENABLE_PROCESSED_INPUT); Field(result, 5) = Val_bool(mode & ENABLE_QUICK_EDIT_MODE); Field(result, 6) = Val_bool(mode & ENABLE_WINDOW_INPUT); return result; } CAMLprim value lt_windows_set_console_mode(value val_fd, value val_mode) { DWORD mode = 0; if (Bool_val(Field(val_mode, 0))) mode |= ENABLE_ECHO_INPUT; if (Bool_val(Field(val_mode, 1))) mode |= ENABLE_INSERT_MODE; if (Bool_val(Field(val_mode, 2))) mode |= ENABLE_LINE_INPUT; if (Bool_val(Field(val_mode, 3))) mode |= ENABLE_MOUSE_INPUT; if (Bool_val(Field(val_mode, 4))) mode |= ENABLE_PROCESSED_INPUT; if (Bool_val(Field(val_mode, 5))) mode |= ENABLE_QUICK_EDIT_MODE; if (Bool_val(Field(val_mode, 6))) mode |= ENABLE_WINDOW_INPUT; if (!SetConsoleMode(Handle_val(val_fd), mode)) { win32_maperr(GetLastError()); uerror("SetConsoleMode", Nothing); } return Val_unit; } /* +-----------------------------------------------------------------+ | Cursor | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_get_console_cursor_info(value val_fd) { CONSOLE_CURSOR_INFO info; value result; if (!GetConsoleCursorInfo(Handle_val(val_fd), &info)) { win32_maperr(GetLastError()); uerror("GetConsoleCursorInfo", Nothing); } result = caml_alloc_tuple(2); Field(result, 0) = Val_int(info.dwSize); Field(result, 1) = Val_bool(info.bVisible); return result; } CAMLprim value lt_windows_set_console_cursor_info(value val_fd, value val_size, value val_visible) { CONSOLE_CURSOR_INFO info; info.dwSize = Int_val(val_size); info.bVisible = Bool_val(val_visible); if (!SetConsoleCursorInfo(Handle_val(val_fd), &info)) { win32_maperr(GetLastError()); uerror("SetConsoleCursorInfo", Nothing); } return Val_unit; } CAMLprim value lt_windows_set_console_cursor_position(value val_fd, value val_coord) { COORD coord; coord.X = Int_val(Field(val_coord, 1)); coord.Y = Int_val(Field(val_coord, 0)); if (!SetConsoleCursorPosition(Handle_val(val_fd), coord)) { win32_maperr(GetLastError()); uerror("SetConsoleCursorPosition", Nothing); } return Val_unit; } /* +-----------------------------------------------------------------+ | Text attributes | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_set_console_text_attribute(value val_fd, value val_attrs) { int fg = Int_val(Field(val_attrs, 0)); int bg = Int_val(Field(val_attrs, 1)); WORD attrs = 0; if (fg & 1) attrs |= FOREGROUND_RED; if (fg & 2) attrs |= FOREGROUND_GREEN; if (fg & 4) attrs |= FOREGROUND_BLUE; if (fg & 8) attrs |= FOREGROUND_INTENSITY; if (bg & 1) attrs |= BACKGROUND_RED; if (bg & 2) attrs |= BACKGROUND_GREEN; if (bg & 4) attrs |= BACKGROUND_BLUE; if (bg & 8) attrs |= BACKGROUND_INTENSITY; if (!SetConsoleTextAttribute(Handle_val(val_fd), attrs)) { win32_maperr(GetLastError()); uerror("SetConsoleTextAttribute", Nothing); } return Val_unit; } /* +-----------------------------------------------------------------+ | Rendering | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_write_console_output(value val_fd, value val_chars, value val_size, value val_coord, value val_rect) { CAMLparam5(val_fd, val_chars, val_size, val_coord, val_rect); CAMLlocal1(result); value line, src; int fg, bg; WORD attrs; int lines = Int_val(Field(val_size, 0)); int columns = Int_val(Field(val_size, 1)); COORD size; COORD coord; SMALL_RECT rect; /* Convert characters */ CHAR_INFO *buffer = (CHAR_INFO*)lwt_unix_malloc(lines * columns * sizeof (CHAR_INFO)); int l, c; CHAR_INFO *dst = buffer; for (l = 0; l < lines; l++) { line = Field(val_chars, l); for (c = 0; c < columns; c++) { src = Field(line, c); dst->Char.UnicodeChar = Int_val(Field(src, 0)); fg = Int_val(Field(src, 1)); bg = Int_val(Field(src, 2)); attrs = 0; if (fg & 1) attrs |= FOREGROUND_RED; if (fg & 2) attrs |= FOREGROUND_GREEN; if (fg & 4) attrs |= FOREGROUND_BLUE; if (fg & 8) attrs |= FOREGROUND_INTENSITY; if (bg & 1) attrs |= BACKGROUND_RED; if (bg & 2) attrs |= BACKGROUND_GREEN; if (bg & 4) attrs |= BACKGROUND_BLUE; if (bg & 8) attrs |= BACKGROUND_INTENSITY; dst->Attributes = attrs; dst++; } } size.X = Int_val(Field(val_size, 1)); size.Y = Int_val(Field(val_size, 0)); coord.X = Int_val(Field(val_coord, 1)); coord.Y = Int_val(Field(val_coord, 0)); rect.Top = Int_val(Field(val_rect, 0)); rect.Left = Int_val(Field(val_rect, 1)); rect.Bottom = Int_val(Field(val_rect, 2)) - 1; rect.Right = Int_val(Field(val_rect, 3)) - 1; if (!WriteConsoleOutputW(Handle_val(val_fd), buffer, size, coord, &rect)) { free(buffer); win32_maperr(GetLastError()); uerror("WriteConsoleOutput", Nothing); } free(buffer); result = caml_alloc_tuple(4); Field(result, 0) = Val_int(rect.Top); Field(result, 1) = Val_int(rect.Left); Field(result, 2) = Val_int(rect.Bottom + 1); Field(result, 3) = Val_int(rect.Right + 1); CAMLreturn(result); } /* +-----------------------------------------------------------------+ | Filling | +-----------------------------------------------------------------+ */ CAMLprim value lt_windows_fill_console_output_character(value val_fd, value val_char, value val_count, value val_coord) { COORD coord; DWORD written; coord.X = Int_val(Field(val_coord, 1)); coord.Y = Int_val(Field(val_coord, 0)); if (!FillConsoleOutputCharacter(Handle_val(val_fd), Int_val(val_char), Int_val(val_count), coord, &written)) { win32_maperr(GetLastError()); uerror("FillConsoleOutputCharacter", Nothing); } return Val_int(written); } #else /* +-----------------------------------------------------------------+ | For unix | +-----------------------------------------------------------------+ */ #include #define NA(name, feature) \ CAMLprim value lt_windows_##name() \ { \ lwt_unix_not_available(feature); \ return Val_unit; \ } NA(get_acp, "GetACP") NA(get_console_cp, "GetConsoleCP") NA(set_console_cp, "SetConsoleCP") NA(get_console_output_cp, "GetConsoleOutputCP") NA(set_console_output_cp, "SetConsoleOutputCP") NA(read_console_input_job, "ReadConsoleInput") NA(read_console_input_result, "ReadConsoleInput") NA(read_console_input_free, "ReadConsoleInput") NA(set_console_text_attribute, "SetConsoleTextAttribute") NA(get_console_screen_buffer_info, "GetConsoleScreenBufferInfo") NA(get_console_cursor_info, "GetConsoleCursorInfo") NA(set_console_cursor_info, "SetConsoleCursorInfo") NA(write_console_output, "WriteConsoleOutput") NA(set_console_cursor_position, "SetConsoleCursorPosition") NA(get_console_mode, "GetConsoleMode") NA(set_console_mode, "SetConsoleMode") NA(fill_console_output_character, "FillConsoleOutputCharacter") #endif lambda-term-3.1.0/src/literalIntf.ml000066400000000000000000000025101366433625400173100ustar00rootroot00000000000000open CamomileLibrary module type Type = sig type char_intf type string_intf val empty_string : unit -> string_intf val of_char : Zed_char.t -> char_intf val of_string : Zed_string.t -> string_intf val to_char : char_intf -> Zed_char.t option * UChar.t list val to_string : string_intf -> Zed_string.t * UChar.t list val to_char_exn : char_intf -> Zed_char.t val to_string_exn : string_intf -> Zed_string.t end module Zed : Type with type char_intf= Zed_char.t and type string_intf= Zed_string.t = struct external id : 'a -> 'a = "%identity" type char_intf= Zed_char.t type string_intf= Zed_string.t let empty_string ()= Zed_string.empty () let of_char= id let of_string= id let to_char ch= Some ch, [] let to_string str= str, [] let to_char_exn= id let to_string_exn= id end module UTF8 : Type with type char_intf= Zed_utf8.t and type string_intf= Zed_utf8.t = struct module Zed_char_UTF8 = Zed_char.US(UTF8) module Zed_string_UTF8 = Zed_string.US(UTF8) type char_intf= Zed_utf8.t type string_intf= Zed_utf8.t let empty_string ()= "" let of_char= Zed_char.to_utf8 let of_string= Zed_string.to_utf8 let to_char= Zed_char_UTF8.to_t let to_string= Zed_string_UTF8.to_t let to_char_exn= Zed_char_UTF8.to_t_exn let to_string_exn= Zed_string.unsafe_of_utf8 end lambda-term-3.1.0/style.css000066400000000000000000000050361366433625400155720ustar00rootroot00000000000000/* 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% } lambda-term-3.1.0/tests/000077500000000000000000000000001366433625400150565ustar00rootroot00000000000000lambda-term-3.1.0/tests/dune000066400000000000000000000001021366433625400157250ustar00rootroot00000000000000(executable (name history_stress_test) (libraries lambda-term)) lambda-term-3.1.0/tests/history_stress_test.ml000066400000000000000000000047111366433625400215560ustar00rootroot00000000000000(* * history_stress_test.ml * ---------------------- * Copyright : (c) 2012, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* Start n processes, adding entries [k, k + n, k + n * 2, ... k + n * count] to their history. Between each addition, they save their history to the same file. At the end the parent check that the history contains all numbers from [0] to [n - 1 + n * count]. *) let return, (>>=) = Lwt.return, Lwt.(>>=) let rec check nproc count n l = match l with | [] -> n = nproc * (count + 1) | p :: l -> n = p && check nproc count (n + 1) l let rec start_procs name fn nproc count k = if k = nproc then [] else let t = Lwt_process.exec (name, [|name; fn; string_of_int nproc; string_of_int count; string_of_int k|]) >>= fun status -> assert (status = Unix.WEXITED 0); return () in t :: start_procs name fn nproc count (k + 1) let () = match Sys.argv with | [|name; fn; s1; s2|] -> Lwt_main.run ( if Sys.file_exists fn then Sys.remove fn; let nproc = int_of_string s1 and count = int_of_string s2 in Lwt.join (start_procs name fn nproc count 0) >>= fun () -> let history = LTerm_history.create [] in LTerm_history.load history fn >>= fun () -> Sys.remove fn; if check nproc count 0 (List.sort compare (List.map int_of_string (LTerm_history.contents history |> List.map Zed_string.to_utf8))) then begin prerr_endline "success"; exit 0 end else begin prerr_endline "failure"; exit 1 end ) | [|_name; fn; s1; s2; s3|] -> Lwt_main.run ( let nproc = int_of_string s1 and count = int_of_string s2 and start = int_of_string s3 in let history = LTerm_history.create [] in let rec loop i = if i >= count then return () else begin LTerm_history.add history (Zed_string.of_utf8 (string_of_int (start + i * nproc))); assert (LTerm_history.length history = i + 1 && LTerm_history.old_count history = i); LTerm_history.save history fn >>= fun () -> loop (i + 1) end in loop 0 ) | _ -> Printf.eprintf "usage: %s \n" Sys.argv.(0); exit 2 lambda-term-3.1.0/tools/000077500000000000000000000000001366433625400150545ustar00rootroot00000000000000lambda-term-3.1.0/tools/dune000066400000000000000000000002051366433625400157270ustar00rootroot00000000000000(executable (name lambda_term_actions) (flags :standard -safe-string) (public_name lambda-term-actions) (libraries lambda-term)) lambda-term-3.1.0/tools/lambda_term_actions.ml000066400000000000000000000025651366433625400214050ustar00rootroot00000000000000(* * lambda_term_actions.ml * ---------------------- * Copyright : (c) 2011, Jeremie Dimino * Licence : BSD3 * * This file is a part of Lambda-Term. *) (* List all available actions. *) let print_action length (action, doc) = print_string action; for _ = String.length action to length do print_char ' ' done; print_string ": "; print_string doc; print_char '\n' let () = (* Collect actions. *) let edit_actions = ("insert(...)", "insert a character.") :: (List.map (fun (action, name) -> (name, Zed_edit.doc_of_action action)) Zed_edit.actions) @ (List.map (fun (action, name) -> (name, LTerm_edit.doc_of_action action)) LTerm_edit.actions) and read_line_actions = List.map (fun (action, name) -> (name, LTerm_read_line.doc_of_action action)) LTerm_read_line.actions in (* Search the longest line. *) let length = List.fold_left (fun acc (action, _doc) -> max (String.length action) acc) 0 edit_actions in let length = List.fold_left (fun acc (action, _doc) -> max (String.length action) acc) length read_line_actions in (* Print actions. *) print_string "General actions\n\ ===============\n\n"; List.iter (print_action length) edit_actions; print_string "\nRead-line actions\n\ =================\n\n"; List.iter (print_action length) read_line_actions; flush stdout