fix hardcoded visit-buffer param default

for recognising key sequences, we only want  to look at
events containing non-modifier keystrokes

.gitignore

@@ -0,0 +1 @@
+doc/index.html

.overmind.env

@@ -0,0 +1 @@
+OVERMIND_AUTO_RESTART=test

Makefile

@@ -2,4 +2,4 @@ doc/index.html: doc/index.md
 	pandoc -t html -f gfm < $< > $@
 
 watch:
-	while true ; do ( find . -type f | entr -d sh test/run.sh ) ;done
+	find . -type f | entr -c -d sh test/run.sh

buffer.fnl

@@ -33,6 +33,14 @@
           (let [b (new-buffer name)]
             (tset buffers name b)
             b))
-   :current (fn [] (let [k (next buffers)] (. buffers k)))
    :find (fn [term] (. buffers term))
+   ;; will rename this to "find" once we've got rid of the
+   ;; only remaining call to the existing Buffer.find
+   :match (fn [s] (collect [name buffer (pairs buffers)]
+                    (if (string.find name s)
+                        (values name buffer))))
+   :next (fn [buffer]
+           (let [n (or (next buffers buffer.name) (next buffers))]
+             (. buffers n)))
+
    })

command.fnl

@@ -1,23 +1,16 @@
 (local { : Gtk  } (require :lgi))
 (local { : view } (require :fennel))
+(local lume (require :lume))
 
 (local commands {})
 
 (local Buffer (require :buffer))
 
