commit 0e103a673c82cba3190d5a78a60aa1ff25670003
parent b534db7fd2746e5fb2125b69b9c1bb73e12062c2
Author: Daniel Barlow <dan@telent.net>
Date: Wed, 21 Dec 2022 13:36:25 +0000
first pass at commands with args
very rudimentary ui, and only handles string args
Diffstat:
4 files changed, 113 insertions(+), 23 deletions(-)
diff --git 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
@@ -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))
+
+(local default-state {
+ :active true
+ :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)
+ })
-(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)))
+ {: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))
+ }))
-{ : invoke }
+{ : define-command : on-input : reset-state }
diff --git 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
@@ -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))
