Sélection via le mode commande, autocomplétion des commandes

diff --git a/bin/modes.ml b/bin/modes.ml
index dec049753e8ce3712a1c842a4d7e2c9be79a748d..5b3beaab642b1e1306ffaf1a4e77eba983ee77c3 100644 (file)
--- 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)))
           | '\e' -> (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 f1a50e480743f4f696f79decb89373b8f0d3035e..a067d7413b7c43484afa03624b5e3107ae25ea87 100644 (file)
--- 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 (file)
index 0000000..fc3ab9a
--- /dev/null
+++ b/bin/parse.ml
@@ -0,0 +1,63 @@
+(* Copyright 2024 Amélia COUTARD-SANDER <https://www.ameliathe1st.gay>.
+ *
+ * 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 <https://www.gnu.org/licenses/>.
+ *)
+
+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 (file)
index 0000000..b3f39bb
--- /dev/null
+++ b/bin/parse.mli
@@ -0,0 +1,21 @@
+(* Copyright 2024 Amélia COUTARD-SANDER <https://www.ameliathe1st.gay>.
+ *
+ * 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 <https://www.gnu.org/licenses/>.
+ *)
+
+exception NonTerminatedString
+
+val shlex : string -> string list
+
+val shquote : string -> string