first pass at commands with args

very rudimentary ui, and only handles string args
main
Daniel Barlow 2022-12-21 13:36:25 +00:00
parent b534db7fd2
commit 0e103a673c
4 changed files with 113 additions and 23 deletions

View File

@ -1,4 +1,5 @@
(local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi)) (local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi))
(local { : view } (require :fennel))
(fn new-buffer [name] (fn new-buffer [name]
(let [props {} (let [props {}
@ -22,6 +23,7 @@
))) )))
})] })]
{:webview widget {:webview widget
:name name
:visit (fn [self u] (print "visit " u) (widget:load_uri u)) :visit (fn [self u] (print "visit " u) (widget:load_uri u))
:properties props})) :properties props}))
@ -32,5 +34,5 @@
(tset buffers name b) (tset buffers name b)
b)) b))
:current (fn [] (let [k (next buffers)] (. buffers k))) :current (fn [] (let [k (next buffers)] (. buffers k)))
:find (fn [self term] (. buffers term)) :find (fn [term] (. buffers term))
}) })

View File

@ -4,37 +4,90 @@
(local commands {}) (local commands {})
(local Buffer (require :buffer)) (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] (fn define-command [name function params]
;; required parameter names and default arguments ;; required parameter names and default arguments
(let [v {:name name :function function :params params}] (let [v {:name name :function function :params params}]
(tset commands name v))) (tset commands name v)))
(define-command "quit-browser" #(Gtk.main_quit) {}) (define-command
"quit-browser"
#(Gtk.main_quit) {})
(define-command (define-command
"visit-location" "visit-location"
(fn [{:url url :buffer buffer}] (fn [{:url url :buffer buffer}]
(buffer:visit url)) (let [b (Buffer.find buffer)] (: b :visit url)))
{:buffer (fn [] (Buffer.current)) {:buffer (fn [] (. (Buffer.current) :name))
:url #(do "http://www.example.com") :url #(do "http://www.example.com")
}) })
(fn prompt-missing-args [params explicit-args] (fn find-command [name]
(collect [k v (pairs params)] (. commands name))
(values k (or (. explicit-args k) (v)))))
(fn invoke [s args] (local default-state {
(match (. commands s) :active true
{:function f :params p} :command nil
(let [prompted-args (prompt-missing-args p args)] :collected-params {}
(f prompted-args)) :this-param nil
nil (print "undefined command " s))) })
(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 }

View File

@ -17,9 +17,6 @@
:orientation Gtk.Orientation.VERTICAL :orientation Gtk.Orientation.VERTICAL
}) })
commander (Gtk.Entry { commander (Gtk.Entry {
:on_activate
(fn [event]
(Command.invoke event.text {}))
}) })
progress-bar (Gtk.ProgressBar { progress-bar (Gtk.ProgressBar {
:orientation Gtk.Orientation.HORIZONTAL :orientation Gtk.Orientation.HORIZONTAL
@ -30,6 +27,13 @@
:orientation Gtk.Orientation.VERTICAL :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 (doto container
(: :pack_start commander false false vpad) (: :pack_start commander false false vpad)
(: :pack_start progress-bar false false vpad) (: :pack_start progress-bar false false vpad)

31
test/command.fnl Normal file
View File

@ -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))