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

buffer.fnl

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

command.fnl

@@ -24,23 +24,22 @@
 
 (define-command
  "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)))
 
 (define-command
  "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)))
 
+(define-command
+ "back"
+ [[:buffer Buffer.match #$1.buffer.name]]
+ (fn [{: buffer}] (buffer:back)))
+
 (fn find-command [name]
   (. commands name))
 
@@ -57,9 +56,6 @@
                &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
@@ -72,7 +68,7 @@
                 :active true
                 }
             _ (let [params (lume.extend {} {:frame self.frame} params)]
-                (invoke-command c  params)
+                (c.function params)
                 {:active false})))]
 
     (match state
@@ -91,14 +87,12 @@
 
       {:command c :this-param k :collected-params p}
       (let [{ : completer}  (. c.params k)
-            vals (completer input-string)
+            value (. (completer input-string) input-string)]
-            value (. vals input-string)]
         (tset p k value)
         (state-for-next-param c 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))
             state)
@@ -109,18 +103,20 @@
         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 [{ : entry : completions-widget : prompt} result]
+(fn update-widget-state [{ : state : widget : entry : completions-widget : prompt} result]
   (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))
-  (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]
   (match self.state
@@ -143,17 +139,16 @@
   (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 {:active false}))
+  (update-widget-state self {}))
 
 (fn invoke-interactively [self name params]
   (let [c (find-command name)
@@ -192,9 +187,6 @@
               :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)

doc/index.md

@@ -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
 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
 

dunlin.fnl

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

frame.fnl

@@ -12,7 +12,15 @@
         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
@@ -35,16 +43,26 @@
                         :estimated-load-progress
                         (tset progress-bar :fraction value)
                         :uri
-                        (commander:set-inactive-text value)
+                        (tset echo-area :label 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) (print "prompted" prompt)))
+                (nil prompt) (tset echo-area :label prompt)))
             (when (and (commander:active?)
                        (= keymap.keyval.Escape event.keyval))
               (commander:deactivate))
@@ -53,10 +71,9 @@
                        (= event.keyval (string.byte "x")))
               (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:show_all)
     (let [f
@@ -64,6 +81,8 @@
            :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))

keymap.fnl

@@ -1,5 +1,6 @@
 (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
@@ -29,15 +30,15 @@
 (fn keychord->spec [keychord]
   (let [Mod Gdk.ModifierType
         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+)-")]
                   (match (v:lower)
                     "m" (bor m Mod.MOD1_MASK)
                     "c" (bor m Mod.CONTROL_MASK)
                     "s" (bor m Mod.MOD4_MASK)))]
     {
-     :keyval (string.byte (symbol:lower))
+     :keyval (Gdk.keyval_from_name symbol)
      : modmask
      }))
 
@@ -51,6 +52,25 @@
           (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
@@ -66,40 +86,53 @@
           (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 m keymap)
+    (var key-sequence [])
     {
      :accept-event
      (fn [_ e]
        (when (not (modifier? e.keyval))
          (let [c (event->index e)]
-           (match (. m c)
+           (table.insert key-sequence c)
+           (match (ref keymap key-sequence)
              (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))
              (do
-               (set m keymap)
+               (set key-sequence [])
                v)
 
              (where nil (= c "103:4"))
              (do
-               (set m keymap)
+               (set key-sequence [])
                (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
-  :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
       : keychord->spec

musing.md

@@ -79,16 +79,28 @@ 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)
-* 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
    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
-* 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

test/keymap.fnl

@@ -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 13} true
+    {:keyval 122 :modmask 12} true
     _ (assert false (view s))))