From c2dcda7a9735c115f0828363f682de9b1a3dd2cc Mon Sep 17 00:00:00 2001 From: =?utf8?q?Am=C3=A9lia=20Coutard-Sander?= Date: Sat, 4 Jan 2025 19:56:18 +0100 Subject: [PATCH] =?utf8?q?S=C3=A9lection=20via=20le=20mode=20commande,=20a?= =?utf8?q?utocompl=C3=A9tion=20des=20commandes?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- bin/modes.ml | 144 +++++++++++++++++++++++++------------------------- bin/modes.mli | 2 - bin/parse.ml | 63 ++++++++++++++++++++++ bin/parse.mli | 21 ++++++++ 4 files changed, 157 insertions(+), 73 deletions(-) create mode 100644 bin/parse.ml create mode 100644 bin/parse.mli diff --git a/bin/modes.ml b/bin/modes.ml index dec0497..5b3beaa 100644 --- a/bin/modes.ml +++ b/bin/modes.ml @@ -45,6 +45,10 @@ end = module type Mode = ModeAux.S +let get_name (m : (module Automata.Automaton)) = + let module M = (val m) in + M.name + module rec Command : (Mode with type initer = string) = struct type state = string @@ -59,37 +63,82 @@ module rec Command : (Mode with type initer = string) = struct Graphics.moveto 10 8; Graphics.draw_string (":" ^ cmd) + let rec last = function + | [s] -> s + | _ :: t -> last t + | [] -> assert false + + let rec ch_last v = function + | [_] -> [v] + | x :: t -> x :: ch_last v t + | [] -> assert false + + let real_complete cmd completions = + let last = last cmd in + match List.filter (String.starts_with ~prefix:last) completions with + | [] -> + Printf.fprintf stderr "No completions !\n%!"; + String.concat " " (List.map Parse.shquote cmd) + | [possibility] -> String.concat " " (List.map Parse.shquote (ch_last possibility cmd)) ^ " " + | possibilities -> + Printf.fprintf stderr "Completions:\n%!"; + List.iter (Printf.fprintf stderr "\t%s\n%!") possibilities; + String.concat " " (List.map Parse.shquote cmd) + + let autocomplete cmd = + match try Parse.shlex cmd with Parse.NonTerminatedString -> Parse.shlex (cmd ^ "'") with + | ["quit"] -> "quit" + | ["select"] -> real_complete ["select"; ""] (List.map get_name Automata.automata) + | ["select"; n] -> real_complete ["select"; n] (List.map get_name Automata.automata) + | ["write"] -> "write " + | ["read"] -> "read " + | [] -> real_complete [""] ["quit"; "select"; "write"; "read"] + | [cmd] -> real_complete [cmd] ["quit"; "select"; "write"; "read"] + | parsed -> String.concat " " (List.map Parse.shquote parsed) + let run_cmd (EditorState (m, st) as estate) cmd = let module M = (val m) in - match cmd with - | "quit" -> - Graphics.close_graph (); - (estate, Either.left "") - | "select" -> (estate, Either.right (ModeAux.ModeAndState ((module AutoSelector), AutoSelector.initial ()))) - | cmd when String.starts_with ~prefix:"write " cmd -> - Out_channel.with_open_text - (String.sub cmd 6 (String.length cmd - 6)) - (Automata.serialise (module M) st.board); - (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) - | cmd when String.starts_with ~prefix:"read " cmd -> - ( EditorState - ( m, - { - st with - board = - In_channel.with_open_text - (String.sub cmd 5 (String.length cmd - 5)) - (Automata.deserialise (module M)); - } ), - Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ) - | _ -> - Printf.fprintf stderr "Unknown cmd: `%s'\n%!" cmd; - (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) + try + match Parse.shlex cmd with + | ["quit"] -> + Graphics.close_graph (); + (estate, Either.left "") + | ["select"; auto] -> ( + match List.find_opt (fun m -> get_name m = auto) Automata.automata with + | Some auto -> + let module M = (val auto) in + ( EditorState + ( (module M), + { board = Automata.initial (module M); pos = (0, 0); current = M.default; size = 16 } + ), + Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ) + | None -> + Printf.fprintf stderr "Automate inconnu: `%s' !\n%!" auto; + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))) + | ["write"; f] -> + (try Out_channel.with_open_text f (Automata.serialise (module M) st.board) + with Sys_error _ -> Printf.fprintf stderr "Failed to write file `%s' !\n%!" f); + (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) + | ["read"; f] -> ( + try + ( EditorState + (m, { st with board = In_channel.with_open_text f (Automata.deserialise (module M)) }), + Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ) + with Sys_error _ -> + Printf.fprintf stderr "Failed to write file `%s' !\n%!" f; + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))) + | _ -> + Printf.fprintf stderr "Unknown cmd: `%s' !\n%!" cmd; + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) + with Parse.NonTerminatedString -> + Printf.fprintf stderr "Unterminated string !\n%!"; + (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) let update estate cmd = function | '\b' -> (estate, Either.left (String.sub cmd 0 (max (String.length cmd - 1) 0))) | '' -> (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ()))) | '\r' -> run_cmd estate cmd + | '\t' -> (estate, Either.left (autocomplete cmd)) | c -> (estate, Either.left (cmd ^ String.make 1 c)) end @@ -162,50 +211,3 @@ and Normal : (Mode with type initer = unit) = struct include Impl end - -and AutoSelector : (Mode with type initer = unit) = struct - type state = (module Automata.Automaton) list * (module Automata.Automaton) * (module Automata.Automaton) list - - type initer = unit - - let initial () = - match Automata.automata with - | au :: aus -> ([], au, aus) - | [] -> assert false - - let render _ (above, curr, below) = - let auto_name (m : (module Automata.Automaton)) = - let module M = (val m) in - M.name - in - Graphics.clear_graph (); - let x = 25 - and y = (Graphics.size_y () / 2) - 10 in - let draw_text i s = - Graphics.moveto x (y + (i * 25)); - Graphics.draw_string s - in - List.iteri (fun i -> draw_text (i + 1)) (List.map auto_name above); - draw_text 0 (auto_name curr); - Graphics.draw_rect (x - 5) (y - 5) 200 20; - List.iteri (fun i -> draw_text (-i - 1)) (List.map auto_name below) - - let update estate (above, curr, below) = function - | 'k' -> ( - match above with - | [] -> (estate, Either.left ([], curr, below)) - | c :: cs -> (estate, Either.left (cs, c, curr :: below))) - | 'j' -> ( - match below with - | [] -> (estate, Either.left (above, curr, [])) - | c :: cs -> (estate, Either.left (curr :: above, c, cs))) - | 's' -> - let module M = (val curr : Automata.Automaton) in - ( EditorState - ((module M), { board = Automata.initial (module M); pos = (0, 0); current = M.default; size = 16 }), - Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ) - | 'q' -> - Graphics.close_graph (); - (estate, Either.left (above, curr, below)) - | _ -> (estate, Either.left (above, curr, below)) -end diff --git a/bin/modes.mli b/bin/modes.mli index f1a50e4..a067d74 100644 --- a/bin/modes.mli +++ b/bin/modes.mli @@ -38,5 +38,3 @@ module type Mode = ModeAux.S module Command : Mode module Normal : Mode with type initer = unit - -module AutoSelector : Mode diff --git a/bin/parse.ml b/bin/parse.ml new file mode 100644 index 0000000..fc3ab9a --- /dev/null +++ b/bin/parse.ml @@ -0,0 +1,63 @@ +(* Copyright 2024 Amélia COUTARD-SANDER . + * + * This file from the cli-utils toolchain is free software: you can redistribute + * it and/or modify it under the terms of the GNU Affero General Public License + * as published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * This toolchain is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more + * details. + * + * You should have received a copy of the GNU Affero General Public License + * along with this toolchain. If not, see . + *) + +let is_whitespace c = c = ' ' || c = '\t' || c = '\n' || c = '\r' || c = '\012' + +exception NonTerminatedString + +let shlex s = + let rec skip_spaces i = + if String.length s = i then [] else if is_whitespace s.[i] then skip_spaces (i + 1) else read_words i + and read_words i = + let w, i = read_word i in + w :: skip_spaces i + and read_word i = + let buf = Buffer.create 64 in + let rec aux i quot = + if String.length s = i + then if quot then raise NonTerminatedString else i + else + match s.[i] with + | c when is_whitespace c && not quot -> i + | '\'' when quot && String.length s > i + 1 && s.[i + 1] = '\'' -> + Buffer.add_char buf '\''; + aux (i + 2) quot + | '\'' -> aux (i + 1) (not quot) + | c -> + Buffer.add_char buf c; + aux (i + 1) quot + in + let i = aux i false in + (Buffer.contents buf, i) + in + skip_spaces 0 + +let string_bind f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_string buf (f c)) s; + Buffer.contents buf + +let shquote s = + if s = "" || String.exists (fun c -> is_whitespace c || c = '\'') s + then + "'" + ^ string_bind + (function + | '\'' -> "''" + | c -> String.make 1 c) + s + ^ "'" + else s diff --git a/bin/parse.mli b/bin/parse.mli new file mode 100644 index 0000000..b3f39bb --- /dev/null +++ b/bin/parse.mli @@ -0,0 +1,21 @@ +(* Copyright 2024 Amélia COUTARD-SANDER . + * + * This file from the cli-utils toolchain is free software: you can redistribute + * it and/or modify it under the terms of the GNU Affero General Public License + * as published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * This toolchain is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more + * details. + * + * You should have received a copy of the GNU Affero General Public License + * along with this toolchain. If not, see . + *) + +exception NonTerminatedString + +val shlex : string -> string list + +val shquote : string -> string -- 2.46.0