dunlin/command.fnl

(local { : Gtk  } (require :lgi))
(local { : view } (require :fennel))

(local commands {})

(local Buffer (require :buffer))

(fn by-pairs [a]
  (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)]
                      name)
        params (collect [_ name val (by-pairs ordered-params)]
                 (values name val))
        v {: name
           : function
           : param-names
           : params}]
    (tset commands name v)))

(define-command
 "quit-browser"
 #(Gtk.main_quit) [])

(define-command
 "visit-location"
 (fn [{:url url :buffer buffer}]
   (let [b (Buffer.find buffer)] (: b :visit url)))
 [:buffer (fn [] (. (Buffer.current) :name))
  :url #(do "http://www.example.com")
  ])

(fn find-command [name]
  (. commands name))

(local default-state {
                      :active false
                      :command nil
                      :collected-params {}
                      :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)
               &until v]
    (if (. params k) nil k)))

(fn invoke-command [command params]
  (command.function params))

(fn next-action [state input-string]
  (let [state-for-next-param
        (fn [c params]
          (match (next-param c params)
            k1 {
                :command c
                :this-param k1
                :collected-params params
                :active true
                }
        _ (do (invoke-command c params) {:active false})))]

    (match state
      {:active false} state

      {:command nil}
      (match (find-command input-string)
        {: name : params &as c}
        (state-for-next-param c {})

        nil
        {
         :active false
         :error (.. "can't find command " input-string)
         })

      {:command c :this-param k :collected-params p}
      (do
        (tset p k input-string)
        (state-for-next-param c p))

      {:command c :this-param nil :collected-params p}
      (do
        (state-for-next-param c p))

      _ (do (print "unexpected state " (view state))
            state)
      )))

(fn on-input [str]
  (let [s (next-action state str)
        param (if s.active (. (. s.command :params) s.this-param))]
    (set state s)
    {
     :active s.active
     :error s.error
     :prompt (if s.active (or s.this-param  "Command?" "") "")
     :default (and param (param))
     }))

(local prompt (Gtk.Label { :label ""}))

(fn update-widget-state [w result]
  (set  prompt.label (or result.prompt ""))
  (set w.sensitive result.active)
  (set w.text
       (or result.default result.error "")))

(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
       (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 widget.text "")
  (set prompt.label (or state.this-param  "Command" ""))
  (widget:grab_focus)
  state)

(fn invoke-interactively [name params]
  (let [c (find-command name)
        s {
           :active true
           :command c
           :collected-params params
           }]
    (set state s)
    (let [r (on-input nil)]
      (update-widget-state widget r)
      (widget:grab_focus)
      r)))

(fn active? [] state.active)

{
 : activate
 : active?
 : define-command
 : on-input
 : invoke-interactively
 :widget box
 :_ {
     : reset-state
     }
 }