]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/gopher/ui/ui.factor
core: subseq-index? -> subseq-of?
[factor.git] / extra / gopher / ui / ui.factor
index 3e33a92853d49111b263d09de18c218d175fc003..be7f9b8d9fd8967241f1451c1a6750cf806a1b55 100644 (file)
@@ -1,12 +1,13 @@
 ! Copyright (C) 2014 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: accessors arrays debugger fonts fry gopher gopher.private
-kernel math.vectors models present sequences ui ui.commands ui.gadgets
-ui.gadgets.editors ui.gadgets.panes ui.gadgets.scrollers
-ui.gadgets.status-bar ui.gadgets.toolbar ui.gadgets.tracks
-ui.gadgets.viewports ui.gestures ui.operations ui.tools.browser
-ui.tools.browser.history ui.tools.common urls webbrowser ;
+USING: accessors arrays debugger fonts gopher gopher.private
+kernel math.vectors models present sequences ui ui.commands
+ui.gadgets ui.gadgets.editors ui.gadgets.panes
+ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.toolbar
+ui.gadgets.tracks ui.gadgets.viewports ui.gestures ui.operations
+ui.tools.browser ui.tools.browser.history ui.tools.common urls
+webbrowser ;
 
 IN: gopher.ui
 
@@ -27,8 +28,11 @@ M: gopher-gadget model-changed
     [ value>> present ]
     [ url-field>> editor>> set-editor-string ] bi* ;
 
+: ?gopher-url ( obj -- url )
+    present dup "://" subseq-of? [ "gopher://" prepend ] unless >url ;
+
 : show-gopher ( url gopher-gadget -- )
-    [ [ >url ] [ f ] if* ] dip
+    [ [ ?gopher-url ] [ f ] if* ] dip
     over [ protocol>> "gopher" = ] [ t ] if* [
         [
             2dup control-value =
@@ -39,7 +43,7 @@ M: gopher-gadget model-changed
     ] [ drop open-url ] if ;
 
 : <url-field> ( gopher-gadget -- field )
-    '[ >url _ show-gopher ] <action-field>
+    '[ _ show-gopher ] <action-field>
         "Gopher URL" >>default-text
         white-interior ;