Compare commits

...

4 Commits

Author SHA1 Message Date
Daniel Barlow 2ceb5ad757 trim outdated stuff 2023-01-15 16:57:25 +00:00
Daniel Barlow 34fb1b2ff4 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
2023-01-15 16:55:22 +00:00
Daniel Barlow 4d3a2bf237 complete command names
we really need to make TAB and Return work for keyboard-selecting
a proffered completion
2023-01-03 23:36:58 +00:00
Daniel Barlow c2c89b6dfd fix buggy call to instr 2023-01-03 21:18:29 +00:00
6 changed files with 98 additions and 66 deletions

View File

@ -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)))

View File

@ -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,16 +43,28 @@
(define-command
"visit-location"
[[:buffer
Buffer.match
#(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
#$1.buffer.name]
[:url #{$1 $1} #($1.buffer:location)]
[: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}]
(buffer:visit url)))
(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]
@ -94,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}
@ -127,22 +149,27 @@
(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)
)))
(let [parent self.completions-widget
set-completions
(fn [completions]
(parent:foreach #(parent:remove $1))
(each [_ c (pairs completions)]
(parent:add
(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}
(let [{ : completer} (. c.params param-name)]
(set-completions (completer str)))
{:command nil}
(set-completions
(collect [k _ (pairs commands)]
(if (= (k:find str 1 true) 1) (values k k)))))))
(fn activate [{: state : entry : prompt &as self}]
(tset state :active true)
@ -216,4 +243,5 @@
{
:commander new-commander
: define-command
: completion
}

View File

@ -37,9 +37,15 @@
(s:reset)))
(fn find [self term]
(let [s (self.db:prepare "select v.url,pt.title,v.timestamp from visits v left join page_titles pt on v.url = pt.url where instr(v.url, ?) is not null")]
(let [s (self.db:prepare "select v.url,pt.title,v.timestamp from visits v left join page_titles pt on v.url = pt.url where instr(v.url, ?) >0")]
(assert (= 0 (s:bind_values term)))
(icollect [r (s:nrows)] r)))
(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))]
@ -49,6 +55,7 @@
: visit
: title
: find
: find-distinct
}))
{

View File

@ -40,29 +40,10 @@ a consideration we haven't touched on yet: in emacs, not all buffers
are files - e.g. the buffer list, or the process list, or the magit
status buffer - there is a well-used affordance for elisp to put
semi-persistent interactable content onscreen - do we need such a
thing here or is it ok to say "just call gtk" to command authors
thing here or is it ok to say "just call gtk" to command authors?
----
when input widget is active for a parameter, show the completions
flowbox
while typing, use the typed input to get a completions list. each
completion is an acceptable value: convert to a gtk widget by calling
(to-label value) and add to flowbox.
if the value is a table
if :to-label key present, use it as-is
else Gtk.Label { :label value.value }
else (assume it's a string)
Gtk.Label { :label value }
on RET, check there is a completion value whose stringification
matches the input string. Hide the flowbox
to activate a rendered completion, the callback needs to perform the
same action as RET would on the chosen value
is there a role for TAB?
@ -81,26 +62,22 @@ focus from entry to step through the completions then RET activates
* [done] visit-location url defaults to current
* [done] ESC to cancel interactive command
* [done] C-g to cancel key sequence
* [done] display unbound key error
* [done] back binding
* [done] save url history, use it in completions
* custom rendering for completions (e.g. buffer thumbnails)
* less ugly default completions rendering
* buffer name is often going to be useless. find buffers by url/title
still need some 1:1 mapping between the buffer object and
a text-representable form of same
* click in commander widget activates visit-location
* bind event to echo-area click, ideally dependent on what's being shown
in there
* in general, can we bind commands to widget events?
* display unbound key error
* autocomplete command name
* command to create new buffer
* keyboard navigation of completions
* suppress "Return is undefined" message after a command executes
----
I think we're misusing the commander to show url and error messages
and key prompts. It's OK to have that part of the screen be multipurpose
but philosophically those things are not related to the command system.
- hide commander when inactive and replace it with echo area
- move it to bottom?
commander can't hide itself, it needs to ask its parent to hide it

View File

@ -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)

View File

@ -11,15 +11,28 @@
(let [h (history.open)]
(h:visit "http://example.com" (fake-time))
(let [actual (h:find "example.com")]
(match actual
(where [{:url "http://example.com" :timestamp t}] (> t 0)) true
?fail (assert false (view ?fail)))))
(assert
(accumulate [found false
r (h:find "example.com")]
(or
found
(match r
{:url "http://example.com" :timestamp t} true)))))
(let [h (history.open)]
(h:visit "http://example.com" (fake-time))
(h:title "http://example.com" "Page title")
(let [actual (h:find "example.com")]
(match actual
(where [{:url "http://example.com" :title "Page title" :timestamp t}] (> t 0)) true
?fail (assert false (view ?fail)))))
(assert
(accumulate [found false
r (h:find "example.com")]
(or
found
(match r
{:url "http://example.com" :title "Page title" :timestamp t} true)))))
(let [h (history.open "/tmp/foo.db")]
(h:visit "http://example.com" (fake-time))
(h:visit "http://notsample.com" (+ 1 (fake-time)))
(each [r (h:find "example.com")]
(match r
{:url "http://notsample.com" } (assert false "unexpected row"))))