(local { : Gtk } (require :lgi)) (local { : view } (require :fennel)) (local commands {}) (local Buffer (require :buffer)) (fn by-pairs [a] (let [iter (fn [_ a] (match a [k v & rest] (values rest k v) _ nil))] (values iter a a))) (fn define-command [name function ordered-params] ;; required parameter names and default arguments (let [param-names (icollect [_ name val (by-pairs ordered-params)] name) params (collect [_ name val (by-pairs ordered-params)] (values name val)) v {: name : function : param-names : params}] (tset commands name v))) (define-command "quit-browser" #(Gtk.main_quit) []) (define-command "visit-location" (fn [{:url url :buffer buffer}] (let [b (Buffer.find buffer)] (: b :visit url))) [:buffer (fn [] (. (Buffer.current) :name)) :url #(do "http://www.example.com") ]) (fn find-command [name] (. commands name)) (local default-state { :active false :command nil :collected-params {} :this-param nil }) (var state default-state) (fn reset-state [] (set state default-state)) (fn next-param [command params] (accumulate [v nil _ k (ipairs command.param-names) &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)) {:command c :this-param nil :collected-params p} (do (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)) })) (fn update-widget-state [w result] (set w.placeholder_text (or result.prompt "")) (set w.sensitive result.active) (set w.text (or result.default result.error ""))) (local widget (let [w (Gtk.Entry { :sensitive false })] (tset w :on_activate (fn [event] (update-widget-state w (on-input event.text)))) w)) (fn activate [] (tset state :active true) (set widget.sensitive true) (set widget.text "") (widget:grab_focus) state) (fn invoke-interactively [name params] (let [c (find-command name) s { :active true :command c :collected-params params }] (set state s) (let [r (on-input nil)] (update-widget-state widget r) (widget:grab_focus) r))) (fn active? [] state.active) { : activate : active? : define-command : on-input : invoke-interactively : widget :_ { : reset-state } }