diff --git a/Makefile b/Makefile index 75a73e5af8..b717a5603b 100644 --- a/Makefile +++ b/Makefile @@ -3,16 +3,16 @@ CC = gcc BINARY = f IMAGE = factor.image BUNDLE = Factor.app -VERSION = 0.86 +VERSION = 0.87 DISK_IMAGE_DIR = Factor-$(VERSION) DISK_IMAGE = Factor-$(VERSION).dmg LIBPATH = -L/usr/X11R6/lib ifdef DEBUG - CFLAGS = -pg -O1 + CFLAGS = -g -std=gnu99 STRIP = touch else - CFLAGS = -Wall -O3 -ffast-math -fomit-frame-pointer $(SITE_CFLAGS) + CFLAGS = -Wall -O3 -ffast-math -std=gnu99 $(SITE_CFLAGS) STRIP = strip endif @@ -40,7 +40,8 @@ OBJS = $(PLAF_OBJS) \ default: @echo "Run 'make' with one of the following parameters:" @echo "" - @echo "freebsd" + @echo "freebsd-x86" + @echo "freebsd-amd64" @echo "linux-x86" @echo "linux-amd64" @echo "linux-ppc" @@ -62,8 +63,11 @@ default: @echo "" @echo "export SITE_CFLAGS=\"-march=pentium4 -ffast-math\"" -freebsd: - $(MAKE) $(BINARY) CONFIG=vm/Config.freebsd +freebsd-x86: + $(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.x86 + +freebsd-amd64: + $(MAKE) $(BINARY) CONFIG=vm/Config.freebsd.amd64 macosx-freetype: ln -sf libfreetype.6.dylib \ @@ -73,10 +77,10 @@ macosx-ppc: macosx-freetype $(MAKE) $(BINARY) CONFIG=vm/Config.macosx.ppc macosx-x86: macosx-freetype - $(MAKE) $(BINARY) CONFIG=vm/Config.macosx + $(MAKE) $(BINARY) CONFIG=vm/Config.macosx.x86 linux-x86: - $(MAKE) $(BINARY) CONFIG=vm/Config.linux + $(MAKE) $(BINARY) CONFIG=vm/Config.linux.x86 $(STRIP) $(BINARY) linux-amd64: @@ -124,6 +128,7 @@ macosx.dmg: -o -name '*.fgen' \ -o -name '*.tex' \ -o -name '*.fhtml' \ + -o -name '*.furnace' \ -o -name '*.xml' \ -o -name '*.js' \) \ -exec ./cp_dir {} $(DISK_IMAGE_DIR)/Factor/{} \; @@ -140,7 +145,6 @@ clean: rm -f vm/*.o clean.app: - rm -rf $(BUNDLE)/Contents/Resources/ rm -f $(BUNDLE)/Contents/MacOS/Factor .c.o: diff --git a/README.txt b/README.txt index 082406f069..1d7e7bac58 100644 --- a/README.txt +++ b/README.txt @@ -160,16 +160,23 @@ the command prompt: f.exe boot.image.pentium4 (or boot.image.x86) -Once bootstrapped, double-clicking f.exe starts the Factor UI. There is -no option to run the listener in the command prompt on Windows. +Once bootstrapped, double-clicking f.exe starts the Factor UI. + +To run the listener in the command prompt: + + f.exe -shell=tty * Source organization - doc/ - the developer's handbook, and various other bits and pieces - contrib/ - various handy libraries not part of the core - examples/ - small examples illustrating various language features +The following four directories are managed by the module system; consult +the documentation for details: + + apps/ - user-contributed applications + libs/ - user-contributed libraries + demos/ - small examples illustrating various language features + core/ - sources for the library, written in Factor + fonts/ - TrueType fonts used by UI - library/ - sources for the library, written in Factor vm/ - sources for the Factor runtime, written in C * Community @@ -190,10 +197,6 @@ Doug Coleman: Mersenne Twister RNG, Windows port Eduardo Cavazos: X11 binding Joshua Grams: PowerPC instruction cache flush code Mackenzie Straight: Windows port -Trent Buck: Debian package - -A number of contributed libraries not part of the core can be found in -contrib/. See contrib/README.txt for details. Have fun! diff --git a/TODO.FACTOR.txt b/TODO.txt similarity index 55% rename from TODO.FACTOR.txt rename to TODO.txt index 203dd0616c..239638743d 100644 --- a/TODO.FACTOR.txt +++ b/TODO.txt @@ -1,50 +1,61 @@ + 0.87: -- fix search unit test +- error popup obscures input area +- cocoa: international keys don't work +- embedded.factor is O(n^2) + ++ 0.88: + +- models: don't do redundant work +- test factor on linux/ppc +- poorly documented vocabs: + - alien + - cocoa + - command-line + - compiler + - completion + - image + - interpreter + - objc + - optimizer +- grid-lines are rendered incorrectly +- lisppaste gui +- growable data heap +- variable width word wrap +- graphical crossref tool +- inspector where slot values can be changed +- compiled call traces do not work if the runtime is built with + -fomit-frame-pointer on ppc +- use crc32 instead of modification date in reload-modules +- top level window positioning on ms windows - these things are "Too Slow": - - all-words - make-image - workspace-window -- menu should stay up if mouse button released -- roundoff is still not quite right with tracks -- grid displays quickly now, but constructing large amounts of gadgets - is slow: eg, 10000 [ dup number>string ] map describe -- completion is not ideal: eg, C+e "buttons" -- slider needs to be modelized -- better help result ranking -- help search looks funny -- variable width word wrap -- graphical module manager tool -- graphical crossref tool -- ui browser: show currently selected vocab & words + - apropos + - 10000 [ dup number>string ] map describe in the UI + - available-modules + - string-lines + - md5, crc32 + - all-words [ word-name ] map prune [ words-named ] map + - 100000 [ "\"hello\" not" eval drop ] times - auto-update browser and help when sources reload -- amd64 structs-by-value bug -- intrinsic fixnum>float float>fixnum - mac intel: struct returns from objc methods -- faster apropos -- compiled call traces -- workspace window takes too long to come up - new windows don't always have focus, eg focus follows mouse -- dataflow for [ ] map [ ] subset looks weird (wrong?) -- listener commands from a menu should not include 'hide-glass' etc -- bogus compile errors? - recompile get/set/>n/n>/ndrop if needed - cross-word type inference -- callback scheduling issue -- windows crash -- ui docs - some kind of declarative wiring framework for ui -- overhaul models, set-model* is crap -- allow rebinding styles -- fix windows gcc issue -- robustify stepper -- see if step back past a throw works -- empty callstack: should throw an exception instead of being a critical error +- if we're printing a block on multiple lines, break at some words like + set off on % # , ... and assembler opcodes +- don't end lines with literals, shuffle words or symbols? +- see should try to not show ; on a line by itself +- IN: on its own line if the entire 'see' form doesn't fit +- command buttons: indicate shortcuts +- how do we refer to command shortcuts in the docs? + ui: -- some way of intercepting all gestures -- how do we refer to command shortcuts in the docs? -- fix top level window positioning +- browser tool: dropdown menu button for definition operations +- copying pane output - editor: - autoscroll - transpose char/word/line @@ -52,54 +63,35 @@ - see if its possible to only repaint dirty regions - structure editor -+ module system: ++ compiler/ffi: -- track a list of assets loaded from each module's file - C types should be words - TYPEDEF: float { ... } { ... } ; ==> \ float T{ c-type ... } "c-type" swp - TYPEDEF: float FTFloat ; ==> \ float \ FTFloat "c-type" swp - make typedef aliasing explicit - seeing a C struct word should show its def -- file out - -+ compiler/ffi: - +- amd64 structs-by-value bug - %allot-bignum-signed-2 is broken on both platforms -- we may be able to remove the dlsym primitive - [ [ dup call ] dup call ] infer hangs - stdcall callbacks - callstack overflow when compiling mutually recursive inline words -- test what is done in the case of an invalid declaration on an inline - recursive -- ppc64 backend - arm backend - float= doesn't consider nans equal - C functions returning structs by value - compiled continuations -+ prettyprinter: - -- clean it up -- if we're printing a block on multiple lines, break at some words like - set off on % # , ... and assembler opcodes -- don't end lines with literals, shuffle words or symbols? -- see should try to not show ; on a line by itself -- IN: on its own line if the entire 'see' form doesn't fit -- don't build entire tree to print first - + misc: +- if a word drops the stack pointer below the bottom, then an error + won't be thrown until the next word accesses the stack +- prettyprinter: don't build entire tree to print first +- automatic help/effects for slot accessors +- tuple shape changes - should be possible to reload any source file in library -- growable data heap - minor GC takes too long now, we should card mark code heap - buffer-ptr should be an alien - swap nappend ==> nappend -- gdb triggers 'multiple i/o ops on port' error - incremental GC - UDP - slice: if sequence or seq start is changed, abstraction violation - hashed generic method dispatch - -+ httpd: - -- remaining HTML issues need fixing diff --git a/apps/README.txt b/apps/README.txt new file mode 100644 index 0000000000..67b44bb6c8 --- /dev/null +++ b/apps/README.txt @@ -0,0 +1,29 @@ +This directory contains Factor code that is not part of the core +library, but is useful enough to ship with the Factor distribution. + +Modules can be loaded from the listener: + + "apps/modulename" require + +Available applications: + +- automata -- Graphics demo for the UI (Eduardo Cavazos) +- benchmarks -- Various performance benchmarks (Slava Pestov) +- boids -- Graphics demo for the UI (Eduardo Cavazos) +- factory -- X11 window manager (Eduardo Cavazos) +- furnace-fjsc -- Web frontend for libs/fjsc (Chris Double) +- furnace-onigiri -- Weblog engine (Matthew Willis) +- furnace-pastebin -- demo app for Furnace (Slava Pestov) +- help-lint -- online documentation typo checker (Slava Pestov) +- hexdump -- Hexdump routine (Doug Coleman) +- lindenmayer -- L-systems tool (Eduardo Cavazos) +- lisppaste -- Lisppaste XML-RPC demo (Slava Pestov) +- mandel -- Mandelbrot fractal demo (Slava Pestov) +- random-tester -- Random compiler tester (Doug Coleman) +- raytracer -- Raytracer demo (Slava Pestov) +- rss -- An RSS1, RSS2 and Atom parser and aggregator (Chris Double, Daniel Ehrenberg) +- show-dataflow -- Code to print compiler dataflow IR to the console, or show it in the UI (Slava Pestov) +- space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double) +- tetris -- Tetris game (Alex Chapman) +- turing -- Turing machine demo (Slava Pestov) +- wee-url -- Web app to make short URLs from long ones (Doug Coleman) diff --git a/apps/all.factor b/apps/all.factor new file mode 100644 index 0000000000..f62691251f --- /dev/null +++ b/apps/all.factor @@ -0,0 +1,14 @@ +USING: words kernel modules ; + +REQUIRES: apps/automata apps/benchmarks apps/boids +apps/factorbot apps/furnace-fjsc apps/furnace-onigiri +apps/furnace-pastebin apps/help-lint apps/hexdump +apps/lindenmayer apps/lisppaste apps/mandel apps/random-tester +apps/raytracer apps/rss apps/space-invaders apps/tetris +apps/turing apps/show-dataflow apps/wee-url ; + +"x11" vocab [ + "apps/factory" require +] when + +PROVIDE: apps/all ; diff --git a/contrib/automata.factor b/apps/automata.factor similarity index 96% rename from contrib/automata.factor rename to apps/automata.factor index f0e63ddf51..390f61d262 100644 --- a/contrib/automata.factor +++ b/apps/automata.factor @@ -1,4 +1,4 @@ -REQUIRES: contrib/vars contrib/slate contrib/lindenmayer/opengl ; +REQUIRES: libs/vars libs/slate apps/lindenmayer/opengl ; USING: kernel namespaces hashtables sequences generic math arrays threads opengl gadgets @@ -153,7 +153,7 @@ init slate> over set-delegate interesting random-item set-rule ; -: automata-window ( -- ) "Automata" open-titled-window ; +: automata-window ( -- ) "Automata" open-window ; automata-gadget H{ { T{ key-down f f "1" } [ slate-ns [ start-center ] bind ] } @@ -167,4 +167,4 @@ automata-gadget H{ ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -PROVIDE: contrib/automata ; \ No newline at end of file +PROVIDE: apps/automata ; \ No newline at end of file diff --git a/contrib/benchmarks/ack.factor b/apps/benchmarks/ack.factor similarity index 100% rename from contrib/benchmarks/ack.factor rename to apps/benchmarks/ack.factor diff --git a/contrib/benchmarks/continuations.factor b/apps/benchmarks/continuations.factor similarity index 100% rename from contrib/benchmarks/continuations.factor rename to apps/benchmarks/continuations.factor diff --git a/contrib/benchmarks/empty-loop.factor b/apps/benchmarks/empty-loop.factor similarity index 100% rename from contrib/benchmarks/empty-loop.factor rename to apps/benchmarks/empty-loop.factor diff --git a/contrib/benchmarks/fac.factor b/apps/benchmarks/fac.factor similarity index 100% rename from contrib/benchmarks/fac.factor rename to apps/benchmarks/fac.factor diff --git a/contrib/benchmarks/fib.factor b/apps/benchmarks/fib.factor similarity index 100% rename from contrib/benchmarks/fib.factor rename to apps/benchmarks/fib.factor diff --git a/contrib/benchmarks/hashtables.factor b/apps/benchmarks/hashtables.factor similarity index 100% rename from contrib/benchmarks/hashtables.factor rename to apps/benchmarks/hashtables.factor diff --git a/contrib/benchmarks/help.factor b/apps/benchmarks/help.factor similarity index 83% rename from contrib/benchmarks/help.factor rename to apps/benchmarks/help.factor index 858b497639..1ed70b85d7 100644 --- a/contrib/benchmarks/help.factor +++ b/apps/benchmarks/help.factor @@ -1,5 +1,5 @@ USING: gadgets-panes hashtables help io kernel namespaces -prettyprint sequences test threads words ; +prettyprint sequences errors threads words test ; [ all-articles [ diff --git a/contrib/benchmarks/iteration.factor b/apps/benchmarks/iteration.factor similarity index 100% rename from contrib/benchmarks/iteration.factor rename to apps/benchmarks/iteration.factor diff --git a/contrib/benchmarks/load.factor b/apps/benchmarks/load.factor similarity index 90% rename from contrib/benchmarks/load.factor rename to apps/benchmarks/load.factor index 52b2e43264..89c62a19c6 100644 --- a/contrib/benchmarks/load.factor +++ b/apps/benchmarks/load.factor @@ -1,4 +1,4 @@ -PROVIDE: contrib/benchmarks +PROVIDE: apps/benchmarks { +tests+ { "empty-loop.factor" "fac.factor" diff --git a/contrib/benchmarks/prettyprint.factor b/apps/benchmarks/prettyprint.factor similarity index 100% rename from contrib/benchmarks/prettyprint.factor rename to apps/benchmarks/prettyprint.factor diff --git a/contrib/benchmarks/reverse-complement-test-in.txt b/apps/benchmarks/reverse-complement-test-in.txt similarity index 100% rename from contrib/benchmarks/reverse-complement-test-in.txt rename to apps/benchmarks/reverse-complement-test-in.txt diff --git a/contrib/benchmarks/reverse-complement-test-out.txt b/apps/benchmarks/reverse-complement-test-out.txt similarity index 100% rename from contrib/benchmarks/reverse-complement-test-out.txt rename to apps/benchmarks/reverse-complement-test-out.txt diff --git a/contrib/benchmarks/reverse-complement.factor b/apps/benchmarks/reverse-complement.factor similarity index 100% rename from contrib/benchmarks/reverse-complement.factor rename to apps/benchmarks/reverse-complement.factor diff --git a/contrib/benchmarks/sort.factor b/apps/benchmarks/sort.factor similarity index 100% rename from contrib/benchmarks/sort.factor rename to apps/benchmarks/sort.factor diff --git a/contrib/benchmarks/strings.factor b/apps/benchmarks/strings.factor similarity index 100% rename from contrib/benchmarks/strings.factor rename to apps/benchmarks/strings.factor diff --git a/contrib/benchmarks/vectors.factor b/apps/benchmarks/vectors.factor similarity index 100% rename from contrib/benchmarks/vectors.factor rename to apps/benchmarks/vectors.factor diff --git a/contrib/boids.factor b/apps/boids.factor similarity index 97% rename from contrib/boids.factor rename to apps/boids.factor index 45b789f3e9..4c4a626033 100644 --- a/contrib/boids.factor +++ b/apps/boids.factor @@ -1,7 +1,7 @@ -REQUIRES: contrib/math - contrib/vars - contrib/lindenmayer/opengl - contrib/slate ; +REQUIRES: libs/math + libs/vars + apps/lindenmayer/opengl + libs/slate ; USING: kernel namespaces math sequences arrays threads opengl gadgets math-contrib vars opengl-contrib slate ; @@ -267,7 +267,7 @@ stop? get [ ] [ run ] if ; >slate namespace slate> set-slate-ns [ display ] >action -slate> "Boids" open-titled-window ; +slate> "Boids" open-window ; : init-boids ( -- ) 50 random-boids >boids ; @@ -275,4 +275,4 @@ slate> "Boids" open-titled-window ; : init ( -- ) init-slate init-variables init-world-size init-boids stop? off ; -PROVIDE: contrib/boids ; \ No newline at end of file +PROVIDE: apps/boids ; \ No newline at end of file diff --git a/examples/factorbot.factor b/apps/factorbot.factor similarity index 86% rename from examples/factorbot.factor rename to apps/factorbot.factor index db4d5ee2f4..f0611ba901 100644 --- a/examples/factorbot.factor +++ b/apps/factorbot.factor @@ -1,6 +1,6 @@ ! Simple IRC bot written in Factor. -REQUIRES: contrib/httpd ; +REQUIRES: libs/httpd ; USING: errors generic hashtables help html http io kernel math memory namespaces parser prettyprint sequences strings threads @@ -76,7 +76,7 @@ M: ping handle-irc ( line -- ) : factorbot-loop [ factorbot ] try 30000 sleep factorbot-loop ; : multiline-respond ( string -- ) - lines [ respond ] each ; + string-lines [ respond ] each ; : object-href "http://factorcode.org" swap browser-link-href append ; @@ -93,24 +93,16 @@ IN: factorbot-commands ] [ nip [ dup summary " -- " - rot object-href append3 respond + rot object-href 3append respond ] each ] if ; : memory ( text -- ) drop [ room. ] string-out multiline-respond ; -: search ( text -- ) - search-help dup empty? [ - not-found - ] [ - first first dup article-title - " -- " rot object-href append3 respond - ] if ; - : quit ( text -- ) drop speaker get "slava" = [ disconnect ] when ; -PROVIDE: examples/factorbot ; +PROVIDE: apps/factorbot ; -MAIN: examples/factorbot factorbot ; +MAIN: apps/factorbot factorbot ; diff --git a/contrib/factory/README.txt b/apps/factory/README.txt similarity index 74% rename from contrib/factory/README.txt rename to apps/factory/README.txt index e06749f361..2a18a5db31 100644 --- a/contrib/factory/README.txt +++ b/apps/factory/README.txt @@ -1,11 +1,3 @@ ----------------------------------------------------------------------- -Loading factory ----------------------------------------------------------------------- - -Putting factory into your image is as simple as this: - - "contrib/factory" require save - ---------------------------------------------------------------------- Running factory in Xnest ---------------------------------------------------------------------- @@ -17,7 +9,7 @@ can use 2 or greater. Start factor and launch factory on the appropriate display: - "contrib/factory" run-module + "libs/factory" run-module In a terminal, start an application on the appropriate display: diff --git a/contrib/factory/factory.factor b/apps/factory/factory.factor similarity index 100% rename from contrib/factory/factory.factor rename to apps/factory/factory.factor diff --git a/apps/factory/load.factor b/apps/factory/load.factor new file mode 100644 index 0000000000..977a1c6683 --- /dev/null +++ b/apps/factory/load.factor @@ -0,0 +1,7 @@ +REQUIRES: libs/process libs/concurrency libs/x11 libs/vars ; + +PROVIDE: apps/factory { +files+ { "factory.factor" } } ; + +USE: factory + +MAIN: apps/factory f start-factory ; diff --git a/apps/furnace-fjsc/furnace-fjsc.factor b/apps/furnace-fjsc/furnace-fjsc.factor new file mode 100644 index 0000000000..fe9f6f6a14 --- /dev/null +++ b/apps/furnace-fjsc/furnace-fjsc.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2006 Chris Double. All Rights Reserved. +! See http://factorcode.org/license.txt for BSD license. +! +IN: furnace:fjsc +USING: kernel html furnace xml xml-writer io httpd sequences + namespaces file-responder parser-combinators lazy-lists + fjsc ; + +: script ( path -- ) + #! given a path to a javascript file, output the + #! script tag that references it. + ; + +: fjsc-page ( scripts title quot -- ) + #! Display a web page importing the given script + #! tags and using the title. The body of the page + #! is generated by calling the quotation. + -rot xhtml-preamble + chars>entities + + + write + [ script ] each + + + call + + ; + +: fjsc-render ( template title -- ) + #! Render the fjsc page importing the required + #! scripts. + serving-html { + "/responder/fjsc-resources/jquery.js" + "/responder/fjsc-resources/bootstrap.js" + } swap [ + [ + f swap render-template + ] fjsc-page + ] with-html-stream ; + +: compile ( code -- ) + #! Compile the facor code as a string, outputting the http + #! response containing the javascript. + serving-text + 'expression' parse car parse-result-parsed fjsc-compile + write flush ; + +! The 'compile' action results in an URL that looks like +! 'responder/fjsc/compile'. It takes one query or post +! parameter called 'code'. It calls the 'compile' word +! passing the parameter to it on the stack. +\ compile { + { "code" v-required } +} define-action + +: repl ( -- ) + #! The main 'repl' page. + f "repl" "Factor to Javascript REPL" fjsc-render ; + +! An action called 'repl' +\ repl { } define-action + +! Create the web app, providing access +! under '/responder/fjsc' which calls the +! 'repl' action. +"fjsc" "repl" "apps/furnace-fjsc" web-app + +! An URL to the javascript resource files used by +! the 'fjsc' responder. +"fjsc-resources" [ + [ + "libs/fjsc/resources/" resource-path "doc-root" set + file-responder + ] with-scope +] add-simple-responder diff --git a/apps/furnace-fjsc/load.factor b/apps/furnace-fjsc/load.factor new file mode 100644 index 0000000000..cc07b5a8b5 --- /dev/null +++ b/apps/furnace-fjsc/load.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2006 Chris Double. All Rights Reserved. +! See http://factorcode.org/license.txt for BSD license. +! +REQUIRES: libs/furnace libs/fjsc ; + +PROVIDE: apps/furnace-fjsc +{ + +files+ { + "furnace-fjsc.factor" + } +} { + +tests+ { + } +} ; diff --git a/apps/furnace-fjsc/repl.furnace b/apps/furnace-fjsc/repl.furnace new file mode 100644 index 0000000000..ac4ca9c316 --- /dev/null +++ b/apps/furnace-fjsc/repl.furnace @@ -0,0 +1,41 @@ + + + + +
+

Enter Factor Code Here

+
+ + +
+

Compiled Code

+ +

Stack

+
+
+

Playground

+
+
+		 +

More information on the Factor to Javascript compiler can be found at these blog posts: +

+

+

Some useful words: +

+
vocabs ( -- seq )
+
Return a sequence of available vocabularies
+
words ( string -- seq )
+
Return a sequence of words in the given vocabulary
+
all-words ( -- seq )
+
Return a sequence of all words
+
+

+

The contents of bootstrap.factor have been loaded on startup.

+
diff --git a/apps/furnace-onigiri/load.factor b/apps/furnace-onigiri/load.factor new file mode 100644 index 0000000000..2a7478ffcc --- /dev/null +++ b/apps/furnace-onigiri/load.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2006 Matthew Willis. All Rights Reserved. +! See http://factorcode.org/license.txt for BSD license. +! +REQUIRES: libs/furnace libs/sqlite libs/calendar libs/crypto libs/farkup +libs/basic-authentication ; + +PROVIDE: apps/furnace-onigiri +{ +files+ { + "onigiri.factor" + "onigiri.facts" +} } ; \ No newline at end of file diff --git a/apps/furnace-onigiri/onigiri.factor b/apps/furnace-onigiri/onigiri.factor new file mode 100644 index 0000000000..e4afd6880c --- /dev/null +++ b/apps/furnace-onigiri/onigiri.factor @@ -0,0 +1,278 @@ +! Copyright (C) 2006 Matthew Willis. All Rights Reserved. +! See http://factorcode.org/license.txt for BSD license. +! +USING: httpd threads kernel namespaces furnace sqlite tuple-db +sequences html strings math hashtables crypto io file-responder calendar +prettyprint parser errors sha2 basic-authentication ; + +IN: furnace:onigiri + +! start should be removed after doublec's responder-url hits the main repos +SYMBOL: responder-url +"/" responder-url set +! end + +TUPLE: entry title stub body created updated ; +entry default-mapping set-mapping + +: any-entry ( -- entry ) + ! useful for tuple-db searching + f f f f f ; + +TUPLE: onigiri-meta value key ; +onigiri-meta default-mapping set-mapping + +TUPLE: user name password level ; +user default-mapping set-mapping + +DEFER: onigiri +: setup-entries ( db-name -- ) + ! create the entries table + sqlite-open dup entry create-tuple-table sqlite-close ; + +: setup-meta ( port db-name -- ) + ! create the onigiri metadata table + ! the port data is necessary, all other data must be entered manually + ! until we get the CRUD interface + sqlite-open [ onigiri-meta create-tuple-table ] keep + swap dupd number>string "port" save-tuple sqlite-close ; + +: setup-users ( db-name -- ) + ! create the users table, adding a default admin user with password admin + sqlite-open dup user create-tuple-table dup + "admin" dup string>sha-256-string over save-tuple sqlite-close ; + +: load-onigiri-meta ( -- ) + "db" \ onigiri get hash + f f find-tuples + [ + dup onigiri-meta-value swap onigiri-meta-key + \ onigiri get set-hash + ] each ; + +: remove-onigiri-meta ( -- ) + ! probably shouldn't use this directly + "db" \ onigiri get hash dup f f find-tuples + [ delete-tuple ] each-with ; + +: save-onigiri-meta ( -- ) + remove-onigiri-meta + "db" \ onigiri get [ hash ] keep hash-keys + [ + dup \ onigiri get hash dup string? + [ swap save-tuple ] + [ 3drop ] if + ] each-with ; + +: title>stub ( title -- stub ) + ! creates a url friendly name based on the title + " " split [ [ alpha? ] subset ] map "" swap remove "-" join ; + +: action>url ( action -- url ) + responder-url get swap append ; + +: stub>url ( stub -- url ) + "entry-show?entry=" swap append action>url ; + +: stub>entry ( stub -- entry ) + [ + "db" \ onigiri get hash swap any-entry [ set-entry-stub ] keep + find-tuples dup empty? [ drop f ] [ first ] if + ] [ f ] if* ; + +: name>user ( name -- user ) + [ + "db" \ onigiri get hash swap f f find-tuples + dup empty? [ drop f ] [ first ] if + ] [ f ] if* ; + +: key>meta ( key -- onigiri-meta ) + [ + "db" \ onigiri get hash f rot find-tuples + dup empty? [ drop f ] [ first ] if + ] [ f ] if* ; + +: compose-entry ( title body-lines -- ) + "\n" join over title>stub swap + millis number>string dup + "db" \ onigiri get hash swap insert-tuple ; + +: millis>timestamp ( millis -- timestamp ) + 1000 /f seconds unix-1970 swap +dt ; + +: atom ( -- ) + "text/xml" serving-content + f "atom" render-template ; + +: css-path ( -- path ) + ! "text/css" serving-content + "css" \ onigiri get hash [ "onigirihouse" ] unless* + "apps/furnace-onigiri/resources/" swap ".css" 3append resource-path ; + +: css ( -- ) + "text/css" serving-content css-path [ + [ + file-vocabs + dup file set ! so that reload works properly + dup contents write + ] with-scope + ] assert-depth drop ; + +TUPLE: onigiri-layout title quot ; +: onigiri-document ( title quot -- ) + "front" render-template ; + +: entry-list ( -- ) + "title" \ onigiri get hash + serving-html [ + [ + "db" \ onigiri get hash any-entry find-tuples + [ [ entry-created string>number ] 2apply <=> neg ] sort + [ "entry" render-template ] each + ] onigiri-document + ] with-html-stream ; + +: entry-show ( stub -- ) + stub>entry + [ + dup "title" \ onigiri get hash + " - " rot entry-title 3append swap + serving-html [ + [ + "entry" render-template + ] curry onigiri-document + ] with-html-stream + ] [ + "title" \ onigiri get hash " - Entry not found" append + serving-html [ + [ f "no-entry" render-template ] onigiri-document + ] with-html-stream + ] if* ; + +: entry-edit ( stub -- ) + [ + any-entry [ set-entry-stub ] keep "db" \ onigiri get hash + swap find-tuples dup length zero? + [ drop any-entry "new entry"] [ first dup entry-title ] if + ] [ any-entry "new entry" ] if* + "title" \ onigiri get hash " - editing " append swap append + serving-html swap [ + [ + "edit" render-template + ] curry onigiri-document + ] with-html-stream ; + +: entry-update ( body title stub -- ) + "onigiri-users" [ + [ + stub>entry [ any-entry ] unless* + ] [ any-entry over title>stub swap [ set-entry-stub ] keep ] if* + [ set-entry-title ] keep + [ CHAR: \r rot remove swap set-entry-body ] keep + millis number>string swap [ set-entry-updated ] 2keep + dup entry-created [ nip ] [ [ set-entry-created ] keep ] if + "db" \ onigiri get hash swap [ save-tuple ] keep + entry-stub "entry-show?entry=" swap append permanent-redirect + ] with-basic-authentication ; + +: entry-delete ( stub -- ) + "onigiri-users" [ + stub>entry [ + "db" \ onigiri get hash swap delete-tuple + ] when* + "entry-list" permanent-redirect + ] with-basic-authentication ; + +: user-list ( -- ) + "onigiri-users" [ + serving-html [ + f "admin-header" render-template + f "user-list" render-template + f "admin-footer" render-template + ] with-html-stream + ] with-basic-authentication ; + +: user-edit ( name -- ) + "onigiri-users" [ + serving-html [ + f "admin-header" render-template + dup [ name>user nip ] when* "user-edit" render-template + f "admin-footer" render-template + ] with-html-stream + ] with-basic-authentication ; + +: user-update ( name password level -- ) + "onigiri-admin" [ + pick name>user + [ + tuck set-user-level swap string>sha-256-string over + set-user-password nip + ] + [ swap string>sha-256-string swap ] if* + "db" \ onigiri get hash swap save-tuple + "user-list" permanent-redirect + ] with-basic-authentication ; + +: user-delete ( name -- ) + "onigiri-admin" [ + name>user [ "db" \ onigiri get hash swap delete-tuple ] when* + "user-list" permanent-redirect + ] with-basic-authentication ; + +: meta-list ( -- ) + "onigiri-users" [ + serving-html [ + f "admin-header" render-template + f "meta-list" render-template + f "admin-footer" render-template + ] with-html-stream + ] with-basic-authentication ; + +: meta-update ( value key -- ) + "onigiri-admin" [ + \ onigiri get set-hash "meta-list" permanent-redirect + ] with-basic-authentication ; + +: register-actions ( -- ) + \ entry-list { } define-action + \ entry-show { { "entry" } } define-action + \ entry-edit { { "entry" } } define-action + \ entry-update { { "body" } { "title" } { "stub" } } define-action + \ entry-delete { { "entry" } } define-action + \ user-list { } define-action + \ user-edit { { "name" } } define-action + \ user-update { { "name" } { "password" } { "level" } } define-action + \ user-delete { { "name" } } define-action + \ meta-list { } define-action + \ meta-update { { "value" } { "key" } } define-action + \ atom { } define-action + \ css { } define-action + "onigiri" "entry-list" "apps/furnace-onigiri/templates/" web-app ; + +: setup-onigiri ( port db-name -- ) + tuck setup-meta dup setup-entries setup-users ; + +: stop-onigiri ( -- ) + ! save metadata, close the db, remove the onigirihouse responder, + ! and if it was the default responder, make "file" the default responder + save-onigiri-meta + "db" \ onigiri get hash sqlite-close + "onigiri" responders get remove-hash + "responder" "default" responders get hash hash + "onigiri" = [ "file" set-default-responder ] when ; + +: onigiri ( db-name -- ) + ! open the db, load metadata from the db, start httpd [optionally, + ! with onigiri as the default responder] + H{ } clone \ onigiri set + sqlite-open "db" \ onigiri get set-hash + load-onigiri-meta register-actions + "onigiri-as-default-responder" \ onigiri get hash "true" = + [ "onigiri" set-default-responder ] when + "port" \ onigiri get hash string>number [ httpd ] in-thread drop + ! add the onigiri users realm + [ f "db" \ onigiri get hash swap find-tuples empty? not ] + "onigiri-users" add-realm + ! add the onigiri admins realm + [ "admin" "db" \ onigiri get hash swap find-tuples empty? not ] + "onigiri-admin" add-realm ; \ No newline at end of file diff --git a/contrib/hardware-info/os-unix.factor b/apps/furnace-onigiri/onigiri.facts similarity index 100% rename from contrib/hardware-info/os-unix.factor rename to apps/furnace-onigiri/onigiri.facts diff --git a/apps/furnace-onigiri/onigiri.todo b/apps/furnace-onigiri/onigiri.todo new file mode 100644 index 0000000000..15ceb7b956 --- /dev/null +++ b/apps/furnace-onigiri/onigiri.todo @@ -0,0 +1,38 @@ +Better xhtml structure +Adsense +*UI for metadata +Plugins +Themes +Recent posts sidebar +Links sidebar +Widgets (Onigirihouse feels ...) +Tagging +Pretty URL's +Develop protocol for metadata and their defaults +Use wiky to do client-side wikistyle +Change furnace to /controller/action/argument1/argument2/.../ style +Have posts correlated with users +Figure out which user is logged in from inside an action + +----DONE----- + +by 12/31/2006 +Atom +Individual post pages +Timestamping and ordering +Rename onigirihouse => onigiri +Store blog metadata in db +Markdown for entries +Make Atom feed validate (Add id, updated to atom) +Store URL +UI for posting +Posting interface +Switch to plug-in CSS + +1/1/07 +Stopped using farkup (for now) +Moved to controller-action naming convention + +1/2/07 +Added Users +Added CRUD for Users, multiple levels of users \ No newline at end of file diff --git a/apps/furnace-onigiri/resources/onigirihouse.css b/apps/furnace-onigiri/resources/onigirihouse.css new file mode 100644 index 0000000000..89f26645f8 --- /dev/null +++ b/apps/furnace-onigiri/resources/onigirihouse.css @@ -0,0 +1,7 @@ +body { font: 14px "Trebuchet MS", Arial, Helvetica, sans-serif; } +h1, h2, h3, h4, h5, h6 { font-family: lucida grande ; } +#header { text-align: center ; } +#container { max-width: 720px ; margin: 0 auto; padding: 20px; } +.entry { margin-bottom: 75px ; } +a { color: #5C832F; text-decoration: none; } +a:hover { text-decoration: underline; } \ No newline at end of file diff --git a/apps/furnace-onigiri/templates/admin-footer.furnace b/apps/furnace-onigiri/templates/admin-footer.furnace new file mode 100644 index 0000000000..17c7245b64 --- /dev/null +++ b/apps/furnace-onigiri/templates/admin-footer.furnace @@ -0,0 +1,3 @@ + + + \ No newline at end of file diff --git a/apps/furnace-onigiri/templates/admin-header.furnace b/apps/furnace-onigiri/templates/admin-header.furnace new file mode 100644 index 0000000000..0df8a60a44 --- /dev/null +++ b/apps/furnace-onigiri/templates/admin-header.furnace @@ -0,0 +1,15 @@ + + + + <% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %> + Onigiri Admin + + + + + + +
\ No newline at end of file diff --git a/apps/furnace-onigiri/templates/analytics.furnace b/apps/furnace-onigiri/templates/analytics.furnace new file mode 100644 index 0000000000..f0e57b41ff --- /dev/null +++ b/apps/furnace-onigiri/templates/analytics.furnace @@ -0,0 +1,8 @@ +<% USING: io namespaces hashtables furnace:onigiri ; %> + + + \ No newline at end of file diff --git a/apps/furnace-onigiri/templates/atom.furnace b/apps/furnace-onigiri/templates/atom.furnace new file mode 100644 index 0000000000..1b7e029866 --- /dev/null +++ b/apps/furnace-onigiri/templates/atom.furnace @@ -0,0 +1,24 @@ + + + <% USING: io namespaces httpd furnace:onigiri tuple-db + math kernel sequences hashtables html calendar ; %> + <% "title" \ onigiri get hash write %> + url write %>"/> + + <% "author" \ onigiri get hash write %> + + <% "atom" action>url write %> + <% "db" \ onigiri get hash any-entry find-tuples + [ [ entry-updated string>number ] 2apply <=> neg ] sort + dup empty? [ %> + <% dup first entry-updated string>number millis>timestamp timestamp>rfc3339 write %><% ] unless + [ [ entry-created string>number ] 2apply <=> neg ] sort + [ %> + + <% dup entry-title write %> + <% dup entry-stub stub>url dup write %> + <% over entry-updated string>number millis>timestamp timestamp>rfc3339 write %> + + <% entry-body write %> + <% ] each %> + \ No newline at end of file diff --git a/apps/furnace-onigiri/templates/edit.furnace b/apps/furnace-onigiri/templates/edit.furnace new file mode 100644 index 0000000000..3c43a2ebb0 --- /dev/null +++ b/apps/furnace-onigiri/templates/edit.furnace @@ -0,0 +1,9 @@ +<% USING: namespaces io kernel sequences furnace:onigiri ; %> + +
+ <% "stub" get [ %>"/><% ] when %> + + + <% "stub" get [ %><% ] when %> +
Title:"/>
Body:
"/>url write %>">Delete
+
diff --git a/apps/furnace-onigiri/templates/entry.furnace b/apps/furnace-onigiri/templates/entry.furnace new file mode 100644 index 0000000000..e70e1a138f --- /dev/null +++ b/apps/furnace-onigiri/templates/entry.furnace @@ -0,0 +1,10 @@ +<% USING: furnace:onigiri io namespaces math calendar html kernel ; %> + +
+

url write %>"><% "title" get write %>

+ +

posted <% "created" get string>number 1000 /f seconds + unix-1970 swap +dt >local-time timestamp>string write %> ">(edit)

+ +<% "body" get write-html %> +
\ No newline at end of file diff --git a/apps/furnace-onigiri/templates/front.furnace b/apps/furnace-onigiri/templates/front.furnace new file mode 100644 index 0000000000..db039daaed --- /dev/null +++ b/apps/furnace-onigiri/templates/front.furnace @@ -0,0 +1,25 @@ + + + + <% USING: namespaces io kernel hashtables furnace:onigiri furnace ; %> + <% "title" get write %> + + + + + + + +
+<% "quot" get call %> + +<% "analytics" \ onigiri get hash [ f "analytics" render-template ] when %> +
+ + diff --git a/apps/furnace-onigiri/templates/meta-list.furnace b/apps/furnace-onigiri/templates/meta-list.furnace new file mode 100644 index 0000000000..722d9b2591 --- /dev/null +++ b/apps/furnace-onigiri/templates/meta-list.furnace @@ -0,0 +1,22 @@ +<% USING: furnace:onigiri namespaces hashtables sequences kernel strings io ; %> + +

Add/Change Onigiri Metadata

+ + + + + + + + +<% \ onigiri get hash-keys [ %> + + <% dup \ onigiri get hash dup string? [ %> + + + + <% ] [ 2drop ] if %> + +<% ] each %> + +
KeyValue
<% swap write %><% write %>
\ No newline at end of file diff --git a/apps/furnace-onigiri/templates/no-entry.furnace b/apps/furnace-onigiri/templates/no-entry.furnace new file mode 100644 index 0000000000..8f6fcd7679 --- /dev/null +++ b/apps/furnace-onigiri/templates/no-entry.furnace @@ -0,0 +1,5 @@ +<% USING: furnace:onigiri io hashtables namespaces ; %> + +

The entry you are searching for could not be found.

+ +

url write %>">Back to <% "title" \ onigiri get hash write %>

\ No newline at end of file diff --git a/apps/furnace-onigiri/templates/user-edit.furnace b/apps/furnace-onigiri/templates/user-edit.furnace new file mode 100644 index 0000000000..7a404b22f0 --- /dev/null +++ b/apps/furnace-onigiri/templates/user-edit.furnace @@ -0,0 +1,15 @@ +<% USING: furnace:onigiri namespaces io kernel ; %> + +
url write %>" method=post> + + + + + + + + +
Name:"/>
Password:
Level:
+
\ No newline at end of file diff --git a/apps/furnace-onigiri/templates/user-list.furnace b/apps/furnace-onigiri/templates/user-list.furnace new file mode 100644 index 0000000000..51e251bb8e --- /dev/null +++ b/apps/furnace-onigiri/templates/user-list.furnace @@ -0,0 +1,15 @@ +<% USING: furnace:onigiri namespaces io hashtables tuple-db kernel sequences ; %> + + + + +<% "db" \ onigiri get hash f f f find-tuples [ %> + + + + +<% ] each %> + +
NameLevel
<% dup user-name write %><% dup user-level write %>editdelete
+ +

url write %>">Add New User

diff --git a/contrib/furnace-pastebin/annotate-paste.fhtml b/apps/furnace-pastebin/annotate-paste.furnace similarity index 100% rename from contrib/furnace-pastebin/annotate-paste.fhtml rename to apps/furnace-pastebin/annotate-paste.furnace diff --git a/contrib/furnace-pastebin/annotation.fhtml b/apps/furnace-pastebin/annotation.furnace similarity index 100% rename from contrib/furnace-pastebin/annotation.fhtml rename to apps/furnace-pastebin/annotation.furnace diff --git a/apps/furnace-pastebin/load.factor b/apps/furnace-pastebin/load.factor new file mode 100644 index 0000000000..e112f63509 --- /dev/null +++ b/apps/furnace-pastebin/load.factor @@ -0,0 +1,4 @@ +REQUIRES: libs/furnace ; + +PROVIDE: apps/furnace-pastebin +{ +files+ { "pastebin.factor" } } ; diff --git a/contrib/furnace-pastebin/new-paste.fhtml b/apps/furnace-pastebin/new-paste.furnace similarity index 100% rename from contrib/furnace-pastebin/new-paste.fhtml rename to apps/furnace-pastebin/new-paste.furnace diff --git a/contrib/furnace-pastebin/paste-list.fhtml b/apps/furnace-pastebin/paste-list.furnace similarity index 100% rename from contrib/furnace-pastebin/paste-list.fhtml rename to apps/furnace-pastebin/paste-list.furnace diff --git a/contrib/furnace-pastebin/paste-summary.fhtml b/apps/furnace-pastebin/paste-summary.furnace similarity index 100% rename from contrib/furnace-pastebin/paste-summary.fhtml rename to apps/furnace-pastebin/paste-summary.furnace diff --git a/contrib/furnace-pastebin/pastebin.factor b/apps/furnace-pastebin/pastebin.factor similarity index 96% rename from contrib/furnace-pastebin/pastebin.factor rename to apps/furnace-pastebin/pastebin.factor index 2378487321..4cbdeb8e11 100644 --- a/contrib/furnace-pastebin/pastebin.factor +++ b/apps/furnace-pastebin/pastebin.factor @@ -72,4 +72,4 @@ C: pastebin ( -- pastebin ) \ annotate-paste [ "n" show-paste ] define-redirect -"pastebin" "paste-list" "contrib/furnace-pastebin" web-app +"pastebin" "paste-list" "apps/furnace-pastebin" web-app diff --git a/contrib/furnace-pastebin/show-paste.fhtml b/apps/furnace-pastebin/show-paste.furnace similarity index 100% rename from contrib/furnace-pastebin/show-paste.fhtml rename to apps/furnace-pastebin/show-paste.furnace diff --git a/apps/help-lint.factor b/apps/help-lint.factor new file mode 100644 index 0000000000..93005d1eda --- /dev/null +++ b/apps/help-lint.factor @@ -0,0 +1,115 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: help-lint +USING: sequences parser kernel errors help words modules strings +namespaces io prettyprint tools definitions generic ; + +! A quick and dirty tool to check documentation in an automated +! fashion. + +! - ensures examples run and produce stated output +! - ensures $see-also elements don't contain duplicate entries +! (I always make this mistake!) +! - ensures $module-link elements point to modules which +! actually exist +! - ensures that $values match the stack effect declaration +! - ensures that word help articles render (this catches broken +! links, improper nesting, etc) + +: check-example ( element -- ) + 1 tail + [ 1 head* "\n" join eval>string "\n" ?tail drop ] keep + peek assert= ; + +: check-examples ( word element -- ) + nip \ $example swap elements [ check-example ] each ; + +: extract-values ( element -- seq ) + \ $values swap elements dup empty? [ + drop { } + ] [ + first 1 tail [ first ] map prune natural-sort + ] if ; + +: effect-values ( word -- seq ) + stack-effect dup effect-in swap effect-out + append [ string? ] subset prune natural-sort ; + +: check-values ( word element -- ) + \ $shuffle over elements empty? + \ $values-x/y over elements empty? not and + pick "declared-effect" word-prop and [ + extract-values >r effect-values r> assert= + ] [ + 2drop + ] if ; + +: check-see-also ( word element -- ) + nip \ $see-also swap elements [ + 1 tail dup prune [ length ] 2apply assert= + ] each ; + +: check-modules ( word element -- ) + nip \ $module-link swap elements [ + second + \ available-modules get member? + [ "Missing module" throw ] unless + ] each ; + +: check-rendering ( word element -- ) + drop [ help ] string-out drop ; + +: all-word-help ( -- seq ) + all-words [ word-help ] subset ; + +TUPLE: word-help-error word ; + +C: word-help-error + [ set-delegate ] keep + [ set-word-help-error-word ] keep ; + +DEFER: check-help + +: fix-help ( error -- ) + dup delegate error. + word-help-error-word edit + "Press ENTER when done." print flush readln drop + reload-modules + check-help ; + +: check-1 ( word -- ) + [ + dup word-help [ + 2dup check-examples + 2dup check-values + 2dup check-see-also + 2dup check-modules + 2dup check-rendering + ] assert-depth 2drop + ] [ + throw + ] recover ; + +: check-help ( -- ) + [ + [ + available-modules [ module-name ] map + \ available-modules set + all-word-help [ check-1 ] each + ] with-scope + ] [ + fix-help check-help + ] recover ; + +: unlinked-words ( -- seq ) + all-word-help [ parents empty? ] subset ; + +: linked-undocumented-words ( -- seq ) + all-words + [ word-help not ] subset + [ parents empty? not ] subset + [ "predicating" word-prop not ] subset ; + +PROVIDE: apps/help-lint ; + +MAIN: apps/help-lint check-help ; diff --git a/contrib/hexdump/hexdump.factor b/apps/hexdump/hexdump.factor similarity index 84% rename from contrib/hexdump/hexdump.factor rename to apps/hexdump/hexdump.factor index 15fe9418c3..d072e81bab 100644 --- a/contrib/hexdump/hexdump.factor +++ b/apps/hexdump/hexdump.factor @@ -1,4 +1,5 @@ -USING: io kernel math namespaces prettyprint sequences strings ; +USING: arrays io kernel math namespaces prettyprint sequences +strings ; IN: hexdump-internals : header. ( len -- ) @@ -8,7 +9,7 @@ IN: hexdump-internals : h-pad. ( digit -- ) >hex 2 CHAR: 0 pad-left write ; : line. ( str n -- ) offset. [ [ h-pad. " " write ] each ] keep - 16 over length - [ " " write ] times + 16 over length - " " concat write [ dup printable? [ drop CHAR: . ] unless ch>string write ] each terpri ; diff --git a/contrib/hexdump/load.factor b/apps/hexdump/load.factor similarity index 75% rename from contrib/hexdump/load.factor rename to apps/hexdump/load.factor index 1fd82280ef..548ac5204a 100644 --- a/contrib/hexdump/load.factor +++ b/apps/hexdump/load.factor @@ -1,3 +1,3 @@ -PROVIDE: contrib/hexdump +PROVIDE: apps/hexdump { +files+ { "hexdump.factor" } } { +tests+ { "test/hexdump.factor" } } ; diff --git a/contrib/hexdump/test/hexdump.factor b/apps/hexdump/test/hexdump.factor similarity index 100% rename from contrib/hexdump/test/hexdump.factor rename to apps/hexdump/test/hexdump.factor diff --git a/contrib/lindenmayer/camera-slate.factor b/apps/lindenmayer/camera-slate.factor similarity index 100% rename from contrib/lindenmayer/camera-slate.factor rename to apps/lindenmayer/camera-slate.factor diff --git a/contrib/lindenmayer/camera.factor b/apps/lindenmayer/camera.factor similarity index 100% rename from contrib/lindenmayer/camera.factor rename to apps/lindenmayer/camera.factor diff --git a/contrib/lindenmayer/lindenmayer.factor b/apps/lindenmayer/lindenmayer.factor similarity index 98% rename from contrib/lindenmayer/lindenmayer.factor rename to apps/lindenmayer/lindenmayer.factor index 64c0622877..8035bc77c3 100644 --- a/contrib/lindenmayer/lindenmayer.factor +++ b/apps/lindenmayer/lindenmayer.factor @@ -1,12 +1,12 @@ ! Eduardo Cavazos - wayo.cavazos@gmail.com -REQUIRES: contrib/math - contrib/vars - contrib/slate - contrib/lindenmayer/opengl - contrib/lindenmayer/turtle - contrib/lindenmayer/camera - contrib/lindenmayer/camera-slate ; +REQUIRES: libs/math + libs/vars + libs/slate + apps/lindenmayer/opengl + apps/lindenmayer/turtle + apps/lindenmayer/camera + apps/lindenmayer/camera-slate ; USING: kernel alien namespaces arrays vectors math opengl sequences threads hashtables strings gadgets @@ -294,7 +294,7 @@ reset-turtle : init-slate ( -- ) >slate namespace slate> set-slate-ns -slate> "L-system" open-titled-window +slate> "L-system" open-window [ display ] >action ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/apps/lindenmayer/load.factor b/apps/lindenmayer/load.factor new file mode 100644 index 0000000000..aa8219e047 --- /dev/null +++ b/apps/lindenmayer/load.factor @@ -0,0 +1,2 @@ +PROVIDE: apps/lindenmayer +{ +files+ { "lindenmayer.factor" } } ; \ No newline at end of file diff --git a/contrib/lindenmayer/opengl.factor b/apps/lindenmayer/opengl.factor similarity index 97% rename from contrib/lindenmayer/opengl.factor rename to apps/lindenmayer/opengl.factor index 44138c369f..38ae09ed9a 100644 --- a/contrib/lindenmayer/opengl.factor +++ b/apps/lindenmayer/opengl.factor @@ -1,4 +1,4 @@ -REQUIRES: contrib/alien ; +REQUIRES: libs/alien ; USING: kernel sequences opengl alien-contrib ; IN: opengl-contrib diff --git a/contrib/lindenmayer/turtle.factor b/apps/lindenmayer/turtle.factor similarity index 98% rename from contrib/lindenmayer/turtle.factor rename to apps/lindenmayer/turtle.factor index 50032f6cc7..b8432f3314 100644 --- a/contrib/lindenmayer/turtle.factor +++ b/apps/lindenmayer/turtle.factor @@ -1,4 +1,4 @@ -REQUIRES: contrib/math contrib/vars ; +REQUIRES: libs/math libs/vars ; USING: kernel math namespaces sequences arrays math-contrib vars ; IN: turtle diff --git a/apps/lisppaste.factor b/apps/lisppaste.factor new file mode 100644 index 0000000000..545a8866b5 --- /dev/null +++ b/apps/lisppaste.factor @@ -0,0 +1,15 @@ +IN: lisppaste +REQUIRES: libs/xml-rpc ; +USING: arrays kernel xml-rpc ; + +: url "http://www.common-lisp.net:8185/RPC2" ; + +: channels ( -- seq ) + { } "listchannels" url invoke-method ; + +: lisppaste ( seq -- response ) + ! seq is { channel user title contents } + ! or { channel user title contents annotation-number } + "newpaste" url invoke-method ; + +PROVIDE: apps/lisppaste ; diff --git a/examples/mandel/load.factor b/apps/mandel/load.factor similarity index 52% rename from examples/mandel/load.factor rename to apps/mandel/load.factor index 26a695bd34..269a8de5d9 100644 --- a/examples/mandel/load.factor +++ b/apps/mandel/load.factor @@ -1,8 +1,8 @@ -PROVIDE: examples/mandel +PROVIDE: apps/mandel { +files+ { "mandel.factor" } } { +tests+ { "tests.factor" } } ; USE: mandel USE: test -MAIN: examples/mandel [ "mandel.pnm" run>file ] time ; +MAIN: apps/mandel [ "mandel.pnm" run>file ] time ; diff --git a/examples/mandel/mandel.factor b/apps/mandel/mandel.factor similarity index 100% rename from examples/mandel/mandel.factor rename to apps/mandel/mandel.factor diff --git a/examples/mandel/tests.factor b/apps/mandel/tests.factor similarity index 100% rename from examples/mandel/tests.factor rename to apps/mandel/tests.factor diff --git a/apps/random-tester/load.factor b/apps/random-tester/load.factor new file mode 100644 index 0000000000..dddeff2a7b --- /dev/null +++ b/apps/random-tester/load.factor @@ -0,0 +1,9 @@ +REQUIRES: libs/lazy-lists libs/shuffle ; +PROVIDE: apps/random-tester +{ +files+ { + "utils.factor" + "random.factor" + "random-tester.factor" + "random-tester2.factor" + "type.factor" +} } ; diff --git a/contrib/random-tester/random-tester.factor b/apps/random-tester/random-tester.factor similarity index 87% rename from contrib/random-tester/random-tester.factor rename to apps/random-tester/random-tester.factor index 4fc64b9d0e..ab24e6554b 100644 --- a/contrib/random-tester/random-tester.factor +++ b/apps/random-tester/random-tester.factor @@ -105,10 +105,6 @@ IN: random-tester : 2-complex>complex { * + - /f } ; - - - - SYMBOL: last-quot SYMBOL: first-arg SYMBOL: second-arg @@ -178,10 +174,10 @@ SYMBOL: second-arg ! RANDOM QUOTATIONS TO TEST -: random-1-integer>x-quot ( -- quot ) 1-integer>x nth-rand unit ; -: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ; -: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ; -: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand unit ; +: random-1-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ; +: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ; +: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ; +: random-1-complex>x-quot ( -- quot ) 1-complex>x pick-one unit ; : test-1-integer>x ( -- ) random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ; @@ -193,18 +189,18 @@ SYMBOL: second-arg random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ; -: random-1-float>float-quot ( -- obj ) 1-float>float nth-rand unit ; -: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand unit ; +: random-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ; +: random-2-float>float-quot ( -- obj ) 2-float>float pick-one unit ; : nrandom-2-float>float-quot ( -- obj ) [ 5 [ { - [ 2-float>float nth-rand , random-float , ] - [ 1-float>float nth-rand , ] + [ 2-float>float pick-one , random-float , ] + [ 1-float>float pick-one , ] } do-one ] times - 2-float>float nth-rand , + 2-float>float pick-one , ] [ ] make ; : test-1-float>float ( -- ) @@ -220,8 +216,8 @@ SYMBOL: second-arg : test-1-integer>x-runtime ( -- ) random-integer random-1-integer>x-quot 1-runtime-check ; -: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws nth-rand unit ; -: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand unit ; +: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ; +: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws pick-one unit ; : test-1-integer>x-throws ( -- obj ) random-integer random-1-integer>x-throws-quot 1-interpreted-vs-compiled-check-catch ; @@ -234,16 +230,9 @@ SYMBOL: second-arg : test-2-integer>x-throws ( -- ) [ random-integer , random-integer , - 2-x>y-throws nth-rand , + 2-x>y-throws pick-one , ] [ ] make 2-interpreted-vs-compiled-check-catch ; -! : test-^-shift ( -- ) -! [ - ! 100 random-int 50 - , - ! 100 random-int 50 - , - ! { ^ shift } nth-rand , - ! ] [ ] make 2-interpreted-vs-compiled-check-catch ; - ! : test-^-ratio ( -- ) ! [ ! random-ratio , random-ratio , \ ^ , @@ -251,27 +240,27 @@ SYMBOL: second-arg : test-0-float?-when [ - random-number , \ dup , \ float? , 1-float>x nth-rand unit , \ when , + random-number , \ dup , \ float? , 1-float>x pick-one unit , \ when , ] [ ] make 0-runtime-check ; : test-1-integer?-when random-integer [ - \ dup , \ integer? , 1-integer>x nth-rand unit , \ when , + \ dup , \ integer? , 1-integer>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-ratio?-when random-ratio [ - \ dup , \ ratio? , 1-ratio>x nth-rand unit , \ when , + \ dup , \ ratio? , 1-ratio>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-float?-when random-float [ - \ dup , \ float? , 1-float>x nth-rand unit , \ when , + \ dup , \ float? , 1-float>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; : test-1-complex?-when random-complex [ - \ dup , \ complex? , 1-complex>x nth-rand unit , \ when , + \ dup , \ complex? , 1-complex>x pick-one unit , \ when , ] [ ] make 1-interpreted-vs-compiled-check ; @@ -308,5 +297,5 @@ SYMBOL: second-arg test-1-complex?-when ! full-gc ! code-gc - } nth-rand dup . execute terpri ; + } pick-one dup . execute terpri ; diff --git a/apps/random-tester/random-tester2.factor b/apps/random-tester/random-tester2.factor new file mode 100644 index 0000000000..5407ccc7a5 --- /dev/null +++ b/apps/random-tester/random-tester2.factor @@ -0,0 +1,163 @@ +USING: compiler errors inference interpreter io +kernel math memory namespaces prettyprint random-tester +sequences tools words ; +USING: arrays definitions generic graphs hashtables ; +IN: random-tester2 + +SYMBOL: wordbank +: w1 + { + die + set-walker-hook exit + + xref-words + + times repeat (repeat) + supremum infimum assoc rassoc norm-sq + product sum curry remove-all member? subseq? + + (next-power-of-2) (^) d>w/w w>h/h millis + (random-int) ^n integer, first-bignum + most-positive-fixnum ^ init-random next-power-of-2 + most-negative-fixnum + + clear-hash build-graph + + >r r> + + set-callstack set-word set-word-prop + set-catchstack set-namestack set-retainstack + set-continuation-retain continuation-catch + set-continuation-name catchstack retainstack + set-no-math-method-generic + set-no-math-method-right + set-check-method-class + set-check-create-name + set-nested-style-stream-style + set-pathname-string + set-check-create-vocab + check-create? + reset-generic forget-class + create forget-word forget-vocab forget forget-tuple + remove-word-prop empty-method + continue-with + + define-compound define make-generic + define-method define-predicate-class + define-tuple define-temp define-tuple-slots + define-writer define-predicate define-generic + ?make-generic define-reader define-slot define-slots + define-typecheck define-slot-word define-union + define-generic* with-methods define-constructor + predicate-word condition-continuation define-symbol + + ndrop + + set-word-def set-word-name + set-word-props set-word-primitive + + stdio + close readln (readln) read1 read with-server + stream-read stream-readln stream-read1 lines (lines) + contents stream-copy stream-flush + stream-format set-line-reader-cr + + double>bits float>bits >bignum + + intern-slots class-predicates delete (delete) prune memq? + normalize norm vneg vmax vmin v- v+ [v-] + + bin> oct> le> be> hex> string>number + + gensym random-int counter + + ! + init-namespaces unxref-word set-global set off on + nest + set-restart-obj + +@ inc dec + + changed-words + callstack namespace namestack global vocabularies + + path+ parent-dir + + .s . word-xt. + + continue-with + set-delegate + + closure + + tabular-output simple-slots + + join concat (group) + } + { "arrays" "errors" "generic" "graphs" "hashtables" "io" + "kernel" "math" "namespaces" + "queues" "strings" "sequences" "vectors" "words" } + [ words ] map concat diff ; + +w1 wordbank set-global + +: databank + { + ! V{ } H{ } V{ 3 } { 3 } { } "" "asdf" + pi 1/0. -1/0. 0/0. [ ] + f t "" 0 0.0 3.14 2 -3 -7 20 3/4 -3/4 1.2/3 3.5 + C{ 2 2 } C{ 1/0. 1/0. } + } ; + +: setup-test ( #data #code -- data... quot ) + #! variable stack effect + >r [ databank pick-one ] times r> + [ drop wordbank get pick-one ] map >quotation ; + +SYMBOL: before +SYMBOL: after +SYMBOL: quot +SYMBOL: err +err off + +: test-compiler ( data... quot -- ... ) + err off + dup quot set + datastack clone dup pop* before set + [ call ] catch drop datastack clone after set + clear + before get [ ] each + quot get [ compile-1 ] [ err on ] recover ; + +: do-test ( data... quot -- ) + .s flush test-compiler + err get [ + datastack after get 2dup = [ + 2drop + ] [ + [ . ] each + "--" print + [ . ] each quot get . + "not =" throw + ] if + ] unless + clear ; + +: random-test ( #data #code -- ) + setup-test do-test ; + +: run-random-tester2 + 100000000000000 [ 6 3 random-test ] times ; + + +! A worthwhile test that has not been run extensively +1000 [ drop gensym ] map "syms" set + +: pick-one [ length random-int ] keep nth ; + +: fooify-test + "syms" get pick-one + 2000 random-int >quotation + over set-word-def + 100 random-int zero? [ code-gc ] when + compile fooify-test ; + diff --git a/contrib/random-tester/random.factor b/apps/random-tester/random.factor similarity index 94% rename from contrib/random-tester/random.factor rename to apps/random-tester/random.factor index 39673c1b0a..fe614aebdb 100644 --- a/contrib/random-tester/random.factor +++ b/apps/random-tester/random.factor @@ -22,7 +22,7 @@ IN: random-tester random-int 2 swap ^ random-int ; : random-seq ( -- seq ) - { [ ] { } V{ } "" } nth-rand + { [ ] { } V{ } "" } pick-one [ max-length random-int [ max-value random-int , ] times ] swap make ; : random-string @@ -56,7 +56,7 @@ SYMBOL: special-complexes coin-flip [ random-fixnum ] [ - coin-flip [ random-bignum ] [ special-integers nth-rand ] if + coin-flip [ random-bignum ] [ special-integers pick-one ] if ] if ; : random-positive-integer ( -- int ) @@ -70,7 +70,7 @@ SYMBOL: special-complexes 1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; : random-float ( -- float ) - coin-flip [ random-ratio ] [ special-floats nth-rand ] if + coin-flip [ random-ratio ] [ special-floats pick-one ] if coin-flip [ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if >float ; diff --git a/apps/random-tester/type.factor b/apps/random-tester/type.factor new file mode 100644 index 0000000000..fa623a736f --- /dev/null +++ b/apps/random-tester/type.factor @@ -0,0 +1,88 @@ +USING: errors generic io kernel lazy-lists math memory namespaces +prettyprint random-tester2 sequences tools words ; +IN: random-tester + +: inert ; +TUPLE: inert-object ; + +: inputs ( -- seq ) + { + 0 -1 -1000000000000000000000000 + ! -268435457 + inert + ! T{ inert-object f } + -29/2 1000000000000000000000000000000/1111111111111111111111111111111111111111111 + 3/4 + -1000000000000000000000000/111111111111111111 + -3.14 1/0. 0.0 -1/0. 3.14 0/0. + C{ 1 -1 } + W{ 55 } + { } + f t + H{ } + V{ 1 0 65536 } + "" + SBUF" " + [ ] + ! DLL" libm.dylib" + ! ALIEN: 1 + T{ inert-object f } + } ; + +: word-inputs ( word -- seq ) + [ stack-effect effect-in length ] [ drop 0 ] recover + inputs swap ; + +: type-error? ( exception -- ? ) + [ swap execute or ] curry + >r { no-method? no-math-method? } f r> reduce ; + +: maybe-explode + dup sequence? [ [ ] each ] when ; inline + +TUPLE: success quot inputs outputs ; + +SYMBOL: err +SYMBOL: type-error +SYMBOL: params +SYMBOL: last-time +SYMBOL: quot +: throws? ( data... quot -- ? ) + dup quot set + err off type-error off + >r + dup clone params set + maybe-explode + r> + ! .s flush + dup last-time get = [ dup . flush dup last-time set ] unless + [ call ] [ err on ] recover + err get [ + dup type-error? dup [ + ! .s + ] unless + type-error set + ] [ + datastack clone >r quot get params get r> + , + ] if clear type-error get ; + +: test-inputs ( word -- seq ) + [ + [ word-inputs ] keep + unit [ + throws? not clear + ] curry each-permutation + ] { } make ; + +: (test1) + [ + [ stack-effect effect-in length ] catch [ 4 < ] unless + ! ] subset [ [ [ test-inputs , full-gc ] { } make , ] each ] { } make ; + ! ] subset [ [ [ test-inputs , ] { } make , ] each ] { } make ; + ] subset [ test-inputs clear ] each ; + +: test1 + wordbank get (test1) ; + +! full-gc finds corrupted memory faster diff --git a/apps/random-tester/utils.factor b/apps/random-tester/utils.factor new file mode 100644 index 0000000000..8d24036563 --- /dev/null +++ b/apps/random-tester/utils.factor @@ -0,0 +1,73 @@ +USING: kernel math sequences namespaces errors hashtables words +arrays parser compiler syntax io optimizer inference shuffle +tools prettyprint ; +IN: random-tester + +: pick-one ( seq -- elt ) + [ length random-int ] keep nth ; + +! HASHTABLES +: random-hash-entry ( hash -- key value ) + hash>alist pick-one first2 ; + +: coin-flip ( -- bool ) 2 random-int zero? ; +: do-one ( seq -- ) pick-one call ; inline + +: nzero-array ( seq -- ) + dup length >r 0 r> [ pick set-nth ] each-with drop ; + +: zero-array + [ drop 0 ] map ; + +TUPLE: p-list seq max count count-vec ; +: make-p-list ( seq n -- tuple ) + >r dup length [ 1- ] keep r> + [ ^ 0 swap 2array ] keep + zero-array ; + +: inc-seq ( seq max -- ) + 2dup [ < ] curry find-last over -1 = [ + 3drop nzero-array + ] [ + nipd 1+ 2over swap set-nth + 1+ over length rot nzero-array + ] if ; + +: inc-count ( tuple -- ) + [ p-list-count first2 >r 1+ r> 2array ] keep + set-p-list-count ; + +: get-permutation ( tuple -- seq ) + [ p-list-seq ] keep p-list-count-vec [ swap nth ] map-with ; + +: p-list-next ( tuple -- seq/f ) + dup p-list-count first2 < [ + [ + [ get-permutation ] keep + [ p-list-count-vec ] keep p-list-max + inc-seq + ] keep inc-count + ] [ + drop f + ] if ; + +: (permutations) ( tuple -- ) + dup p-list-next [ , (permutations) ] [ drop ] if* ; + +: permutations ( seq n -- seq ) + make-p-list + [ + (permutations) + ] { } make ; + +: (each-permutation) ( tuple quot -- ) + over p-list-next [ + [ rot drop swap call ] 3keep + drop (each-permutation) + ] [ + 2drop + ] if* ; inline + +: each-permutation ( seq n quot -- ) + >r make-p-list r> (each-permutation) ; + diff --git a/examples/raytracer.factor b/apps/raytracer.factor similarity index 97% rename from examples/raytracer.factor rename to apps/raytracer.factor index 04eaedd1c7..7d2063e91f 100644 --- a/examples/raytracer.factor +++ b/apps/raytracer.factor @@ -161,6 +161,6 @@ DEFER: create ( level c r -- scene ) "Generating " write dup write "..." print [ run write ] with-stream ; -PROVIDE: examples/raytracer ; +PROVIDE: apps/raytracer ; -MAIN: examples/raytracer [ "raytracer.pnm" run>file ] time ; +MAIN: apps/raytracer [ "raytracer.pnm" run>file ] time ; diff --git a/apps/rss/atom.xml b/apps/rss/atom.xml new file mode 100644 index 0000000000..d0195661ce --- /dev/null +++ b/apps/rss/atom.xml @@ -0,0 +1,45 @@ + + + dive into mark + + A <em>lot</em> of effort + went into making this effortless + + 2005-07-31T12:29:29Z + tag:example.org,2003:3 + + + Copyright (c) 2003, Mark Pilgrim + + Example Toolkit + + + Atom draft-07 snapshot + + + tag:example.org,2003:3.2397 + 2005-07-31T12:29:29Z + 2003-12-13T08:29:29-04:00 + + Mark Pilgrim + http://example.org/ + f8dy@example.com + + + Sam Ruby + + + Joe Gregorio + + +
+

[Update: The Atom draft is finished.]

+
+ + + diff --git a/apps/rss/load.factor b/apps/rss/load.factor new file mode 100644 index 0000000000..fce842e18f --- /dev/null +++ b/apps/rss/load.factor @@ -0,0 +1,10 @@ +REQUIRES: libs/http-client libs/httpd libs/sqlite libs/xml + libs/parser-combinators ; +PROVIDE: apps/rss +{ +files+ { + "rss.factor" + "rss-reader.factor" +} } +{ +tests+ { + "test.factor" +} } ; diff --git a/contrib/rss/readme.txt b/apps/rss/readme.txt similarity index 100% rename from contrib/rss/readme.txt rename to apps/rss/readme.txt diff --git a/contrib/rss/rss-reader.factor b/apps/rss/rss-reader.factor similarity index 94% rename from contrib/rss/rss-reader.factor rename to apps/rss/rss-reader.factor index b6ed9ad626..ee7d5d9079 100644 --- a/contrib/rss/rss-reader.factor +++ b/apps/rss/rss-reader.factor @@ -72,20 +72,20 @@ SYMBOL: db ] show 2drop ; : rss>reader-feed ( url rss -- reader-feed ) - [ rss-title ] keep rss-link ; + [ feed-title ] keep feed-link ; : rss-entry>reader-entry ( url entry -- reader-entry ) - [ rss-entry-link ] keep - [ rss-entry-title ] keep - [ rss-entry-description ] keep - rss-entry-pub-date + [ entry-link ] keep + [ entry-title ] keep + [ entry-description ] keep + entry-pub-date ; : update-feed-database ( url -- ) dup remove-feed - dup rss-get + dup news-get 2dup rss>reader-feed db get swap save-tuple - rss-entries [ + feed-entries [ dupd rss-entry>reader-entry dup >r reader-entry-link f f f db get swap find-tuples [ db get swap delete-tuple ] each r> db get swap save-tuple diff --git a/apps/rss/rss.factor b/apps/rss/rss.factor new file mode 100644 index 0000000000..6b36fec462 --- /dev/null +++ b/apps/rss/rss.factor @@ -0,0 +1,89 @@ +! Copyright (C) 2006 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +IN: rss +USING: kernel http-client xml xml-utils xml-data errors io strings + sequences xml-writer parser-combinators lazy-lists ; + +: ?children>string ( tag/f -- string/f ) + [ children>string ] [ f ] if* ; + +LAZY: '&' ( -- parser ) + "&" token + [ blank? ] satisfy &> + [ "&" swap add ] <@ ; + +: &>& ( string -- string ) + '&' replace ; + +TUPLE: feed title link entries ; +TUPLE: entry title link description pub-date ; + +: rss1.0 ( xml -- feed ) + [ + "channel" find-tag + [ "title" find-tag children>string ] keep + "link" find-tag children>string + ] keep + "item" find-tags [ + [ "title" find-tag children>string ] keep + [ "link" find-tag children>string ] keep + [ "description" find-tag children>string ] keep + f "date" "http://purl.org/dc/elements/1.1/" + find-name-tag ?children>string + + ] map ; + +: rss2.0 ( xml -- feed ) + "channel" find-tag + [ "title" find-tag children>string ] keep + [ "link" find-tag children>string ] keep + "item" find-tags [ + [ "title" find-tag children>string ] keep + [ "link" find-tag ] keep + [ "guid" find-tag dupd ? children>string ] keep + [ "description" find-tag children>string ] keep + "pubDate" find-tag children>string + ] map ; + +: atom1.0 ( xml -- feed ) + [ "title" find-tag children>string ] keep + [ "link" find-tag "href" prop-name-tag first ] keep + "entry" find-tags [ + [ "title" find-tag children>string ] keep + [ "link" find-tag "href" prop-name-tag first ] keep + [ + dup "content" find-tag + [ nip ] [ "summary" find-tag ] if* + dup tag-children [ tag? ] contains? + [ tag-children [ write-chunk ] string-out ] + [ children>string ] if + ] keep + dup "published" find-tag + [ nip ] [ "updated" find-tag ] if* + children>string + ] map ; + +: feed ( xml -- feed ) + dup name-tag { + { [ dup "RDF" = ] [ drop rss1.0 ] } + { [ dup "rss" = ] [ drop rss2.0 ] } + { [ "feed" = ] [ atom1.0 ] } + { [ t ] [ "Invalid newsfeed" throw ] } + } cond ; + +: read-feed ( string -- feed ) + ! &>& ! this will be uncommented when parser-combinators are fixed + string>xml feed ; + +: load-news-file ( filename -- feed ) + #! Load an news syndication file and process it, returning + #! it as an feed tuple. + [ contents read-feed ] keep stream-close ; + +: news-get ( url -- feed ) + #! Retrieve an news syndication file, return as a feed tuple. + http-get rot 200 = [ + nip read-feed + ] [ + 2drop "Error retrieving newsfeed file" throw + ] if ; diff --git a/apps/rss/rss1.xml b/apps/rss/rss1.xml new file mode 100644 index 0000000000..78a253b722 --- /dev/null +++ b/apps/rss/rss1.xml @@ -0,0 +1,67 @@ + + + + + + Meerkat + http://meerkat.oreillynet.com + Meerkat: An Open Wire Service + The O'Reilly Network + Rael Dornfest (mailto:rael@oreilly.com) + Copyright © 2000 O'Reilly & Associates, Inc. + 2000-01-01T12:00+00:00 + hourly + 2 + 2000-01-01T12:00+00:00 + + + + + + + + + + + + + + + Meerkat Powered! + http://meerkat.oreillynet.com/icons/meerkat-powered.jpg + http://meerkat.oreillynet.com + + + + XML: A Disruptive Technology + http://c.moreover.com/click/here.pl?r123 + + XML is placing increasingly heavy loads on the existing technical + infrastructure of the Internet. + + The O'Reilly Network + Simon St.Laurent (mailto:simonstl@simonstl.com) + Copyright © 2000 O'Reilly & Associates, Inc. + XML + XML.com + NASDAQ + XML + + + + Search Meerkat + Search Meerkat's RSS Database... + s + http://meerkat.oreillynet.com/ + search + regex + + + diff --git a/apps/rss/test.factor b/apps/rss/test.factor new file mode 100644 index 0000000000..8ddc964bec --- /dev/null +++ b/apps/rss/test.factor @@ -0,0 +1,37 @@ +USING: rss io test ; +IN: temporary + +[ T{ + feed + f + "Meerkat" + "http://meerkat.oreillynet.com" + V{ + T{ + entry + f + "XML: A Disruptive Technology" + "http://c.moreover.com/click/here.pl?r123" + "\n XML is placing increasingly heavy loads on the existing technical\n infrastructure of the Internet.\n " + f + } + } +} ] [ "apps/rss/rss1.xml" resource-path load-news-file ] unit-test +[ T{ + feed + f + "dive into mark" + "http://example.org/" + V{ + T{ + entry + f + "Atom draft-07 snapshot" + "http://example.org/2005/04/02/atom" + "\n
\n

[Update: The Atom draft is finished.]

\n
\n " + + "2003-12-13T08:29:29-04:00" + } + } +} ] [ "apps/rss/atom.xml" resource-path load-news-file ] unit-test +[ " & & hi" ] [ " & & hi" &>& ] unit-test diff --git a/apps/show-dataflow/load.factor b/apps/show-dataflow/load.factor new file mode 100644 index 0000000000..d6d6bb80ca --- /dev/null +++ b/apps/show-dataflow/load.factor @@ -0,0 +1,3 @@ +PROVIDE: apps/show-dataflow +{ +files+ { "print-dataflow.factor" "show-dataflow.factor" } } +{ +tests+ { "tests.factor" } } ; diff --git a/examples/print-dataflow/print-dataflow.factor b/apps/show-dataflow/print-dataflow.factor similarity index 87% rename from examples/print-dataflow/print-dataflow.factor rename to apps/show-dataflow/print-dataflow.factor index 4abb99c666..5735aabd69 100644 --- a/examples/print-dataflow/print-dataflow.factor +++ b/apps/show-dataflow/print-dataflow.factor @@ -1,7 +1,9 @@ -IN: print-dataflow +! Copyright (C) 2006, 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: show-dataflow USING: generic hashtables inference io kernel kernel-internals -math namespaces prettyprint sequences styles vectors words -optimizer ; +math namespaces prettyprint prettyprint-internals sequences +styles vectors words optimizer ; ! A simple tool for turning dataflow IR into quotations, for ! debugging purposes. @@ -11,7 +13,7 @@ GENERIC: node>quot ( ? node -- ) TUPLE: comment node text ; M: comment pprint* - "( " over comment-text " )" append3 + "( " over comment-text " )" 3append swap comment-node presented associate styled-text ; @@ -79,7 +81,7 @@ M: object node>quot dup class word-name comment, ; : dataflow>quot ( node ? -- quot ) [ swap (dataflow>quot) ] [ ] make ; -: dataflow. ( quot ? -- ) +: print-dataflow ( quot ? -- ) #! Print dataflow IR for a quotation. Flag indicates if #! annotations should be printed or not. >r dataflow optimize r> dataflow>quot . ; diff --git a/library/ui/tools/dataflow.factor b/apps/show-dataflow/show-dataflow.factor similarity index 80% rename from library/ui/tools/dataflow.factor rename to apps/show-dataflow/show-dataflow.factor index 5d4a2c17b5..730d701414 100644 --- a/library/ui/tools/dataflow.factor +++ b/apps/show-dataflow/show-dataflow.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2006 Slava Pestov. +! Copyright (C) 2006, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: gadgets-dataflow +IN: show-dataflow USING: namespaces arrays sequences io inference math kernel generic prettyprint words gadgets opengl gadgets-panes gadgets-labels gadgets-theme gadgets-presentations gadgets-buttons gadgets-borders gadgets-scrolling -gadgets-workspace optimizer models help ; +optimizer models help ; GENERIC: node>gadget* ( height node -- gadget ) @@ -78,8 +78,7 @@ TUPLE: node-gadget value height ; C: node-gadget ( gadget node height -- gadget ) [ set-node-gadget-height ] keep [ set-node-gadget-value ] keep - swap over set-gadget-delegate - dup faint-boundary ; + swap over set-gadget-delegate ; M: node-gadget pref-dim* dup delegate pref-dim @@ -111,10 +110,6 @@ M: #push node-presents >#push< first ; ] 2map ; -: ( node -- gadget ) - class [ word-name