command.fnl (7914B)
1 (local { : Gtk } (require :lgi)) 2 (local { : view } (require :fennel)) 3 (local lume (require :lume)) 4 5 (local commands {}) 6 7 (local Buffer (require :buffer)) 8 9 (fn define-command [name ordered-params function] 10 ;; required parameter names and default arguments 11 (let [param-names (icollect [_ [name] (pairs ordered-params)] name) 12 params (collect [_ [name completer default] (pairs ordered-params)] 13 (values name {: completer : default})) 14 v {: name 15 : function 16 : param-names 17 : params}] 18 (tset commands name v))) 19 20 (fn completion [{: widget : text : value }] 21 (let [value (or value (assert text "must have text"))] 22 { 23 :widget (or widget (Gtk.Label { :label text })) 24 : text 25 : value 26 })) 27 28 (define-command 29 "quit-browser" 30 [] 31 #(Gtk.main_quit)) 32 33 34 (define-command 35 "switch-to-buffer" 36 [[:buffer 37 #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) 38 #(. (Buffer.next $1.buffer) :name)] 39 ] 40 (fn [{:frame frame :buffer buffer}] 41 (frame:show-buffer buffer))) 42 43 (define-command 44 "visit-location" 45 [[:buffer 46 #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) 47 #$1.buffer.name] 48 [:url 49 (fn [term] 50 (let [from-history 51 (if (> (# term) 2) 52 (icollect [v (_G.history:find-distinct term)] 53 (let [label (.. v.url " " (or v.title ""))] 54 (completion { :text v.url 55 :widget (Gtk.Label { : label }) 56 :value v.url 57 }))) 58 [])] 59 (lume.unique (lume.concat from-history [(completion {:text term})])))) 60 #($1.buffer:location)] 61 ] 62 (fn [{:url url :buffer buffer}] 63 (buffer:visit url))) 64 65 (define-command 66 "back" 67 [[:buffer 68 #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) 69 #$1.buffer.name]] 70 (fn [{: buffer}] (buffer:back))) 71 72 73 (fn find-command [name] 74 (. commands name)) 75 76 (local default-state { 77 :active false 78 :command nil 79 :collected-params {} 80 :this-param nil 81 }) 82 83 (fn next-param [command params] 84 (accumulate [v nil 85 _ k (ipairs command.param-names) 86 &until v] 87 (if (. params k) nil k))) 88 89 (fn next-action [self input-string] 90 (let [state self.state 91 state-for-next-param 92 (fn [c params] 93 (match (next-param c params) 94 k1 { 95 :command c 96 :this-param k1 97 :collected-params params 98 :active true 99 } 100 _ (let [params (lume.extend {} {:frame self.frame} params)] 101 (c.function params) 102 {:active false})))] 103 104 (match state 105 {:active false} state 106 107 {:command nil} 108 (match (find-command input-string) 109 {: name : params &as c} 110 (state-for-next-param c {}) 111 112 nil 113 { 114 :active false 115 :error (.. "can't find command " input-string) 116 }) 117 118 {:command c :this-param k :collected-params p} 119 (let [{ : completer} (. c.params k) 120 vals (completer input-string) 121 chosen (lume.match vals #(= $1.text input-string))] 122 (assert chosen (view { : vals : input-string })) 123 (tset p k chosen.value) 124 (state-for-next-param c p)) 125 126 {:command c :this-param nil :collected-params p} 127 (state-for-next-param c p) 128 129 _ (do (print "unexpected state " (view state)) 130 state) 131 ))) 132 133 (fn on-input-finished [self str] 134 (let [s (next-action self str) 135 param (if s.active (. (. s.command :params) s.this-param))] 136 (set self.state s) 137 { 138 :active s.active 139 :error s.error 140 :prompt (if s.active (or s.this-param "Command?" "") "") 141 :default (and param (param.default self.frame)) 142 })) 143 144 (fn update-widget-state [{ : widget : entry : completions-widget : prompt} result] 145 (set prompt.label (or result.prompt "")) 146 (set entry.sensitive result.active) 147 (if (not result.active) 148 (completions-widget:hide)) 149 (set entry.text (or result.default result.error "")) 150 (if result.active (entry:grab_focus)) 151 152 (when widget.parent 153 (widget.parent:set_visible_child_name 154 (if result.active "commander" "echo-area")))) 155 156 (fn on-input [self str] 157 (let [parent self.completions-widget 158 set-completions 159 (fn [completions] 160 (let [flowbox (Gtk.FlowBox { 161 :activate_on_single_click true 162 :selection_mode Gtk.SelectionMode.SINGLE 163 }) 164 ;; I don't know why, but the flowboxchild activate signal 165 ;; is working only for keyboard activation not for 166 ;; clicking. So instead of using it we connect to 167 ;; child_activated, and use kids-map to find out which 168 ;; child it was 169 kids-map {}] 170 (parent:foreach #(parent:remove $1)) ; expect only 1 direct child 171 (each [_ c (pairs completions)] 172 (let [fbc (Gtk.FlowBoxChild)] 173 (tset kids-map fbc c.text) 174 (fbc:add c.widget) 175 (flowbox:add fbc))) 176 (tset flowbox :on_child_activated 177 (fn [_self child] 178 (match (. kids-map child) 179 text (update-widget-state 180 self 181 (self:on-input-finished text))))) 182 (parent:add flowbox)) 183 (parent:show_all))] 184 (match self.state 185 {:command c :this-param param-name} 186 (let [{ : completer} (. c.params param-name)] 187 (set-completions (completer str))) 188 189 {:command nil} 190 (set-completions 191 (icollect [k _ (pairs commands)] 192 (if (= (k:find str 1 true) 1) (completion { :text k}))))))) 193 194 (fn activate [{: state : entry : prompt &as self}] 195 (tset state :active true) 196 (update-widget-state 197 self 198 {:active true 199 :prompt (or state.this-param "Command" "") 200 }) 201 (entry:grab_focus) 202 state) 203 204 (fn deactivate [{: state : entry : prompt &as self}] 205 (doto state 206 (lume.clear) 207 (tset :active false)) 208 (update-widget-state self {:active false})) 209 210 (fn invoke-interactively [self name params] 211 (let [c (find-command name) 212 supplied-params (collect [k v (pairs params)] 213 (values k (v self.frame))) 214 s { 215 :active true 216 :command c 217 :collected-params supplied-params 218 }] 219 (set self.state s) 220 (let [r (self:on-input-finished nil)] 221 (update-widget-state self r) 222 (self.entry:grab_focus) 223 r))) 224 225 (fn new-commander [frame] 226 (let [entry (Gtk.Entry {:sensitive false }) 227 prompt (Gtk.Label { :label ""}) 228 box (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) 229 hbox (Gtk.Box { :orientation Gtk.Orientation.HORIZONTAL }) 230 completions (Gtk.Box { :orientation Gtk.Orientation.VERTICAL }) 231 self { 232 :state default-state 233 : activate 234 : deactivate 235 :active? (fn [self] self.state.active) 236 : on-input 237 : on-input-finished 238 : invoke-interactively 239 : entry 240 :widget box 241 : prompt 242 : frame 243 :completions-widget completions 244 }] 245 (hbox:pack_start prompt false false 15) 246 (hbox:pack_start entry true true 5) 247 (box:pack_start hbox true false 0) 248 (box:pack_start completions true true 0) 249 (tset entry :on_changed #(self:on-input $1.text)) 250 (tset entry :on_activate 251 #(update-widget-state self (self:on-input-finished $1.text))) 252 self)) 253 254 255 { 256 :commander new-commander 257 : define-command 258 : completion 259 }