From 34fb1b2ff44f2a016a58f74cfbf72538340ee321 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 15 Jan 2023 13:04:35 +0000 Subject: [PATCH] revisit completer/completion api A completion is now a table with attributes :text, :widget, :value A completer returns an array of completions This means we can now render URL completions with the page title as well as the URL --- buffer.fnl | 4 ++-- command.fnl | 45 +++++++++++++++++++++++++++++++++------------ history.fnl | 7 +++++++ test/command.fnl | 11 +++++++++-- 4 files changed, 51 insertions(+), 16 deletions(-) diff --git a/buffer.fnl b/buffer.fnl index f54c369..fb4440f 100644 --- a/buffer.fnl +++ b/buffer.fnl @@ -44,9 +44,9 @@ :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)] + :match (fn [s] (icollect [name buffer (pairs buffers)] (if (string.find name s) - (values name buffer)))) + (values buffer)))) :next (fn [buffer] (let [n (or (next buffers buffer.name) (next buffers))] (. buffers n))) diff --git a/command.fnl b/command.fnl index 77a1ca6..620b88a 100644 --- a/command.fnl +++ b/command.fnl @@ -17,15 +17,24 @@ : params}] (tset commands name v))) +(fn completion [{: widget : text : value }] + (let [value (or value (assert text "must have text"))] + { + :widget (or widget (Gtk.Button { :label text })) + : text + : value + })) + (define-command "quit-browser" [] #(Gtk.main_quit)) + (define-command "switch-to-buffer" [[:buffer - Buffer.match + #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) #(. (Buffer.next $1.buffer) :name)] ] (fn [{:frame frame :buffer buffer}] @@ -34,10 +43,18 @@ (define-command "visit-location" [[:buffer - Buffer.match + #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) #$1.buffer.name] [:url - (fn [term] (collect [v (_G.history:find term)] (values v.url v.url))) + (fn [term] + (if (> (# term) 2) + (icollect [v (_G.history:find-distinct term)] + (let [label (.. v.url " " (or v.title ""))] + (completion { :text v.url + :widget (Gtk.Button { : label }) + :value v.url + }))) + [])) #($1.buffer:location)] ] (fn [{:url url :buffer buffer}] @@ -45,7 +62,9 @@ (define-command "back" - [[:buffer Buffer.match #$1.buffer.name]] + [[:buffer + #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 })) + #$1.buffer.name]] (fn [{: buffer}] (buffer:back))) (fn find-command [name] @@ -96,8 +115,9 @@ {: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) + 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} @@ -133,13 +153,13 @@ set-completions (fn [completions] (parent:foreach #(parent:remove $1)) - (each [text _w (pairs completions)] + (each [_ c (pairs completions)] (parent:add - (Gtk.Button { - :label text - :on_clicked - #(update-widget-state self (self:on-input-finished text)) - }))) + (doto c.widget + (tset :on_clicked + #(update-widget-state + self + (self:on-input-finished c.text)))))) (parent:show_all))] (match self.state {:command c :this-param param-name} @@ -223,4 +243,5 @@ { :commander new-commander : define-command + : completion } diff --git a/history.fnl b/history.fnl index e152732..a508371 100644 --- a/history.fnl +++ b/history.fnl @@ -41,6 +41,12 @@ (assert (= 0 (s:bind_values term))) (s:nrows))) +(fn find-distinct [self term] + (print :self self :term term) + (let [s (self.db:prepare "select distinct v.url,pt.title from visits v left join page_titles pt on v.url = pt.url where instr(v.url, ?) >0")] + (assert (= 0 (s:bind_values term))) + (s:nrows))) + (fn open [pathname] (let [db (if pathname (sqlite.open pathname) (sqlite.open_memory))] (migrate-all db) @@ -49,6 +55,7 @@ : visit : title : find + : find-distinct })) { diff --git a/test/command.fnl b/test/command.fnl index 8982661..5ae41e7 100644 --- a/test/command.fnl +++ b/test/command.fnl @@ -5,6 +5,13 @@ (var happened false) (fn before [] (set happened false)) +(assert + (match (Command.completion { :text "foo" }) + (where { : widget : text : value } + (= text "foo") + (= value "foo")) + true)) + (Command.define-command "no-args-command" [] @@ -12,8 +19,8 @@ (Command.define-command "multiply" - [[:a #{$1 $1} #"3"] - [:b #{$1 $1} #"2"]] + [[:a #[(Command.completion {:text $1})] #"3"] + [:b #[(Command.completion {:text $1})] #"2"]] (fn [{: a : b }] (set happened (* (tonumber a) (tonumber b))))) (before)