diff --git a/buffer.fnl b/buffer.fnl index 39a4e6b..36098a3 100644 --- a/buffer.fnl +++ b/buffer.fnl @@ -1,4 +1,5 @@ (local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) +(local { : view } (require :fennel)) (fn new-buffer [name] (let [props {} @@ -22,6 +23,7 @@ ))) })] {:webview widget + :name name :visit (fn [self u] (print "visit " u) (widget:load_uri u)) :properties props})) @@ -32,5 +34,5 @@ (tset buffers name b) b)) :current (fn [] (let [k (next buffers)] (. buffers k))) - :find (fn [self term] (. buffers term)) + :find (fn [term] (. buffers term)) }) diff --git a/command.fnl b/command.fnl index e52feea..010df77 100644 --- a/command.fnl +++ b/command.fnl @@ -4,37 +4,90 @@ (local commands {}) (local Buffer (require :buffer)) -;; when a command is invoked from a binding, the binding may provide -;; some or all of the parameter values. when there are missing params, -;; or when invoked from the commander, `invoke` prompts for the -;; missing params, offering default values which were specified by -;; define-command - (fn define-command [name function params] ;; required parameter names and default arguments (let [v {:name name :function function :params params}] (tset commands name v))) -(define-command "quit-browser" #(Gtk.main_quit) {}) +(define-command + "quit-browser" + #(Gtk.main_quit) {}) (define-command "visit-location" (fn [{:url url :buffer buffer}] - (buffer:visit url)) - {:buffer (fn [] (Buffer.current)) + (let [b (Buffer.find buffer)] (: b :visit url))) + {:buffer (fn [] (. (Buffer.current) :name)) :url #(do "http://www.example.com") }) -(fn prompt-missing-args [params explicit-args] - (collect [k v (pairs params)] - (values k (or (. explicit-args k) (v))))) +(fn find-command [name] + (. commands name)) -(fn invoke [s args] - (match (. commands s) - {:function f :params p} - (let [prompted-args (prompt-missing-args p args)] - (f prompted-args)) - nil (print "undefined command " s))) +(local default-state { + :active true + :command nil + :collected-params {} + :this-param nil + }) +(var state default-state) +(fn reset-state [] + (set state default-state)) -{ : invoke } +(fn next-param [command params] + (accumulate [v nil + k _ (pairs command.params) + &until v] + (if (. params k) nil k))) + +(fn invoke-command [command params] + (command.function params)) + +(fn next-action [state input-string] + (let [state-for-next-param + (fn [c params] + (match (next-param c params) + k1 { + :command c + :this-param k1 + :collected-params params + :active true + } + _ (do (invoke-command c params) {:active false})))] + + (match state + {:active false} state + + {:command nil} + (match (find-command input-string) + {: name : params &as c} + (state-for-next-param c {}) + + nil + { + :active false + :error (.. "can't find command " input-string) + }) + + {:command c :this-param k :collected-params p} + (do + (tset p k input-string) + (state-for-next-param c p)) + _ + (do (print "unexpected state " (view state)) + state) + ))) + +(fn on-input [str] + (let [s (next-action state str) + param (if s.active (. (. s.command :params) s.this-param))] + (set state s) + { + :active s.active + :error s.error + :prompt (or s.this-param "") + :default (and param (param)) + })) + +{ : define-command : on-input : reset-state } diff --git a/frame.fnl b/frame.fnl index c94b0b1..90b6baf 100644 --- a/frame.fnl +++ b/frame.fnl @@ -17,9 +17,6 @@ :orientation Gtk.Orientation.VERTICAL }) commander (Gtk.Entry { - :on_activate - (fn [event] - (Command.invoke event.text {})) }) progress-bar (Gtk.ProgressBar { :orientation Gtk.Orientation.HORIZONTAL @@ -30,6 +27,13 @@ :orientation Gtk.Orientation.VERTICAL }) ] + (tset commander :on_activate + (fn [event] + (let [result (Command.on-input event.text)] + (print "result" (view result)) + (set commander.placeholder_text (or result.prompt "")) + (set commander.text (or result.default ""))))) + (doto container (: :pack_start commander false false vpad) (: :pack_start progress-bar false false vpad) diff --git a/test/command.fnl b/test/command.fnl new file mode 100644 index 0000000..7a811e9 --- /dev/null +++ b/test/command.fnl @@ -0,0 +1,31 @@ +(local { : view } (require :fennel)) + +(local Command (require :command)) + +(var happened false) +(fn before [] (set happened false) (Command.reset-state)) + +(Command.define-command "no-args-command" #(set happened true)) + +(Command.define-command + "multiply" + (fn [{: a : b }] (set happened (* (tonumber a) (tonumber b)))) + {:a #(do "3") :b #(do "2")}) + +(before) +(let [(ok err) + (match-try (Command.on-input "not-a-command") + (where {:error e :active false} (e:match "can't find command")) true + (catch + x (values nil (view x))))] + (assert ok err)) + +(before) +(let [(ok err) + (match-try (Command.on-input "multiply") + {:active true :prompt p1} (Command.on-input "2") + {:active true :prompt p2} (Command.on-input "3") + (where {:active false} (= happened 6)) true + (catch + x (values nil (view x))))] + (assert ok err))