From 7741d2ca2329c3db8888ca726802110efe1bdf79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 24 Mar 2009 09:11:45 -0500 Subject: [PATCH 1/8] - definitions.icons now has a reference article - move about to help.vocabs; it now opens the vocab browser instead - help.vocabs is in default use list - add runnable-vocab predicate class --- basis/definitions/icons/icons-docs.factor | 12 +++++++ basis/definitions/icons/icons.factor | 38 ++++++++++++++--------- basis/help/crossref/crossref-docs.factor | 5 +-- basis/help/help-docs.factor | 11 ------- basis/help/help.factor | 9 ------ basis/help/home/home-docs.factor | 12 ++++--- basis/help/home/home.factor | 2 +- basis/help/markup/markup.factor | 3 ++ basis/help/tips/tips-docs.factor | 5 ++- basis/help/vocabs/vocabs-docs.factor | 23 +++++++++++++- basis/help/vocabs/vocabs.factor | 3 ++ basis/ui/tools/browser/browser.factor | 6 ++-- basis/ui/tools/tools-docs.factor | 4 +++ core/parser/parser.factor | 1 + core/vocabs/loader/loader-docs.factor | 1 + core/vocabs/vocabs-docs.factor | 3 ++ core/vocabs/vocabs.factor | 5 ++- 17 files changed, 94 insertions(+), 49 deletions(-) create mode 100644 basis/definitions/icons/icons-docs.factor diff --git a/basis/definitions/icons/icons-docs.factor b/basis/definitions/icons/icons-docs.factor new file mode 100644 index 0000000000..8bca46bc3a --- /dev/null +++ b/basis/definitions/icons/icons-docs.factor @@ -0,0 +1,12 @@ +IN: definitions.icons +USING: help.markup help.syntax ; + +ARTICLE: "definitions.icons" "Definition icons" +"The " { $vocab-link "definitions.icons" } " vocabulary associates common definition types with icons." +{ $definition-icons } +"Looking up the icon associated with a definition:" +{ $subsection definition-icon } +"Defining new icons:" +{ $subsection POSTPONE: ICON: } ; + +ABOUT: "definitions.icons" \ No newline at end of file diff --git a/basis/definitions/icons/icons.factor b/basis/definitions/icons/icons.factor index 7c5fbed9f4..7562658ea4 100644 --- a/basis/definitions/icons/icons.factor +++ b/basis/definitions/icons/icons.factor @@ -2,22 +2,29 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs classes.predicate fry generic io.pathnames kernel macros sequences vocabs words words.symbol words.constant -lexer parser help.topics ; +lexer parser help.topics help.markup namespaces sorting ; IN: definitions.icons GENERIC: definition-icon ( definition -- path ) -> @@ -29,12 +36,15 @@ ICON: primitive primitive-word ICON: symbol symbol-word ICON: constant constant-word ICON: word normal-word -ICON: vocab-link unopen-vocab ICON: word-link word-help-article ICON: link help-article +ICON: runnable-vocab runnable-vocab +ICON: vocab open-vocab +ICON: vocab-link unopen-vocab -PRIVATE> - -M: vocab definition-icon - vocab-main "runnable-vocab" "open-vocab" ? definition-icon-path ; - \ No newline at end of file +: $definition-icons ( element -- ) + drop + icons get >alist sort-keys + [ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map + { "" "Definition class" } prefix + $table ; \ No newline at end of file diff --git a/basis/help/crossref/crossref-docs.factor b/basis/help/crossref/crossref-docs.factor index 6ec35b23ce..ae227fde89 100644 --- a/basis/help/crossref/crossref-docs.factor +++ b/basis/help/crossref/crossref-docs.factor @@ -11,10 +11,7 @@ HELP: article-parent HELP: help-path { $values { "topic" "an article name or a word" } { "seq" "a new sequence" } } -{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection, traversing all the way up to the root." } -{ $examples - { $example "USING: help.crossref prettyprint ;" "\"sequences\" help-path ." "{ \"collections\" \"handbook-language-reference\" \"handbook\" }" } -} ; +{ $description "Outputs a sequence of all help articles which contain " { $snippet "topic" } " as a subsection, traversing all the way up to the root." } ; HELP: xref-article { $values { "topic" "an article name or a word" } } diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor index 547ee871aa..be521eb93a 100644 --- a/basis/help/help-docs.factor +++ b/basis/help/help-docs.factor @@ -69,12 +69,6 @@ ARTICLE: "element-types" "Element types" IN: help.markup ABOUT: "element-types" -ARTICLE: "browsing-help" "Browsing documentation" -"The easiest way to browse the help is from the help browser tool in the UI, however you can also display help topics in the listener. Help topics are identified by article name strings, or words. You can request a specific help topic:" -{ $subsection help } -"You can also display the main help article for a vocabulary:" -{ $subsection about } ; - ARTICLE: "writing-help" "Writing documentation" "By convention, documentation is written in files whose names end with " { $snippet "-docs.factor" } ". Vocabulary documentation should be placed in the same directory as the vocabulary source code; see " { $link "vocabs.loader" } "." $nl @@ -148,11 +142,6 @@ HELP: help { $description "Displays a help topic." } ; -HELP: about -{ $values { "vocab" "a vocabulary specifier" } } -{ $description - "Displays the main help article for the vocabulary. The main help article is set with the " { $link POSTPONE: ABOUT: } " parsing word." -} ; HELP: :help { $description "Displays documentation for the most recent error." } ; diff --git a/basis/help/help.factor b/basis/help/help.factor index 6fa4473d97..d20e06b6c6 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -127,15 +127,6 @@ help-hook [ [ print-topic ] ] initialize : help ( topic -- ) help-hook get call( topic -- ) ; -: about ( vocab -- ) - dup require - dup vocab [ ] [ no-vocab ] ?if - dup vocab-help [ help ] [ - "The " write vocab-name write - " vocabulary does not define a main help article." print - "To define one, refer to \\ ABOUT: help" print - ] ?if ; - : ($index) ( articles -- ) sort-articles [ \ $subsection swap 2array ] map print-element ; diff --git a/basis/help/home/home-docs.factor b/basis/help/home/home-docs.factor index d4d8a6206d..6608a6e9c0 100644 --- a/basis/help/home/home-docs.factor +++ b/basis/help/home/home-docs.factor @@ -2,18 +2,22 @@ IN: help.home USING: help.markup help.syntax ; ARTICLE: "help.home" "Factor documentation" -{ $heading "Starting points" } +"If this is your first time with Factor, you can start by writing " { $link "first-program" } "." +{ $heading "Reference" } { $list - { $link "ui-listener" } { $link "handbook" } { $link "vocab-index" } + { $link "ui-tools" } + { $link "handbook-library-reference" } } { $heading "Recently visited" } { $table { "Words" "Articles" "Vocabs" } { { $recent recent-words } { $recent recent-articles } { $recent recent-vocabs } } -} print-element +} +"The browser, completion popups and other tools use a common set of " { $link "definitions.icons" } "." { $heading "Recent searches" } -{ $recent-searches } ; +{ $recent-searches } +"Use the search field in the top-right of the " { $link "ui-browser" } " window to search for words, vocabularies and help articles." ; ABOUT: "help.home" \ No newline at end of file diff --git a/basis/help/home/home.factor b/basis/help/home/home.factor index b1b938cb45..f32c0db30d 100644 --- a/basis/help/home/home.factor +++ b/basis/help/home/home.factor @@ -24,7 +24,7 @@ M: object add-recent-where f ; first get [ nl ] [ 1array $pretty-link ] interleave ; : $recent-searches ( element -- ) - drop recent-searches get [ nl ] [ ($link) ] interleave ; + drop recent-searches get [ <$link> ] map $list ; : redisplay-recent-page ( -- ) "help.home" >link dup associate diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index a80d386638..8b5edf38c1 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -140,6 +140,9 @@ ALIAS: $slot $snippet : $image ( element -- ) [ [ "" ] dip first image associate format ] ($span) ; +: <$image> ( path -- element ) + 1array \ $image prefix ; + ! Some links : write-link ( string object -- ) link-style get [ write-object ] with-style ; diff --git a/basis/help/tips/tips-docs.factor b/basis/help/tips/tips-docs.factor index 7148b25a37..8d732c5568 100644 --- a/basis/help/tips/tips-docs.factor +++ b/basis/help/tips/tips-docs.factor @@ -1,5 +1,6 @@ IN: help.tips -USING: help.markup help.syntax debugger ; +USING: help.markup help.syntax debugger prettyprint see help help.vocabs +help.apropos tools.time stack-checker editors ; TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ; @@ -15,6 +16,8 @@ TIP: "You can write documentation for your own code using the " { $link "help" } TIP: "You can write graphical applications using the " { $link "ui" } "." ; +TIP: "Power tools: " { $links see edit help about apropos time infer. } ; + ARTICLE: "all-tips-of-the-day" "All tips of the day" { $tips-of-the-day } ; diff --git a/basis/help/vocabs/vocabs-docs.factor b/basis/help/vocabs/vocabs-docs.factor index 5f1a97205e..cbedce2f52 100644 --- a/basis/help/vocabs/vocabs-docs.factor +++ b/basis/help/vocabs/vocabs-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax io strings ; +USING: help help.topics help.markup help.syntax io strings ; IN: help.vocabs ARTICLE: "vocab-tags" "Vocabulary tags" @@ -15,3 +15,24 @@ ARTICLE: "vocab-index" "Vocabulary index" HELP: words. { $values { "vocab" "a vocabulary name" } } { $description "Printings a listing of all the words in a vocabulary, categorized by type." } ; + +HELP: about +{ $values { "vocab" "a vocabulary specifier" } } +{ $description + "Displays the main help article for the vocabulary. The main help article is set with the " { $link POSTPONE: ABOUT: } " parsing word." +} ; + +ARTICLE: "browsing-help" "Browsing documentation" +"Help topics are instances of a mixin:" +{ $subsection topic } +"Most commonly, topics are article name strings, or words. You can display a specific help topic:" +{ $subsection help } +"You can also display the help for a vocabulary:" +{ $subsection about } +"To list a vocabulary's words only:" +{ $subsection words. } +{ $examples + { $code "\"evaluator\" help" } + { $code "\\ + help" } + { $code "\"io.files\" about" } +} ; \ No newline at end of file diff --git a/basis/help/vocabs/vocabs.factor b/basis/help/vocabs/vocabs.factor index 13bb0cdf3e..a8c93feee4 100644 --- a/basis/help/vocabs/vocabs.factor +++ b/basis/help/vocabs/vocabs.factor @@ -9,6 +9,9 @@ make namespaces prettyprint sequences sets sorting summary tools.vocabs vocabs vocabs.loader words words.symbol definitions.icons ; IN: help.vocabs +: about ( vocab -- ) + [ require ] [ vocab help ] bi ; + : $pretty-link ( element -- ) [ first definition-icon 1array $image " " print-element ] [ $definition-link ] diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index e1dcba9910..553ba0f6b9 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -78,7 +78,7 @@ M: browser-gadget focusable-child* search-field>> ; "Browser" open-status-window ; : browser-window ( -- ) - "handbook" (browser-window) ; + "help.home" (browser-window) ; \ browser-window H{ { +nullary+ t } } define-command @@ -97,7 +97,7 @@ M: browser-gadget focusable-child* search-field>> ; : com-forward ( browser -- ) model>> go-forward ; -: com-documentation ( browser -- ) "help.home" swap show-help ; +: com-home ( browser -- ) "help.home" swap show-help ; : browser-help ( -- ) "ui-browser" com-browse ; @@ -106,7 +106,7 @@ M: browser-gadget focusable-child* search-field>> ; browser-gadget "toolbar" f { { T{ key-down f { A+ } "LEFT" } com-back } { T{ key-down f { A+ } "RIGHT" } com-forward } - { f com-documentation } + { T{ key-down f { A+ } "H" } com-home } { T{ key-down f f "F1" } browser-help } } define-command-map diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor index c591775429..93f45591a5 100644 --- a/basis/ui/tools/tools-docs.factor +++ b/basis/ui/tools/tools-docs.factor @@ -57,8 +57,12 @@ ARTICLE: "ui-tools" "UI developer tools" "The " { $vocab-link "ui.tools" } " vocabulary hierarchy implements a collection of simple developer tools." $nl "To take full advantage of the UI tools, you should be using a supported text editor. See " { $link "editor" } "." +$nl +"Common functionality:" { $subsection "ui-shortcuts" } { $subsection "ui-presentations" } +{ $subsection "definitions.icons" } +"Tools:" { $subsection "ui-listener" } { $subsection "ui-browser" } { $subsection "ui-inspector" } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index b71f6ed3be..6d613a8b24 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -168,6 +168,7 @@ SYMBOL: interactive-vocabs "help" "help.apropos" "help.lint" + "help.vocabs" "inspector" "io" "io.files" diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index 527da053fb..e0d6fd4493 100644 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -56,6 +56,7 @@ $nl "Application vocabularies can define a main entry point, giving the user a convenient way to run the application:" { $subsection POSTPONE: MAIN: } { $subsection run } +{ $subsection runnable-vocab } { $see-also "vocabularies" "parser-files" "source-files" } ; ABOUT: "vocabs.loader" diff --git a/core/vocabs/vocabs-docs.factor b/core/vocabs/vocabs-docs.factor index 2929b50081..2c87d9736a 100644 --- a/core/vocabs/vocabs-docs.factor +++ b/core/vocabs/vocabs-docs.factor @@ -96,3 +96,6 @@ $nl HELP: >vocab-link { $values { "name" string } { "vocab" "a vocabulary specifier" } } { $description "If the vocabulary is loaded, outputs the corresponding " { $link vocab } " instance, otherwise creates a new " { $link vocab-link } "." } ; + +HELP: runnable-vocab +{ $class-description "The class of vocabularies with a " { $slot "main" } " word." } ; \ No newline at end of file diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index b9f38dfef3..edac418285 100644 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -105,4 +105,7 @@ M: vocab-spec forget* forget-vocab ; SYMBOL: load-vocab-hook ! ( name -- vocab ) -: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ; \ No newline at end of file +: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ; + +PREDICATE: runnable-vocab < vocab + vocab-main >boolean ; \ No newline at end of file From 9b8dd01c0ba14ceba939042365eea09822aeecfe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Mar 2009 10:11:58 -0500 Subject: [PATCH 2/8] Fix bitrot in compiler.tree.debugger --- basis/compiler/tree/debugger/debugger-tests.factor | 5 ++++- basis/compiler/tree/debugger/debugger.factor | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/compiler/tree/debugger/debugger-tests.factor b/basis/compiler/tree/debugger/debugger-tests.factor index eb0bbd5ce6..4d1c5c824d 100644 --- a/basis/compiler/tree/debugger/debugger-tests.factor +++ b/basis/compiler/tree/debugger/debugger-tests.factor @@ -1,5 +1,8 @@ IN: compiler.tree.debugger.tests -USING: compiler.tree.debugger tools.test ; +USING: compiler.tree.debugger tools.test sorting sequences io ; \ optimized. must-infer \ optimizer-report. must-infer + +[ [ <=> ] sort ] optimized. +[ [ print ] each ] optimizer-report. \ No newline at end of file diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index 188dcdb935..430424291e 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -160,7 +160,7 @@ SYMBOL: node-count { [ dup generic? ] [ generics-called ] } { [ dup method-body? ] [ methods-called ] } [ words-called ] - } cond inc-at + } cond get inc-at ] [ drop ] if ] each-node node-count set From be9d8ffd0220624ac03ad1627c0c33ae4f968c77 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Mar 2009 10:12:10 -0500 Subject: [PATCH 3/8] A+b now focuses the search field --- basis/ui/tools/browser/browser.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 553ba0f6b9..e242b743f8 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -89,7 +89,7 @@ M: browser-gadget focusable-child* search-field>> ; : show-browser ( -- ) [ browser-gadget? ] find-window - [ raise-window ] [ browser-window ] if* ; + [ [ raise-window ] [ request-focus ] bi ] [ browser-window ] if* ; \ show-browser H{ { +nullary+ t } } define-command From 80860f62b22d9354da864c5c86e7252fd95bdefd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 25 Mar 2009 10:19:27 -0500 Subject: [PATCH 4/8] remove dead freetype code from Makefile --- Makefile | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index 5461ea5de9..234b8a2c88 100644 --- a/Makefile +++ b/Makefile @@ -98,17 +98,13 @@ netbsd-x86-32: netbsd-x86-64: $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.netbsd.x86.64 -macosx-freetype: - ln -sf libfreetype.6.dylib \ - Factor.app/Contents/Frameworks/libfreetype.dylib - -macosx-ppc: macosx-freetype +macosx-ppc: $(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.ppc -macosx-x86-32: macosx-freetype +macosx-x86-32: $(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86.32 -macosx-x86-64: macosx-freetype +macosx-x86-64: $(MAKE) $(EXECUTABLE) macosx.app CONFIG=vm/Config.macosx.x86.64 linux-x86-32: From 28b10a709464eb5c3f0183ff29c166904c4a322e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 25 Mar 2009 10:19:52 -0500 Subject: [PATCH 5/8] remove loading freetype library on CE --- basis/windows/ce/ce.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/basis/windows/ce/ce.factor b/basis/windows/ce/ce.factor index 948612b2b2..18c48a0139 100644 --- a/basis/windows/ce/ce.factor +++ b/basis/windows/ce/ce.factor @@ -10,6 +10,5 @@ USING: alien sequences ; { "libm" "\\windows\\coredll.dll" "stdcall" } ! { "gl" "libGLES_CM.dll" "stdcall" } ! { "glu" "libGLES_CM.dll" "stdcall" } - ! { "freetype" "libfreetype-6.dll" "stdcall" } { "ole32" "ole32.dll" "stdcall" } } [ first3 add-library ] each From 70bc39b3fd1495748e9bb54dfa7078858539a9c6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Mar 2009 11:10:25 -0500 Subject: [PATCH 6/8] Fix hello-unicode for deployment --- extra/hello-unicode/deploy.factor | 15 +++++++++++++++ extra/hello-unicode/hello-unicode.factor | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 extra/hello-unicode/deploy.factor diff --git a/extra/hello-unicode/deploy.factor b/extra/hello-unicode/deploy.factor new file mode 100644 index 0000000000..f2f1c9fb18 --- /dev/null +++ b/extra/hello-unicode/deploy.factor @@ -0,0 +1,15 @@ +USING: tools.deploy.config ; +H{ + { deploy-word-defs? f } + { deploy-reflection 1 } + { deploy-word-props? f } + { deploy-compiler? t } + { deploy-threads? t } + { deploy-unicode? f } + { "stop-after-last-window?" t } + { deploy-name "hello-unicode" } + { deploy-math? t } + { deploy-ui? t } + { deploy-io 2 } + { deploy-c-types? f } +} diff --git a/extra/hello-unicode/hello-unicode.factor b/extra/hello-unicode/hello-unicode.factor index ef492958e7..4374db2003 100644 --- a/extra/hello-unicode/hello-unicode.factor +++ b/extra/hello-unicode/hello-unicode.factor @@ -15,6 +15,6 @@ IN: hello-unicode ] with-style ] make-pane { 10 10 } ; -: hello-unicode ( -- ) "გამარჯობა" open-window ; +: hello-unicode ( -- ) [ "გამარჯობა" open-window ] with-ui ; MAIN: hello-unicode \ No newline at end of file From c36ae80c2824d3387101717cf4c0ba5736eb36c1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Mar 2009 11:12:10 -0500 Subject: [PATCH 7/8] Better error message if user forgets with-ui --- basis/ui/gadgets/gadgets.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index e38f56c7f1..a4bedf1ef7 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -135,7 +135,9 @@ SYMBOL: ui-notify-flag : forget-pref-dim ( gadget -- ) f >>pref-dim drop ; -: layout-queue ( -- queue ) \ layout-queue get ; +: ui-state ( symbol -- value ) get [ "UI not running" throw ] unless* ; + +: layout-queue ( -- queue ) \ layout-queue ui-state ; : layout-later ( gadget -- ) #! When unit testing gadgets without the UI running, the @@ -214,7 +216,7 @@ M: gadget ungraft* drop ; > graft-queue delete-node ] From f41ee97addfa4341df3df40fdfc12a1dd70b8f62 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 25 Mar 2009 11:20:21 -0500 Subject: [PATCH 8/8] add sms, twitter fields to account. create sitewatcher account when user registers --- extra/site-watcher/db/db.factor | 9 ++++++--- extra/site-watcher/site-watcher-tests.factor | 4 ++-- extra/webapps/site-watcher/site-watcher.factor | 10 ++++++++-- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/extra/site-watcher/db/db.factor b/extra/site-watcher/db/db.factor index a1a85f825f..148e5b96f9 100644 --- a/extra/site-watcher/db/db.factor +++ b/extra/site-watcher/db/db.factor @@ -5,15 +5,18 @@ io.directories io.files.temp kernel io.streams.string calendar debugger combinators.smart sequences ; IN: site-watcher.db -TUPLE: account account-id account-name email ; +TUPLE: account account-id account-name email twitter sms ; -: ( account-name -- account ) +: ( account-name email -- account ) account new + swap >>email swap >>account-name ; account "ACCOUNT" { { "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ } { "email" "EMAIL" VARCHAR } + { "twitter" "TWITTER" VARCHAR } + { "sms" "SMS" VARCHAR } } define-persistent TUPLE: site site-id url up? changed? last-up error last-error ; @@ -72,7 +75,7 @@ TUPLE: reporting-site email url up? changed? last-up? error last-error ; : insert-site ( url -- site ) dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ; -: insert-account ( account-name -- ) insert-tuple ; +: insert-account ( account-name email -- ) insert-tuple ; : find-sites ( -- seq ) f select-tuples ; diff --git a/extra/site-watcher/site-watcher-tests.factor b/extra/site-watcher/site-watcher-tests.factor index 62233587d9..b067504e2e 100644 --- a/extra/site-watcher/site-watcher-tests.factor +++ b/extra/site-watcher/site-watcher-tests.factor @@ -14,7 +14,7 @@ IN: site-watcher.tests site ensure-table watching-site ensure-table - "erg@factorcode.org" insert-account + "erg" "erg@factorcode.org" insert-account "http://asdfasdfasdfasdfqwerqqq.com" insert-site drop "http://fark.com" insert-site drop @@ -22,4 +22,4 @@ IN: site-watcher.tests f select-tuples ] with-db ; -[ f ] [ fake-sites empty? ] unit-test \ No newline at end of file +[ f ] [ fake-sites empty? ] unit-test diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor index e220cff1d4..f173edb814 100644 --- a/extra/webapps/site-watcher/site-watcher.factor +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -71,7 +71,7 @@ CONSTANT: site-list-url URL" $site-watcher-app/" : ( -- action ) [ - username select-tuple from-object + username f select-tuple from-object ] >>init { site-watcher-app "update-notify" } >>template [ @@ -82,8 +82,10 @@ CONSTANT: site-list-url URL" $site-watcher-app/" } validate-params ] >>validate [ - username select-tuple + username f select-tuple "email" value >>email + "twitter" value >>twitter + "sms" value >>sms update-tuple site-list-url ] >>submit @@ -122,6 +124,10 @@ CONSTANT: site-list-url URL" $site-watcher-app/" site-watcher-db main-responder set-global +M: site-watcher-app init-user-profile + drop + "username" value "email" value insert-tuple ; + : init-db ( -- ) site-watcher-db [ { site account watching-site } [ ensure-table ] each