1 ! Copyright (C) 2021 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays debugger fonts gemini kernel
5 math.vectors models present sequences splitting ui ui.commands
6 ui.gadgets ui.gadgets.editors ui.gadgets.panes
7 ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.toolbar
8 ui.gadgets.tracks ui.gadgets.viewports ui.gestures ui.operations
9 ui.tools.browser ui.tools.browser.history ui.tools.common urls
14 TUPLE: gemini-gadget < tool history scroller url-field ;
16 gemini-gadget default-font-size { 50 50 } n*v set-tool-dim
18 M: gemini-gadget history-value
19 [ control-value ] [ scroller>> scroll-position ]
22 M: gemini-gadget set-history-value
24 [ set-control-value ] [ scroller>> set-scroll-position ]
27 M: gemini-gadget model-changed
29 [ url-field>> editor>> set-editor-string ] bi* ;
31 : ?gemini-url ( obj -- url )
32 present dup "://" subseq-index? [ "gemini://" prepend ] unless >url ;
34 : show-gemini ( url gemini-gadget -- )
35 [ [ ?gemini-url ] [ f ] if* ] dip
36 over [ protocol>> "gemini" = ] [ t ] if* [
39 [ 2drop ] [ nip history>> add-history ] if
43 ] [ drop open-url ] if ;
45 : <url-field> ( gemini-gadget -- field )
46 '[ _ show-gemini ] <action-field>
47 "Gemini URL" >>default-text
50 : <gemini-pane> ( gemini-gadget -- gadget )
51 model>> [ '[ _ [ gemini. ] when* ] try ] <pane-control> ;
53 : <gemini-toolbar> ( browser -- toolbar )
58 over <toolbar> f track-add
59 swap url-field>> 1 track-add ;
61 : add-gemini-toolbar ( track -- track )
62 dup <gemini-toolbar> format-toolbar f track-add ;
64 : add-gemini-pane ( track -- track )
65 dup dup <gemini-pane> margins
66 <scroller> >>scroller scroller>> white-interior 1 track-add ;
68 : <gemini-gadget> ( -- gadget )
69 vertical gemini-gadget new-track with-lines
71 dup <history> >>history
72 dup <url-field> >>url-field
76 : open-gemini-window ( url -- )
78 [ "gemini" open-status-window ]
81 : com-clear ( gemini -- )
82 f swap set-control-value ;
84 : com-up ( gemini -- )
88 [ dup "/" tail? "./../" "./" ? url-append-path ] change-path
93 : com-gemini ( url -- )
94 [ gemini-gadget? ] find-window
95 [ [ raise-window ] [ gadget-child show-gemini ] bi ]
96 [ open-gemini-window ] if* ;
98 gemini-gadget "toolbar" f {
105 gemini-gadget "scrolling" f {
106 { T{ key-down f f "UP" } com-scroll-up }
107 { T{ key-down f f "DOWN" } com-scroll-down }
108 { T{ key-down f f "PAGE_UP" } com-page-up }
109 { T{ key-down f f "PAGE_DOWN" } com-page-down }
112 [ dup url? [ protocol>> "gemini" = ] [ drop f ] if ] \ com-gemini H{ { +primary+ t } } define-operation