move command state into per-frame table

lots of dependent changes here, unfortunately

- get rid of Buffer.current (it's per-frame now)
- in define-command, functions providing default parameter values
   now accept frame as parameter
- in keymaps, parameter values are functions that accept frame as
   parameter
main
Daniel Barlow 2022-12-27 12:25:50 +00:00
parent dea9d925a5
commit 5069e6aff1
5 changed files with 73 additions and 70 deletions

View File

@ -33,6 +33,5 @@
(let [b (new-buffer name)] (let [b (new-buffer name)]
(tset buffers name b) (tset buffers name b)
b)) b))
:current (fn [] (let [k (next buffers)] (. buffers k)))
:find (fn [term] (. buffers term)) :find (fn [term] (. buffers term))
}) })

View File

@ -32,7 +32,7 @@
"visit-location" "visit-location"
(fn [{:url url :buffer buffer}] (fn [{:url url :buffer buffer}]
(let [b (Buffer.find buffer)] (: b :visit url))) (let [b (Buffer.find buffer)] (: b :visit url)))
[:buffer (fn [] (. (Buffer.current) :name)) [:buffer (fn [f] f.buffer.name)
:url #(do "http://www.example.com") :url #(do "http://www.example.com")
]) ])
@ -98,77 +98,74 @@
state) state)
))) )))
(fn on-input [str] (fn on-input [self str]
(let [s (next-action state str) (let [s (next-action self.state str)
param (if s.active (. (. s.command :params) s.this-param))] param (if s.active (. (. s.command :params) s.this-param))]
(set state s) (set self.state s)
{ {
:active s.active :active s.active
:error s.error :error s.error
:prompt (if s.active (or s.this-param "Command?" "") "") :prompt (if s.active (or s.this-param "Command?" "") "")
:default (and param (param)) :default (and param (param self.frame))
})) }))
(local prompt (Gtk.Label { :label ""})) (fn update-widget-state [{ : entry : prompt} result]
(local widget
(let [w (Gtk.Entry {
:sensitive false
})]
(tset w :on_activate
(fn [event]
(let [result (on-input event.text)]
(set prompt.label (or result.prompt ""))
(set w.sensitive result.active)
(set w.text (or result.default result.error "")))))
w))
(local box
(let [box
(Gtk.Box {
:orientation Gtk.Orientation.HORIZONTAL
})]
(box:pack_start prompt false false 15)
(box:pack_start widget true true 5)
box))
(fn update-widget-state [result]
(set prompt.label (or result.prompt "")) (set prompt.label (or result.prompt ""))
(set widget.sensitive result.active) (set entry.sensitive result.active)
(set widget.text (or result.default result.error ""))) (set entry.text (or result.default result.error "")))
(fn activate [] (fn activate [{: state : entry : prompt}]
(tset state :active true) (tset state :active true)
(set widget.sensitive true) (set entry.sensitive true)
(set widget.text "") (set entry.text "")
(set prompt.label (or state.this-param "Command" "")) (set prompt.label (or state.this-param "Command" ""))
(widget:grab_focus) (entry:grab_focus)
state) state)
(fn invoke-interactively [name params] (fn invoke-interactively [self name params]
(let [c (find-command name) (let [c (find-command name)
supplied-params (collect [k v (pairs params)]
(values k (v self.frame)))
s { s {
:active true :active true
:command c :command c
:collected-params params :collected-params supplied-params
}] }]
(set state s) (set self.state s)
(let [r (on-input nil)] (let [r (self:on-input nil)]
(update-widget-state r) (update-widget-state self r)
(widget:grab_focus) (self.entry:grab_focus)
r))) r)))
(fn new-commander [frame]
(let [entry (Gtk.Entry {:sensitive false })
prompt (Gtk.Label { :label ""})
box (Gtk.Box {
:orientation Gtk.Orientation.HORIZONTAL
})
self {
:state default-state
: activate
:active? (fn [self] self.state.active)
: on-input
: invoke-interactively
: entry
:widget box
: prompt
: frame
}]
(box:pack_start prompt false false 15)
(box:pack_start entry true true 5)
(tset entry :on_activate
(fn [event]
(let [result (self:on-input event.text)]
(set prompt.label (or result.prompt ""))
(set entry.sensitive result.active)
(set entry.text (or result.default result.error "")))))
self))
{ {
: activate :commander new-commander
:active? (fn [] state.active)
: define-command : define-command
: on-input
: invoke-interactively
:widget box
:_ {
: reset-state
}
} }

View File

