From 5069e6aff1e526d0d9b6788e9a8b58be1336f62c Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Tue, 27 Dec 2022 12:25:50 +0000 Subject: [PATCH] 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 --- buffer.fnl | 1 - command.fnl | 97 +++++++++++++++++++++++------------------------- dunlin.fnl | 2 +- frame.fnl | 16 +++++--- test/command.fnl | 27 ++++++++------ 5 files changed, 73 insertions(+), 70 deletions(-) diff --git a/buffer.fnl b/buffer.fnl index a2e7894..8b3628d 100644 --- a/buffer.fnl +++ b/buffer.fnl @@ -33,6 +33,5 @@ (let [b (new-buffer name)] (tset buffers name b) b)) - :current (fn [] (let [k (next buffers)] (. buffers k))) :find (fn [term] (. buffers term)) }) diff --git a/command.fnl b/command.fnl index 1b86e85..74e62d7 100644 --- a/command.fnl +++ b/command.fnl @@ -32,7 +32,7 @@ "visit-location" (fn [{:url url :buffer buffer}] (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") ]) @@ -98,77 +98,74 @@ state) ))) -(fn on-input [str] - (let [s (next-action state str) +(fn on-input [self str] + (let [s (next-action self.state str) param (if s.active (. (. s.command :params) s.this-param))] - (set state s) + (set self.state s) { :active s.active :error s.error :prompt (if s.active (or s.this-param "Command?" "") "") - :default (and param (param)) + :default (and param (param self.frame)) })) -(local prompt (Gtk.Label { :label ""})) - -(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] +(fn update-widget-state [{ : entry : prompt} result] (set prompt.label (or result.prompt "")) - (set widget.sensitive result.active) - (set widget.text (or result.default result.error ""))) + (set entry.sensitive result.active) + (set entry.text (or result.default result.error ""))) -(fn activate [] +(fn activate [{: state : entry : prompt}] (tset state :active true) - (set widget.sensitive true) - (set widget.text "") + (set entry.sensitive true) + (set entry.text "") (set prompt.label (or state.this-param "Command" "")) - (widget:grab_focus) + (entry:grab_focus) state) -(fn invoke-interactively [name params] +(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 params + :collected-params supplied-params }] - (set state s) - (let [r (on-input nil)] - (update-widget-state r) - (widget:grab_focus) + (set self.state s) + (let [r (self:on-input 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.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 - :active? (fn [] state.active) + :commander new-commander : define-command - : on-input - : invoke-interactively - :widget box - :_ { - : reset-state - } } diff --git a/dunlin.fnl b/dunlin.fnl index 3daa961..67ac8c1 100644 --- a/dunlin.fnl +++ b/dunlin.fnl @@ -9,7 +9,7 @@ ;;; when we decide how to do an init file/rc file, this will go in it (local my-keymap { - "g" ["visit-location" {:buffer "main"}] + "g" ["visit-location" {:buffer #(. (. $1 :buffer) :name)}] "M-q" ["quit-browser" {}] "C-x" { "C-c" ["quit-browser" {}] diff --git a/frame.fnl b/frame.fnl index 014503e..9a60af5 100644 --- a/frame.fnl +++ b/frame.fnl @@ -10,7 +10,9 @@ (fn new-frame [global-keymap] (let [hpad 2 vpad 2 + self {} recogniser (keymap.recogniser global-keymap) + commander (Command.commander self) window (Gtk.Window { :title "Dunlin" :default_width 800 @@ -32,16 +34,16 @@ (tset window :on_key_release_event (fn [window event] - (when (not (Command.active?)) + (when (not (commander:active?)) (match (recogniser:accept-event event) - [name params] (Command.invoke-interactively name params) + [name params] (commander:invoke-interactively name params) (nil prompt) (print "prompted" prompt))) (when (and event.state.MOD1_MASK (= event.keyval (string.byte "x"))) - (Command.activate)))) + (commander:activate)))) (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 contentwidget true true vpad)) (window:add container) @@ -54,11 +56,13 @@ :show-buffer (fn [self b] (each [_ w (pairs (contentwidget:get_children))] (w:hide)) + (tset self :buffer b) (contentwidget:pack_start b.webview true true 0) (b.webview:show)) }] - (table.insert frames f) - f))) + (lume.extend self f) + (table.insert frames self) + self))) { :new new-frame :frames frames } diff --git a/test/command.fnl b/test/command.fnl index 8e64db9..888b438 100644 --- a/test/command.fnl +++ b/test/command.fnl @@ -3,7 +3,7 @@ (local Command (require :command)) (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) []) @@ -13,31 +13,34 @@ [:a #(do "3") :b #(do "2")]) (before) -(let [(ok err) - (match-try (Command.activate) - {:active true} (Command.on-input "not-a-command") +(let [commander (Command.commander) + (ok err) + (match-try (commander:activate) + {:active true} (commander: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.activate) - {:active true} (Command.on-input "multiply") - {:active true :prompt p1} (Command.on-input "2") - {:active true :prompt p2} (Command.on-input "3") +(let [commander (Command.commander) + (ok err) + (match-try (commander:activate) + {:active true} (commander:on-input "multiply") + {:active true :prompt p1} (commander:on-input "2") + {:active true :prompt p2} (commander:on-input "3") (where {:active false} (= happened 6)) true (catch x (values nil (view x))))] (assert ok err)) (before) -(let [(ok err) +(let [commander (Command.commander) + (ok err) (match - (Command.invoke-interactively + (commander:invoke-interactively "multiply" - {:a "7" :b "9"}) + {:a #"7" :b #"9"}) (where {:active false} (= happened 63)) true x (values nil (.. "wrong answer " (view x) " " (view happened))) nil (values nil "???"))]