dunlin/command.fnl

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

(local commands {})

(local Buffer (require :buffer))

(fn define-command [name ordered-params function]
  ;; required parameter names and default arguments
  (let [param-names (icollect [_ [name] (pairs ordered-params)] name)
        params (collect [_ [name completer default] (pairs ordered-params)]
                 (values name {: completer : default}))
        v {: name
           : function
           : param-names
           : params}]
    (tset commands name v)))

(define-command
 "quit-browser"
 []
 #(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
   (fn [term] (collect [v (_G.history:find term)] (values v.url v.url)))
   #($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))

(local default-state {
                      :active false
                      :command nil
                      :collected-params {}
                      :this-param nil
                      })

(fn next-param [command params]
  (accumulate [v nil
               _ k (ipairs command.param-names)
               &until v]
    (if (. params k) nil k)))

(fn next-action [self input-string]
  (let [state self.state
        state-for-next-param
        (fn [c params]
          (match (next-param c params)
            k1 {
                :command c
                :this-param k1
                :collected-params params
                :active true
                }
            _ (let [params (lume.extend {} {:frame self.frame} params)]
                (c.function 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}
      (let [{ : completer}  (. c.params k)
            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 (print "unexpected state " (view state))
            state)
      )))

(fn on-input-finished [self str]
  (let [s (next-action self str)
        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 [{ : widget : 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 ""))
  (when widget.parent
    (widget.parent:set_visible_child_name
     (if result.active "commander" "echo-area"))))

(fn on-input [self str]
  (match self.state
    {:command c :this-param param-name}
    (let [parent self.completions-widget
          { : 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-input-finished text))
                      })))
      (parent:show_all)
      )))


(fn activate [{: state : entry : prompt &as self}]
  (tset state :active true)
  (update-widget-state
   self
   {:active true
    :prompt (or state.this-param  "Command" "")
    })
  (entry:grab_focus)
  state)

(fn deactivate [{: state : entry : prompt &as self}]
  (doto state
    (lume.clear)
    (tset :active false))
  (update-widget-state self {:active false}))

(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 supplied-params
           }]
    (set self.state s)
    (let [r (self:on-input-finished nil)]
      (update-widget-state self r)
      (self.entry:grab_focus)
      r)))

(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
              : deactivate
              :active? (fn [self] self.state.active)
              : on-input
              : on-input-finished
              : 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-input-finished event.text)]
              (update-widget-state self result))))
    self))


{
 :commander new-commander
 : define-command
 }