@ -9,7 +9,7 @@
;;; when we decide how to do an init file/rc file, this will go in it ;;; when we decide how to do an init file/rc file, this will go in it
(local my-keymap { (local my-keymap {
"g" ["visit-location" {:buffer "main"}] "g" ["visit-location" {:buffer #(. (. $1 :buffer) :name)}]
"M-q" ["quit-browser" {}] "M-q" ["quit-browser" {}]
"C-x" { "C-x" {
"C-c" ["quit-browser" {}] "C-c" ["quit-browser" {}]

View File

@ -10,7 +10,9 @@
(fn new-frame [global-keymap] (fn new-frame [global-keymap]
(let [hpad 2 (let [hpad 2
vpad 2 vpad 2
self {}
recogniser (keymap.recogniser global-keymap) recogniser (keymap.recogniser global-keymap)
commander (Command.commander self)
window (Gtk.Window { window (Gtk.Window {
:title "Dunlin" :title "Dunlin"
:default_width 800 :default_width 800
@ -32,16 +34,16 @@
(tset window :on_key_release_event (tset window :on_key_release_event
(fn [window event] (fn [window event]
(when (not (Command.active?)) (when (not (commander:active?))
(match (recogniser:accept-event event) (match (recogniser:accept-event event)
[name params] (Command.invoke-interactively name params) [name params] (commander:invoke-interactively name params)
(nil prompt) (print "prompted" prompt))) (nil prompt) (print "prompted" prompt)))
(when (and event.state.MOD1_MASK (when (and event.state.MOD1_MASK
(= event.keyval (string.byte "x"))) (= event.keyval (string.byte "x")))
(Command.activate)))) (commander:activate))))
(doto container (doto container
(: :pack_start Command.widget false false vpad) (: :pack_start commander.widget false false vpad)
(: :pack_start progress-bar false false vpad) (: :pack_start progress-bar false false vpad)
(: :pack_start contentwidget true true vpad)) (: :pack_start contentwidget true true vpad))
(window:add container) (window:add container)
@ -54,11 +56,13 @@
:show-buffer (fn [self b] :show-buffer (fn [self b]
(each [_ w (pairs (contentwidget:get_children))] (each [_ w (pairs (contentwidget:get_children))]
(w:hide)) (w:hide))
(tset self :buffer b)
(contentwidget:pack_start b.webview true true 0) (contentwidget:pack_start b.webview true true 0)
(b.webview:show)) (b.webview:show))
}] }]
(table.insert frames f) (lume.extend self f)
f))) (table.insert frames self)
self)))
{ :new new-frame :frames frames } { :new new-frame :frames frames }

View File

@ -3,7 +3,7 @@
(local Command (require :command)) (local Command (require :command))
(var happened false) (var happened false)
(fn before [] (set happened false) (Command._.reset-state)) (fn before [] (set happened false))
(Command.define-command "no-args-command" #(set happened true) []) (Command.define-command "no-args-command" #(set happened true) [])
@ -13,31 +13,34 @@
[:a #(do "3") :b #(do "2")]) [:a #(do "3") :b #(do "2")])
(before) (before)
(let [(ok err) (let [commander (Command.commander)
(match-try (Command.activate) (ok err)
{:active true} (Command.on-input "not-a-command") (match-try (commander:activate)
{:active true} (commander:on-input "not-a-command")
(where {:error e :active false} (e:match "can't find command")) true (where {:error e :active false} (e:match "can't find command")) true
(catch (catch
x (values nil (view x))))] x (values nil (view x))))]
(assert ok err)) (assert ok err))
(before) (before)
(let [(ok err) (let [commander (Command.commander)
(match-try (Command.activate) (ok err)
{:active true} (Command.on-input "multiply") (match-try (commander:activate)
{:active true :prompt p1} (Command.on-input "2") {:active true} (commander:on-input "multiply")
{:active true :prompt p2} (Command.on-input "3") {:active true :prompt p1} (commander:on-input "2")
{:active true :prompt p2} (commander:on-input "3")
(where {:active false} (= happened 6)) true (where {:active false} (= happened 6)) true
(catch (catch
x (values nil (view x))))] x (values nil (view x))))]
(assert ok err)) (assert ok err))
(before) (before)
(let [(ok err) (let [commander (Command.commander)
(ok err)
(match (match
(Command.invoke-interactively (commander:invoke-interactively
"multiply" "multiply"
{:a "7" :b "9"}) {:a #"7" :b #"9"})
(where {:active false} (= happened 63)) true (where {:active false} (= happened 63)) true
x (values nil (.. "wrong answer " (view x) " " (view happened))) x (values nil (.. "wrong answer " (view x) " " (view happened)))
nil (values nil "???"))] nil (values nil "???"))]