-(fn by-pairs [a]
+(fn define-command [name ordered-params function]
-  (let [iter (fn [_ a]
-               (match a
-                 [k v & rest] (values rest k v)
-                 _ nil))]
-    (values iter a a)))
-
-(fn define-command [name function ordered-params]
   ;; required parameter names and default arguments
-  (let [param-names (icollect [_ name val (by-pairs ordered-params)]
+  (let [param-names (icollect [_ [name] (pairs ordered-params)] name)
-                      name)
+        params (collect [_ [name completer default] (pairs ordered-params)]
-        params (collect [_ name val (by-pairs ordered-params)]
+                 (values name {: completer : default}))
-                 (values name val))
         v {: name
            : function
            : param-names
@@ -26,15 +19,27 @@
 
 (define-command
  "quit-browser"
- #(Gtk.main_quit) [])
+ []
+ #(Gtk.main_quit))
+
+(define-command
+ "switch-to-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  #(doto {} (tset $1 $1)) #(do "http://www.example.com")]
+  ]
  (fn [{:url url :buffer buffer}]
-   (let [b (Buffer.find buffer)] (: b :visit url)))
+   (buffer:visit url)))
- [:buffer (fn [] (. (Buffer.current) :name))
-  :url #(do "http://www.example.com")
-  ])
 
 (fn find-command [name]
   (. commands name))
@@ -46,10 +51,6 @@
                       :this-param nil
                       })
 
-(var state default-state)
-(fn reset-state []
-  (set state default-state))
-
 (fn next-param [command params]
   (accumulate [v nil
                _ k (ipairs command.param-names)
@@ -59,8 +60,9 @@
 (fn invoke-command [command params]
   (command.function params))
 
-(fn next-action [state input-string]
+(fn next-action [self input-string]
-  (let [state-for-next-param
+  (let [state self.state
+        state-for-next-param
         (fn [c params]
           (match (next-param c params)
             k1 {
@@ -69,7 +71,9 @@
                 :collected-params params
                 :active true
                 }
-        _ (do (invoke-command c params) {:active false})))]
+            _ (let [params (lume.extend {} {:frame self.frame} params)]
+                (invoke-command c  params)
+                {:active false})))]
 
     (match state
       {:active false} state
@@ -86,8 +90,10 @@
          })
 
       {:command c :this-param k :collected-params p}
-      (do
+      (let [{ : completer}  (. c.params k)
-        (tset p k 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}
@@ -98,75 +104,102 @@
             state)
       )))
 
-(fn on-input [str]
+(fn on-activate [self str]
-  (let [s (next-action state str)
+  (let [s (next-action self 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.default self.frame))
      }))
 
-(local prompt (Gtk.Label { :label ""}))
+(fn update-widget-state [{ : entry : completions-widget : prompt} result]
+  (set prompt.label (or result.prompt ""))
+  (set entry.sensitive result.active)
+  (if (not result.active)
+      (completions-widget:hide))
+  (set entry.text (or result.default result.error "")))
 
-(fn update-widget-state [w result]
+(fn on-input [self str]
-  (set  prompt.label (or result.prompt ""))
+  (match self.state
-  (set w.sensitive result.active)
+    {:command c :this-param param-name}
-  (set w.text
+    (let [parent self.completions-widget
-       (or result.default result.error "")))
+          { : completer}  (. c.params param-name)
+          completions (completer str)]
+      (parent:foreach #(parent:remove $1))
+      (each [text _w (pairs completions)]
+        (parent:add (Gtk.Button {
+                                 :label text
+                                 :on_clicked
+                                 #(update-widget-state self (self:on-activate text))
+                                 })))
+      (parent:show_all)
+      )))
 
-(local widget
-       (let [w (Gtk.Entry {
-                          :sensitive false
-                          })]
-         (tset w :on_activate
-               (fn [event]
-                 (update-widget-state w (on-input event.text))))
-         w))
 
-(local box
+(fn activate [{: state : entry : prompt}]
-       (let [box
-             (Gtk.Box {
-                       :orientation Gtk.Orientation.HORIZONTAL
-                 })]
-
-         (box:pack_start prompt false false 15)
-         (box:pack_start widget true true 5)
-         box))
-
-(fn activate []
   (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" ""))
-  (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)
+    (set self.state s)
-    (let [r (on-input nil)]
+    (let [r (self:on-activate nil)]
-      (update-widget-state widget r)
+      (update-widget-state self r)
-      (widget:grab_focus)
+      (self.entry:grab_focus)
       r)))
 
-(fn active? [] state.active)
+(fn new-commander [frame]
+  (let [entry (Gtk.Entry {:sensitive false })
+        prompt (Gtk.Label { :label ""})
+        box (Gtk.Box {
+                      :orientation Gtk.Orientation.VERTICAL
+                      })
+        hbox (Gtk.Box {
+                      :orientation Gtk.Orientation.HORIZONTAL
+                      })
+        completions (Gtk.FlowBox)
+        self {
+              :state default-state
+              : activate
+              :active? (fn [self] self.state.active)
+              : on-input
+              : on-activate
+              : invoke-interactively
+              : entry
+              :widget box
+              : prompt
+              : frame
+              :completions-widget completions
+              }]
+    (hbox:pack_start prompt false false 15)
+    (hbox:pack_start entry true true 5)
+    (box:pack_start hbox true false 0)
+    (box:pack_start completions true true 0)
+    (tset entry :on_changed
+          (fn [event]
+            (self:on-input event.text)))
+    (tset entry :on_activate
+          (fn [event]
+            (let [result  (self:on-activate event.text)]
+              (update-widget-state self result))))
+    self))
+
 
 {
- : activate
+ :commander new-commander
- : active?
  : define-command
- : on-input
- : invoke-interactively
- :widget box
- :_ {
-     : reset-state
-     }
  }

default.nix

@@ -19,11 +19,26 @@
 , writeText
 }:
 let pname = "dunlin";
+    lume = let lua = lua5_3; in lua53Packages.buildLuaPackage rec {
+      pname = "lume";
+      version = "1";
+      src = fetchFromGitHub {
+        repo = "lume"; owner = "rxi";
+        rev = "98847e7812cf28d3d64b289b03fad71dc704547d";
+        hash = "sha256-/u23EqgjjkU8FV9oXvMNXBkY8JAOJUhJAzXTSibJthU=";
+      };
+      buildPhase = ":";
+      installPhase = ''
+        mkdir -p "$out/share/lua/${lua.luaversion}"
+        cp lume.lua "$out/share/lua/${lua.luaversion}"
+      '';
+    };
     lua = lua5_3.withPackages (ps: with ps; [
       lgi
       luafilesystem
       luaposix
       readline
+      lume
     ]);
     fennel_ = lua.pkgs.fennel;
     glib_networking_gio  = "${glib-networking}/lib/gio/modules";

dunlin.fnl

@@ -9,18 +9,12 @@
 ;;; when we decide how to do an init file/rc file, this will go in it
 
 (local my-keymap {
-                  "g" #(Command.invoke-interactively
+                  "g" ["visit-location" {:buffer #$1.buffer }]
-                        "visit-location"
+                  "M-q" ["quit-browser" {}]
-                        {:buffer "main"})
-                  "M-q" #(Command.invoke-interactively
-                          "quit-browser"
-                          {})
                   "C-x" {
-                       "C-c"
+                         "C-c" ["quit-browser" {}]
-                       #(Command.invoke-interactively
+                         "b" ["switch-to-buffer" {}]
-                         "quit-browser"
+                         }
-                         {})
-                       }
                   })
 
 (let [f (Frame.new my-keymap)

frame.fnl

@@ -1,5 +1,7 @@
 (local { : Gtk : Gdk : WebKit2 : cairo } (require :lgi))
 (local { : view } (require :fennel))
+(local lume (require :lume))
+
 (local Command (require :command))
 (local keymap (require :keymap))
 
@@ -8,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
@@ -30,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)
-                c (c)
+                [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)
@@ -52,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)
+      (lume.extend self f)
-      f)))
+      (table.insert frames self)
+      self)))
 
 
 { :new new-frame :frames frames }

keymap.fnl

@@ -1,6 +1,24 @@
 (local { : Gdk } (require :lgi))
 (local { : view } (require :fennel))
 
+(local modifier-keyvals
+       {
+        ;; These aren't canonical or official, this is just the
+        ;; result of pressing keys on my keyboard. If Gtk/Gdk/GI
+        ;; implemented KeyEvent.is_modifier we wouldn't have to
+        ;; do this
+        65507 :control_l
+        65505 :shift_l
+        269025067 :fn
+        65515 :windows
+        65513 :alt_l
+        65027 :alt_gr
+        65508 :control_r
+        })
+
+(fn modifier? [keyval]
+  (. modifier-keyvals keyval))
+
 (fn keychord->spec [keychord]
   (let [Mod Gdk.ModifierType
         symbol (keychord:match "(%w+)$")
@@ -26,13 +44,17 @@
           (bor m (. Gdk.ModifierType k)))]
     (spec->index {:keyval event.keyval : modmask})))
 
+(fn designates-command? [tbl]
+  ;; a keymap entry has a string as key, a command
+  ;; definition is a numerically-indexed array
+  (if (. tbl 1) true))
 
 (fn compile-keymap [input]
   (collect [k v (pairs input)]
     (let [f (-> k keychord->spec spec->index)]
-      (match (type v)
+      (if (designates-command? v)
-        "function" (values f v)
+          (values f v)
-        "table" (values f (compile-keymap v))))))
+          (values f (compile-keymap v))))))
 
 (fn recogniser [source-keymap]
   (let [keymap (compile-keymap source-keymap)]
@@ -40,20 +62,20 @@
     {
      :accept-event
      (fn [_ e]
-       (let [c (event->index e)
+       (when (not (modifier? e.keyval))
-             v (. m c)]
+         (let [c (event->index e)
-         (match (type v)
+               v (. m c)]
-           "table" (do
+           (if v
+               (if (designates-command? v)
+                   (do
+                     (set m keymap)
+                     v)
+                   (do
                      (set m v)
-                     (values nil (.. c " ")))
+                     (values nil (.. c " "))))
-           "function" (do
+               (do
-                        (set m keymap)
+                 (set m keymap)
-                        v)
+                 (values nil (.. "No binding for " (view e) " ")))))))
-           "nil" (do
-                   (set m keymap)
-                   (values nil (.. "No binding for " (view e) " ")))
-
-           )))
      }))
 
 

