dunlin/command.fnl

145 lines
3.3 KiB
Fennel

(local { : Gtk } (require :lgi))
(local { : view } (require :fennel))
(local commands {})
(local Buffer (require :buffer))
(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
"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 _ (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))
{: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
: reset-state
: invoke-interactively
: widget
}