(local { : Gtk } (require :lgi)) (local { : view } (require :fennel)) (local lume (require :lume)) (local commands {}) (local Buffer (require :buffer)) (fn define-command [name ordered-params function] ;; required parameter names and default arguments (let [param-names (icollect [_ [name] (pairs ordered-params)] name) params (collect [_ [name completer default] (pairs ordered-params)] (values name {: completer : default})) v {: name : function : param-names : params}] (tset commands name v))) (define-command "quit-browser" [] #(Gtk.main_quit)) (define-command "switch-to-buffer" [[:buffer Buffer.match #(. (Buffer.next $1.buffer) :name)] ] (fn [{:frame frame :buffer buffer}] (frame:show-buffer buffer))) (define-command "visit-location" [[:buffer Buffer.match #$1.buffer.name] [:url #{$1 $1} #($1.buffer:location)] ] (fn [{:url url :buffer buffer}] (buffer:visit url))) (define-command "back" [[:buffer Buffer.match #$1.buffer.name]] (fn [{: buffer}] (buffer:back))) (fn find-command [name] (. commands name)) (local default-state { :active false :command nil :collected-params {} :this-param nil }) (fn next-param [command params] (accumulate [v nil _ k (ipairs command.param-names) &until v] (if (. params k) nil k))) (fn next-action [self input-string] (let [state self.state state-for-next-param (fn [c params] (match (next-param c params) k1 { :command c :this-param k1 :collected-params params :active true } _ (let [params (lume.extend {} {:frame self.frame} params)] (c.function 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} (let [{ : completer} (. c.params k) vals (completer input-string) value (. vals input-string)] (tset p k value) (state-for-next-param c p)) {:command c :this-param nil :collected-params p} (state-for-next-param c p) _ (do (print "unexpected state " (view state)) state) ))) (fn on-activate [self str] (let [s (next-action self str) param (if s.active (. (. s.command :params) s.this-param))] (set self.state s) { :active s.active :error s.error :prompt (if s.active (or s.this-param "Command?" "") "") :default (and param (param.default self.frame)) })) (fn update-widget-state [{ : widget : entry : completions-widget : prompt} result] (set prompt.label (or result.prompt "")) (set entry.sensitive result.active) (if (not result.active) (completions-widget:hide)) (set entry.text (or result.default result.error "")) (widget.parent:set_visible_child_name (if result.active "commander" "echo-area"))) (fn on-input [self str] (match self.state {:command c :this-param param-name} (let [parent self.completions-widget { : completer} (. c.params param-name) completions (completer str)] (parent:foreach #(parent:remove $1)) (each [text _w (pairs completions)] (parent:add (Gtk.Button { :label text :on_clicked #(update-widget-state self (self:on-activate text)) }))) (parent:show_all) ))) (fn activate [{: state : entry : prompt &as self}] (tset state :active true) (update-widget-state self {:active true :prompt (or state.this-param "Command" "") }) (entry:grab_focus) state) (fn deactivate [{: state : entry : prompt &as self}] (doto state (lume.clear) (tset :active false)) (update-widget-state self {:active false})) (fn invoke-interactively [self name params] (let [c (find-command name) supplied-params (collect [k v (pairs params)] (values k (v self.frame))) s { :active true :command c :collected-params supplied-params }] (set self.state s) (let [r (self:on-activate nil)] (update-widget-state self r) (self.entry:grab_focus) r))) (fn new-commander [frame] (let [entry (Gtk.Entry {:sensitive false }) prompt (Gtk.Label { :label ""}) box (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) hbox (Gtk.Box { :orientation Gtk.Orientation.HORIZONTAL }) completions (Gtk.FlowBox) self { :state default-state : activate : deactivate :active? (fn [self] self.state.active) : on-input : on-activate : invoke-interactively : entry :widget box : prompt : frame :completions-widget completions }] (hbox:pack_start prompt false false 15) (hbox:pack_start entry true true 5) (box:pack_start hbox true false 0) (box:pack_start completions true true 0) (tset entry :on_changed (fn [event] (self:on-input event.text))) (tset entry :on_activate (fn [event] (let [result (self:on-activate event.text)] (update-widget-state self result)))) self)) { :commander new-commander : define-command }