musing.md

@@ -36,14 +36,52 @@ lua's standard types
 
 ## next steps
 
-* change define-command so that the parameters are ordered
+* [done] change define-command so that the parameters are ordered
 * display unbound key error
 * ESC to cancel interactive command
 * autocomplete command name
 * parameters with non-string values (e.g. buffer)
 * show current url when command inactive
-* show prompts for parameter
+* [done] show prompts for parameter
 * multiple buffers
   - create buffer
   - list buffers (where does the output go?)
   - find and switch to buffer
+
+
+how do we do the buffer list thing?
+- generate html, or
+- use native widgets
+
+native widgets seems neater
+- how do we permit commands to insert widgets into the frame?
+- how do we get rid of them?
+
+we could have an "output overlay" inserted underneath the commander.
+could we use the same thing for completions? we haven't addressed
+non-string parameters yet, really
+
+M-x switch-to-buffer
+ Buffer mai_
+
+ +------+  +---------+
+ | main |  | mailing |
+ +------+  +---------+
+
+
+-----
+
+so there are two things going on here
+
+1) how to implement switch-to-buffer with appropriate autocomplete
+on the buffer name - perhaps involving showing buffer thumbnails etc
+
+2) in emacs, not all buffers are files - e.g. the buffer list, or the
+process list, or the magit status buffer - there is a well-used
+affordance for elisp to put semi-persistent interactable content
+onscreen - do we need such a thing here or is it ok to say "just call
+gtk" to command authors
+
+are these the same problem or are they separate problems? do we have
+the second problem?  What I will do is address the first one and
+see if it's generalisable once I've done it.

