Compare commits

...

7 Commits

Author SHA1 Message Date
9775e00545 inline temps and whitespace, improve update-widget-state
update-widget-state accepts a second parameter which duplicates
information available in self.state. This commit gets rid of
some not all of it
2023-01-01 22:23:07 +00:00
c1b7c2d777 add back button 2023-01-01 22:22:40 +00:00
bc17c3af6c show url in echo area when it changes 2023-01-01 20:55:11 +00:00
055e8b792f hide commander and print messages in echo area 2023-01-01 19:12:54 +00:00
1f93dc2310 tidying up 2023-01-01 19:12:39 +00:00
b1bdc326ef WIP popup commander 2023-01-01 16:49:15 +00:00
c3e9c14186 index->string allows printing keystrokes readably 2023-01-01 15:08:45 +00:00
8 changed files with 125 additions and 61 deletions

View File

@ -32,6 +32,7 @@
(set property-change-listener cb)) (set property-change-listener cb))
:location #(widget:get_uri) :location #(widget:get_uri)
:visit (fn [_ u] (widget:load_uri u)) :visit (fn [_ u] (widget:load_uri u))
:back #(widget:go_back)
:properties props})) :properties props}))
(let [buffers {}] (let [buffers {}]

View File

@ -24,23 +24,22 @@
(define-command (define-command
"switch-to-buffer" "switch-to-buffer"
[[:buffer [[:buffer Buffer.match #(. (Buffer.next $1.buffer) :name)]]
Buffer.match (fn [{: frame : buffer}]
#(. (Buffer.next $1.buffer) :name)]
]
(fn [{:frame frame :buffer buffer}]
(frame:show-buffer buffer))) (frame:show-buffer buffer)))
(define-command (define-command
"visit-location" "visit-location"
[[:buffer [[:buffer Buffer.match #$1.buffer.name]
Buffer.match [:url #{$1 $1} #($1.buffer:location)]]
#$1.buffer.name] (fn [{: url : buffer}]
[:url #{$1 $1} #($1.buffer:location)]
]
(fn [{:url url :buffer buffer}]
(buffer:visit url))) (buffer:visit url)))
(define-command
"back"
[[:buffer Buffer.match #$1.buffer.name]]
(fn [{: buffer}] (buffer:back)))
(fn find-command [name] (fn find-command [name]
(. commands name)) (. commands name))
@ -57,9 +56,6 @@
&until v] &until v]
(if (. params k) nil k))) (if (. params k) nil k)))
(fn invoke-command [command params]
(command.function params))
(fn next-action [self input-string] (fn next-action [self input-string]
(let [state self.state (let [state self.state
state-for-next-param state-for-next-param
@ -72,7 +68,7 @@
:active true :active true
} }
_ (let [params (lume.extend {} {:frame self.frame} params)] _ (let [params (lume.extend {} {:frame self.frame} params)]
(invoke-command c params) (c.function params)
{:active false})))] {:active false})))]
(match state (match state
@ -91,14 +87,12 @@
{:command c :this-param k :collected-params p} {:command c :this-param k :collected-params p}
(let [{ : completer} (. c.params k) (let [{ : completer} (. c.params k)
vals (completer input-string) value (. (completer input-string) input-string)]
value (. vals input-string)]
(tset p k value) (tset p k value)
(state-for-next-param c p)) (state-for-next-param c p))
{:command c :this-param nil :collected-params p} {:command c :this-param nil :collected-params p}
(do (state-for-next-param c p)
(state-for-next-param c p))
_ (do (print "unexpected state " (view state)) _ (do (print "unexpected state " (view state))
state) state)
@ -109,18 +103,20 @@
param (if s.active (. (. s.command :params) s.this-param))] param (if s.active (. (. s.command :params) s.this-param))]
(set self.state s) (set self.state s)
{ {
: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 self.frame)) :default (and param (param.default self.frame))
})) }))
(fn update-widget-state [{ : entry : completions-widget : prompt} result] (fn update-widget-state [{ : state : widget : entry : completions-widget : prompt} result]
(set prompt.label (or result.prompt "")) (set prompt.label (or result.prompt ""))
(set entry.sensitive result.active) (set entry.sensitive state.active)
(if (not result.active) (if (not state.active)
(completions-widget:hide)) (completions-widget:hide))
(set entry.text (or result.default result.error ""))) (set entry.text (or result.default result.error ""))
(match widget.parent
p (p:set_visible_child_name
(if state.active "commander" "echo-area"))))
(fn on-input [self str] (fn on-input [self str]
(match self.state (match self.state
@ -143,17 +139,16 @@
(tset state :active true) (tset state :active true)
(update-widget-state (update-widget-state
self self
{:active true {
:prompt (or state.this-param "Command" "") :prompt (or state.this-param "Command" "")
}) })
(entry:grab_focus) (entry:grab_focus))
state)
(fn deactivate [{: state : entry : prompt &as self}] (fn deactivate [{: state : entry : prompt &as self}]
(doto state (doto state
(lume.clear) (lume.clear)
(tset :active false)) (tset :active false))
(update-widget-state self {:active false})) (update-widget-state self {}))
(fn invoke-interactively [self name params] (fn invoke-interactively [self name params]
(let [c (find-command name) (let [c (find-command name)
@ -192,9 +187,6 @@
:widget box :widget box
: prompt : prompt
: frame : frame
:set-inactive-text (fn [self text]
(when (not self.state.active)
(tset entry :text text)))
:completions-widget completions :completions-widget completions
}] }]
(hbox:pack_start prompt false false 15) (hbox:pack_start prompt false false 15)

View File

@ -99,6 +99,12 @@ To see how commands are implemented, read the code in `command.fnl`.
There is a simple keymap in `dunlin.fnl`, and you can see the details There is a simple keymap in `dunlin.fnl`, and you can see the details
of how keymaps work in `keymap.fnl` of how keymaps work in `keymap.fnl`
When writing key bindings or printing errors, Dunlin assumes that the
key producing "Mod 1" (often labelled Alt) is the Meta key, and the
key producing "Mod 4" (on a PC, typically the key with the Windows logo)
is the Super key. For me this matches how Emacs does it, but I would
welcome reports of machines/setups that don't act ths way
## Contributing ## Contributing

View File

@ -10,6 +10,7 @@
(local my-keymap { (local my-keymap {
"g" ["visit-location" {:buffer #$1.buffer }] "g" ["visit-location" {:buffer #$1.buffer }]
"BackSpace" ["back" {:buffer #$1.buffer }]
"M-q" ["quit-browser" {}] "M-q" ["quit-browser" {}]
"C-x" { "C-x" {
"C-c" ["quit-browser" {}] "C-c" ["quit-browser" {}]

View File

@ -12,7 +12,15 @@
vpad 2 vpad 2
self {} self {}
recogniser (keymap.recogniser global-keymap) recogniser (keymap.recogniser global-keymap)
bottom-line (Gtk.Stack {
:transition_type Gtk.StackTransitionType.SLIDE_UP_DOWN
:transition_duration 100
})
commander (Command.commander self) commander (Command.commander self)
echo-area (Gtk.Label {
:xalign 0
:margin_start 10
})
window (Gtk.Window { window (Gtk.Window {
:title "Dunlin" :title "Dunlin"
:default_width 800 :default_width 800
@ -35,16 +43,26 @@
:estimated-load-progress :estimated-load-progress
(tset progress-bar :fraction value) (tset progress-bar :fraction value)
:uri :uri
(commander:set-inactive-text value) (tset echo-area :label value)
n n
(comment (print "prop change" n value))))] (comment (print "prop change" n value))))]
(doto bottom-line
(: :add_named echo-area "echo-area")
(: :add_named commander.widget "commander")
(: :set_visible_child_name "commander"))
(doto container
(: :pack_start progress-bar false false vpad)
(: :pack_start contentwidget true true vpad)
(: :pack_end bottom-line false false vpad))
(tset window :on_key_release_event (tset window :on_key_release_event
(fn [window event] (fn [window event]
(when (not (commander:active?)) (when (not (commander:active?))
(match (recogniser:accept-event event) (match (recogniser:accept-event event)
[name params] (commander:invoke-interactively name params) [name params] (commander:invoke-interactively name params)
(nil prompt) (print "prompted" prompt))) (nil prompt) (tset echo-area :label prompt)))
(when (and (commander:active?) (when (and (commander:active?)
(= keymap.keyval.Escape event.keyval)) (= keymap.keyval.Escape event.keyval))
(commander:deactivate)) (commander:deactivate))
@ -53,10 +71,9 @@
(= event.keyval (string.byte "x"))) (= event.keyval (string.byte "x")))
(commander:activate)))) (commander:activate))))
(doto container (echo-area:show) (commander.widget:show)
(: :pack_start commander.widget false false vpad)
(: :pack_start progress-bar false false vpad)
(: :pack_start contentwidget true true vpad))
(window:add container) (window:add container)
(window:show_all) (window:show_all)
(let [f (let [f
@ -64,6 +81,8 @@
:window window :window window
:buffer nil :buffer nil
:content contentwidget :content contentwidget
:message (fn [self message]
(tset echo-area :label message))
: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))

View File

@ -1,5 +1,6 @@
(local { : Gdk } (require :lgi)) (local { : Gdk } (require :lgi))
(local { : view } (require :fennel)) (local { : view } (require :fennel))
(local lume (require :lume))
(local modifier-keyvals (local modifier-keyvals
;; we need to detect and discard modifier-only key events when ;; we need to detect and discard modifier-only key events when
@ -29,15 +30,15 @@
(fn keychord->spec [keychord] (fn keychord->spec [keychord]
(let [Mod Gdk.ModifierType (let [Mod Gdk.ModifierType
symbol (keychord:match "(%w+)$") symbol (keychord:match "(%w+)$")
upper? (and (symbol:match "%u") true) ; upper? (and (symbol:match "%u") true)
modmask (accumulate [m (if upper? Mod.SHIFT_MASK 0) modmask (accumulate [m 0 ;(if upper? Mod.SHIFT_MASK 0)
v (keychord:gmatch "(%w+)-")] v (keychord:gmatch "(%w+)-")]
(match (v:lower) (match (v:lower)
"m" (bor m Mod.MOD1_MASK) "m" (bor m Mod.MOD1_MASK)
"c" (bor m Mod.CONTROL_MASK) "c" (bor m Mod.CONTROL_MASK)
"s" (bor m Mod.MOD4_MASK)))] "s" (bor m Mod.MOD4_MASK)))]
{ {
:keyval (string.byte (symbol:lower)) :keyval (Gdk.keyval_from_name symbol)
: modmask : modmask
})) }))
@ -51,6 +52,25 @@
(bor m (. Gdk.ModifierType k)))] (bor m (. Gdk.ModifierType k)))]
(spec->index {:keyval event.keyval : modmask}))) (spec->index {:keyval event.keyval : modmask})))
(fn compact [xs]
(icollect [_ v (ipairs xs)] v))
(fn index->string [index]
(let [Mod Gdk.ModifierType
[keyval modmask] (lume.map (lume.split index ":") tonumber)
chars []]
(if (> (band modmask Mod.CONTROL_MASK) 0) (table.insert chars "C"))
(if (> (band modmask Mod.MOD1_MASK) 0) (table.insert chars "M"))
(if (> (band modmask Mod.MOD4_MASK) 0) (table.insert chars "S"))
(table.insert chars (Gdk.keyval_name keyval))
(table.concat chars "-")))
(let [v (index->string "103:0")] (assert (= v "g") v))
(let [v (index->string "65:0")] (assert (= v "A") v))
(let [v (index->string "120:4")] (assert (= v "C-x") v))
(let [v (index->string "100:8")] (assert (= v "M-d") v))
(let [v (index->string "100:12")] (assert (= v "C-M-d") v))
(fn command? [tbl] (fn command? [tbl]
;; a keymap entry has a string as key, a command ;; a keymap entry has a string as key, a command
;; definition is a numerically-indexed array ;; definition is a numerically-indexed array
@ -66,40 +86,53 @@
(values f (compile-keymap v)) (values f (compile-keymap v))
(values f v))))) (values f v)))))
(fn ref [tbl keys]
(when tbl
(match keys
[k1 & more] (ref (. tbl k1) more)
[k1] (. tbl k1)
x tbl)))
(let [v (ref {:a 1} [:a])] (assert (= v 1) v))
(let [v (ref {:a {:c 7}} [:a :c])] (assert (= v 7) v))
(let [v (ref {:a {:c 7}} [:a ])] (assert (match v {:c 7} true) (view v)))
(let [v (ref {:a {:c 7}} [:z :d])] (assert (not v) v))
(fn recogniser [source-keymap] (fn recogniser [source-keymap]
(let [keymap (compile-keymap source-keymap)] (let [keymap (compile-keymap source-keymap)]
(var m keymap) (var key-sequence [])
{ {
:accept-event :accept-event
(fn [_ e] (fn [_ e]
(when (not (modifier? e.keyval)) (when (not (modifier? e.keyval))
(let [c (event->index e)] (let [c (event->index e)]
(match (. m c) (table.insert key-sequence c)
(match (ref keymap key-sequence)
(where v (keymap? v)) (where v (keymap? v))
(do (values nil
(set m v) (let [syms (lume.map key-sequence index->string)]
(values nil (.. c " "))) (table.concat syms " ")))
(where v (command? v)) (where v (command? v))
(do (do
(set m keymap) (set key-sequence [])
v) v)
(where nil (= c "103:4")) (where nil (= c "103:4"))
(do (do
(set m keymap) (set key-sequence [])
(values nil "cancelled")) (values nil "cancelled"))
_ _
(do (let [syms (lume.map key-sequence index->string)]
(set m keymap) (set key-sequence [])
(values nil (.. "No binding for " (view e) " "))))))) (values nil (.. (table.concat syms " ") " is undefined")))))))
})) }))
{ : recogniser { : recogniser
:keyval { :keyval (collect [_ name (ipairs [:Escape :Delete :BackSpace])]
:Escape (Gdk.keyval_from_name "Escape") (values name (Gdk.keyval_from_name name)))
}
:_ { :_ {
;; symbols in _ are exported only for testing ;; symbols in _ are exported only for testing
: keychord->spec : keychord->spec

View File

@ -79,16 +79,28 @@ focus from entry to step through the completions then RET activates
* [done] show loading progress * [done] show loading progress
* [done] show url when the commander is inactive * [done] show url when the commander is inactive
* [done] visit-location url defaults to current * [done] visit-location url defaults to current
* [done] ESC to cancel interactive command
* [done] C-g to cancel key sequence
* custom rendering for completions (e.g. buffer thumbnails) * custom rendering for completions (e.g. buffer thumbnails)
* buffer name is often going to be useless. find buffers * less ugly default completions rendering
by url/title * buffer name is often going to be useless. find buffers by url/title
still need some 1:1 mapping between the buffer object and still need some 1:1 mapping between the buffer object and
a text-representable form of same a text-representable form of same
* click in commander widget activates visit-location * click in commander widget activates visit-location
* in general, can we bind commands to widget events?
* display unbound key error * display unbound key error
* ESC to cancel interactive command
* autocomplete command name * autocomplete command name
* multiple buffers * command to create new buffer
- create buffer * keyboard navigation of completions
- list buffers (do we need this if we have thumbnails?)
----
I think we're misusing the commander to show url and error messages
and key prompts. It's OK to have that part of the screen be multipurpose
but philosophically those things are not related to the command system.
- hide commander when inactive and replace it with echo area
- move it to bottom?
commander can't hide itself, it needs to ask its parent to hide it

View File

@ -33,9 +33,9 @@
{:keyval 97 :modmask 4} true {:keyval 97 :modmask 4} true
_ (assert false (view s)))) _ (assert false (view s))))
(let [s (keymap._.keychord->spec "C-M-Z")] (let [s (keymap._.keychord->spec "C-M-z")]
(match s (match s
{:keyval 122 :modmask 13} true {:keyval 122 :modmask 12} true
_ (assert false (view s)))) _ (assert false (view s))))