Compare commits

..

No commits in common. "9775e0054590486a740b33d1ae801c4154caca9c" and "ad2628ddfc16d4868d8d837d71d92e604daf8ad4" have entirely different histories.

8 changed files with 61 additions and 125 deletions

View File

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

View File

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

View File

@ -99,12 +99,6 @@ 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
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

View File

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

View File

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

View File

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

View File

@ -79,28 +79,16 @@ focus from entry to step through the completions then RET activates
* [done] show loading progress
* [done] show url when the commander is inactive
* [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)
* less ugly default completions rendering
* buffer name is often going to be useless. find buffers 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
a text-representable form of same
* click in commander widget activates visit-location
* in general, can we bind commands to widget events?
* display unbound key error
* ESC to cancel interactive command
* autocomplete command name
* command to create new buffer
* keyboard navigation of completions
----
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
* multiple buffers
- create buffer
- list buffers (do we need this if we have thumbnails?)

View File

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