test/command.fnl

@@ -3,41 +3,48 @@
 (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) [])
+(Command.define-command
+ "no-args-command"
+ []
+ #(set happened true))
 
 (Command.define-command
  "multiply"
- (fn [{: a : b }] (set happened (* (tonumber a) (tonumber b))))
+ [[:a #{$1 $1} #"3"]
- [:a #(do "3") :b #(do "2")])
+  [:b #{$1 $1} #"2"]]
+ (fn [{: a : b }] (set happened (* (tonumber a) (tonumber b)))))
 
 (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-activate "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)
+(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-activate "multiply")
-        {:active true :prompt p2} (Command.on-input "3")
+        {:active true :prompt p1} (commander:on-activate "2")
+        {:active true :prompt p2} (commander:on-activate "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 "???"))]

test/keymap.fnl

@@ -6,13 +6,15 @@
 
 (local Mod Gdk.ModifierType)
 
-(local km
+(local km {
-       {"a"
+           "a" {
-        {"a" #1
+                "a" ["command-1"]
-         "b" #2}
+                "b" ["command-2" {:arg-1 "10" :arg-2 "11"}]
-        "b"
+                }
-        {"z" #3}
+           "b" {
-        "c" #4
+                "z" ["command-3"]
+                }
+           "c" ["command-4"]
         })
 
 (fn fake-key-event [c]
@@ -40,8 +42,16 @@
 (let [r (keymap.recogniser km)
       (ok err)
       (match (r:accept-event (fake-key-event "c"))
-        (where f (= (f) 4)) true
+        ["command-4"] true
         x (values false (view x))
         nil (values false "???"))]
-
+  (assert ok err))
+
+(let [r (keymap.recogniser km)
+      (ok err)
+      (match-try
+          (r:accept-event (fake-key-event "a"))
+        nil (r:accept-event (fake-key-event "b"))
+        ["command-2"  {:arg-1 "10" :arg-2 "11"}] true
+        (catch x (values false (view x))))]
   (assert ok err))