260 lines
7.7 KiB
Fennel
260 lines
7.7 KiB
Fennel
(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)))
|
|
|
|
(fn completion [{: widget : text : value }]
|
|
(let [value (or value (assert text "must have text"))]
|
|
{
|
|
:widget (or widget (Gtk.Label { :label text }))
|
|
: text
|
|
: value
|
|
}))
|
|
|
|
(define-command
|
|
"quit-browser"
|
|
[]
|
|
#(Gtk.main_quit))
|
|
|
|
|
|
(define-command
|
|
"switch-to-buffer"
|
|
[[:buffer
|
|
#(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
|
|
#(. (Buffer.next $1.buffer) :name)]
|
|
]
|
|
(fn [{:frame frame :buffer buffer}]
|
|
(frame:show-buffer buffer)))
|
|
|
|
(define-command
|
|
"visit-location"
|
|
[[:buffer
|
|
#(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
|
|
#$1.buffer.name]
|
|
[:url
|
|
(fn [term]
|
|
(let [from-history
|
|
(if (> (# term) 2)
|
|
(icollect [v (_G.history:find-distinct term)]
|
|
(let [label (.. v.url " " (or v.title ""))]
|
|
(completion { :text v.url
|
|
:widget (Gtk.Label { : label })
|
|
:value v.url
|
|
})))
|
|
[])]
|
|
(lume.unique (lume.concat from-history [(completion {:text term})]))))
|
|
#($1.buffer:location)]
|
|
]
|
|
(fn [{:url url :buffer buffer}]
|
|
(buffer:visit url)))
|
|
|
|
(define-command
|
|
"back"
|
|
[[:buffer
|
|
#(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
|
|
#$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)
|
|
chosen (lume.match vals #(= $1.text input-string))]
|
|
(assert chosen (view { : vals : input-string }))
|
|
(tset p k chosen.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 ""))
|
|
(if result.active (entry:grab_focus))
|
|
|
|
(when widget.parent
|
|
(widget.parent:set_visible_child_name
|
|
(if result.active "commander" "echo-area"))))
|
|
|
|
(fn on-input [self str]
|
|
(let [parent self.completions-widget
|
|
set-completions
|
|
(fn [completions]
|
|
(let [flowbox (Gtk.FlowBox {
|
|
:activate_on_single_click true
|
|
:selection_mode Gtk.SelectionMode.SINGLE
|
|
})
|
|
;; I don't know why, but the flowboxchild activate signal
|
|
;; is working only for keyboard activation not for
|
|
;; clicking. So instead of using it we connect to
|
|
;; child_activated, and use kids-map to find out which
|
|
;; child it was
|
|
kids-map {}]
|
|
(parent:foreach #(parent:remove $1)) ; expect only 1 direct child
|
|
(each [_ c (pairs completions)]
|
|
(let [fbc (Gtk.FlowBoxChild)]
|
|
(tset kids-map fbc c.text)
|
|
(fbc:add c.widget)
|
|
(flowbox:add fbc)))
|
|
(tset flowbox :on_child_activated
|
|
(fn [_self child]
|
|
(match (. kids-map child)
|
|
text (update-widget-state
|
|
self
|
|
(self:on-input-finished text)))))
|
|
(parent:add flowbox))
|
|
(parent:show_all))]
|
|
(match self.state
|
|
{:command c :this-param param-name}
|
|
(let [{ : completer} (. c.params param-name)]
|
|
(set-completions (completer str)))
|
|
|
|
{:command nil}
|
|
(set-completions
|
|
(icollect [k _ (pairs commands)]
|
|
(if (= (k:find str 1 true) 1) (completion { :text k})))))))
|
|
|
|
(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.Box { :orientation Gtk.Orientation.VERTICAL })
|
|
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 #(self:on-input $1.text))
|
|
(tset entry :on_activate
|
|
#(update-widget-state self (self:on-input-finished $1.text)))
|
|
self))
|
|
|
|
|
|
{
|
|
:commander new-commander
|
|
: define-command
|
|
: completion
|
|
}
|