From 86070337fd372fff42d6685e2d962c5224ecc11e Mon Sep 17 00:00:00 2001 From: "U-EE860\\Administrator" Date: Sat, 24 Nov 2007 02:17:40 +0100 Subject: [PATCH 01/50] Refactor open-file to allow flags and attributes as the fourth parameter --- extra/io/windows/ce/files/files.factor | 3 ++- extra/io/windows/mmap/mmap.factor | 2 +- extra/io/windows/nt/files/files.factor | 4 ++-- extra/io/windows/windows.factor | 18 ++++++++++-------- 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/extra/io/windows/ce/files/files.factor b/extra/io/windows/ce/files/files.factor index df5dc65094..c4f5b2ef9e 100755 --- a/extra/io/windows/ce/files/files.factor +++ b/extra/io/windows/ce/files/files.factor @@ -7,7 +7,8 @@ IN: windows.ce.files ! M: windows-ce-io normalize-pathname ( string -- string ) ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ; -M: windows-ce-io CreateFile-flags ( -- DWORD ) FILE_ATTRIBUTE_NORMAL ; +M: windows-ce-io CreateFile-flags ( DWORD -- DWORD ) + FILE_ATTRIBUTE_NORMAL bitor ; M: windows-ce-io FileArgs-overlapped ( port -- f ) drop f ; : finish-read ( port status bytes-ret -- ) diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index ca5d2bbd9a..27587e8340 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -62,7 +62,7 @@ M: windows-ce-io with-privileges : mmap-open ( path access-mode create-mode flProtect access -- handle handle address ) { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ - >r >r open-file dup f r> 0 0 f + >r >r 0 open-file dup f r> 0 0 f CreateFileMapping [ win32-error=0/f ] keep dup close-later dup diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index d53f5fcb40..5eed39224c 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -3,8 +3,8 @@ io.windows.nt io.windows.nt.backend kernel libc math threads windows windows.kernel32 ; IN: io.windows.nt.files -M: windows-nt-io CreateFile-flags ( -- DWORD ) - FILE_FLAG_OVERLAPPED ; +M: windows-nt-io CreateFile-flags ( DWORD -- DWORD ) + FILE_FLAG_OVERLAPPED bitor ; M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) make-overlapped ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index ac0ede0e06..b0ec7f8436 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -23,7 +23,7 @@ TUPLE: win32-file handle ptr overlapped ; : ( in out -- stream ) >r f r> f handle>duplex-stream ; -HOOK: CreateFile-flags io-backend ( -- DWORD ) +HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) HOOK: add-completion io-backend ( port -- ) @@ -31,7 +31,8 @@ M: windows-io normalize-directory ( string -- string ) "\\" ?tail drop "\\*" append ; : share-mode ( -- fixnum ) - FILE_SHARE_READ FILE_SHARE_WRITE bitor ; inline + FILE_SHARE_READ FILE_SHARE_WRITE bitor + FILE_SHARE_DELETE bitor ; foldable M: win32-file init-handle ( handle -- ) drop ; @@ -40,24 +41,25 @@ M: win32-file close-handle ( handle -- ) win32-file-handle CloseHandle drop ; ! Clean up resources (open handle) if add-completion fails -: open-file ( path access-mode create-mode -- handle ) +: open-file ( path access-mode create-mode flags -- handle ) [ - >r share-mode f r> CreateFile-flags f CreateFile + >r >r >r normalize-pathname r> + share-mode f r> r> CreateFile-flags f CreateFile dup invalid-handle? dup close-later dup add-completion ] with-destructors ; : open-pipe-r/w ( path -- handle ) - GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING open-file ; + GENERIC_READ GENERIC_WRITE bitor OPEN_EXISTING 0 open-file ; : open-read ( path -- handle length ) - normalize-pathname GENERIC_READ OPEN_EXISTING open-file 0 ; + GENERIC_READ OPEN_EXISTING 0 open-file 0 ; : open-write ( path -- handle length ) - normalize-pathname GENERIC_WRITE CREATE_ALWAYS open-file 0 ; + GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 ; : (open-append) ( path -- handle ) - normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; + GENERIC_WRITE OPEN_ALWAYS 0 open-file ; : set-file-pointer ( handle length -- ) dupd d>w/w FILE_BEGIN SetFilePointer From 3d0304e61445c8fc345aab1a96545c7548fe5bb2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:44:20 -0600 Subject: [PATCH 02/50] Fix bootstrap --- extra/windows/nt/nt.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/extra/windows/nt/nt.factor b/extra/windows/nt/nt.factor index a485beba00..8a709416d8 100644 --- a/extra/windows/nt/nt.factor +++ b/extra/windows/nt/nt.factor @@ -13,5 +13,3 @@ USING: alien sequences ; { "glu" "glu32.dll" "stdcall" } { "freetype" "freetype6.dll" "cdecl" } } [ first3 add-library ] each - -USING: windows.shell32 ; From 244558f48d79a02ee076f74262dca585b9235d7d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 08:46:18 -0600 Subject: [PATCH 03/50] Add open-in-explorer --- extra/windows/shell32/shell32.factor | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index a6599df637..98ad6b0bd9 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -67,13 +67,27 @@ IN: windows.shell32 : CSIDL_FLAG_CREATE HEX: 8000 ; inline : CSIDL_FLAG_MASK HEX: ff00 ; inline +: SW_HIDE 0 ; inline +: SW_SHOWNORMAL 1 ; inline +: SW_NORMAL 1 ; inline +: SW_SHOWMINIMIZED 2 ; inline +: SW_SHOWMAXIMIZED 3 ; inline +: SW_MAXIMIZE 3 ; inline +: SW_SHOWNOACTIVATE 4 ; inline +: SW_SHOW 5 ; inline +: SW_MINIMIZE 6 ; inline +: SW_SHOWMINNOACTIVE 7 ; inline +: SW_SHOWNA 8 ; inline +: SW_RESTORE 9 ; inline +: SW_SHOWDEFAULT 10 ; inline +: SW_MAX 10 ; inline + : S_OK 0 ; inline : S_FALSE 1 ; inline : E_FAIL HEX: 80004005 ; inline : E_INVALIDARG HEX: 80070057 ; inline : ERROR_FILE_NOT_FOUND 2 ; inline - : SHGFP_TYPE_CURRENT 0 ; inline : SHGFP_TYPE_DEFAULT 1 ; inline @@ -83,6 +97,11 @@ TYPEDEF: void* PIDLIST_ABSOLUTE FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ; ! SHGetSpecialFolderLocation ! SHGetSpecialFolderPath +FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ; +: ShellExecute ShellExecuteW ; inline + +: open-in-explorer ( dir -- ) + f "open" rot f f SW_SHOWNORMAL ShellExecute drop ; : SHGetFolderPath SHGetFolderPathW ; inline From 9143e843b110f39a55253b72ae98331a36569a2f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:00:15 -0600 Subject: [PATCH 04/50] Force windows.shell32 to load when UI loads Remove duplicated code --- extra/ui/windows/windows.factor | 4 ++-- extra/windows/shell32/shell32.factor | 16 +--------------- 2 files changed, 3 insertions(+), 17 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 3d95e281aa..9ee9994d95 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -4,8 +4,8 @@ USING: alien alien.c-types arrays assocs ui ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds ui.gestures io kernel math math.vectors namespaces prettyprint sequences strings vectors words windows.kernel32 windows.gdi32 windows.user32 -windows.opengl32 windows.messages windows.types windows.nt -windows threads timers libc combinators continuations +windows.shell32 windows.opengl32 windows.messages windows.types +windows.nt windows threads timers libc combinators continuations command-line shuffle opengl ui.render ; IN: ui.windows diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index 98ad6b0bd9..25d265479e 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -1,5 +1,5 @@ USING: alien alien.c-types alien.syntax combinators -kernel windows ; +kernel windows windows.user32 ; IN: windows.shell32 : CSIDL_DESKTOP HEX: 00 ; inline @@ -67,20 +67,6 @@ IN: windows.shell32 : CSIDL_FLAG_CREATE HEX: 8000 ; inline : CSIDL_FLAG_MASK HEX: ff00 ; inline -: SW_HIDE 0 ; inline -: SW_SHOWNORMAL 1 ; inline -: SW_NORMAL 1 ; inline -: SW_SHOWMINIMIZED 2 ; inline -: SW_SHOWMAXIMIZED 3 ; inline -: SW_MAXIMIZE 3 ; inline -: SW_SHOWNOACTIVATE 4 ; inline -: SW_SHOW 5 ; inline -: SW_MINIMIZE 6 ; inline -: SW_SHOWMINNOACTIVE 7 ; inline -: SW_SHOWNA 8 ; inline -: SW_RESTORE 9 ; inline -: SW_SHOWDEFAULT 10 ; inline -: SW_MAX 10 ; inline : S_OK 0 ; inline : S_FALSE 1 ; inline From 6ffd6456c4b892ff7a8ea63cc5cb17f7d6907765 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:42:08 -0600 Subject: [PATCH 05/50] Add some code to build up all possible quotations with random-tester --- extra/random-tester/utils/utils.factor | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/extra/random-tester/utils/utils.factor b/extra/random-tester/utils/utils.factor index ef3d66ad2d..91aefabe6f 100644 --- a/extra/random-tester/utils/utils.factor +++ b/extra/random-tester/utils/utils.factor @@ -1,5 +1,5 @@ USING: arrays assocs combinators.lib continuations kernel -math math.functions namespaces quotations random sequences +math math.functions memoize namespaces quotations random sequences sequences.private shuffle ; IN: random-tester.utils @@ -93,3 +93,13 @@ C: p-list >r make-p-list r> (each-permutation) ; +MEMO: builder-permutations ( n -- seq ) + { compose curry } swap permutations + [ >quotation ] map ; foldable + +: all-quot-permutations ( seq -- newseq ) + dup length 1- builder-permutations + swap [ 1quotation ] map dup length permutations + [ swap [ >r seq>stack r> call ] curry* map ] curry* map ; + +! clear { map sq 10 } all-quot-permutations [ [ [ [ [ call ] keep datastack length 2 = [ . .s nl ] when ] catch ] in-thread drop ] each ] each From 70299ba86a26d7721d47ff4852cc0732f77d7589 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 09:49:39 -0600 Subject: [PATCH 06/50] Fix bug curry -> swap curry --- extra/random-tester/utils/utils.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/random-tester/utils/utils.factor b/extra/random-tester/utils/utils.factor index 91aefabe6f..1c591a11e9 100644 --- a/extra/random-tester/utils/utils.factor +++ b/extra/random-tester/utils/utils.factor @@ -93,9 +93,9 @@ C: p-list >r make-p-list r> (each-permutation) ; -MEMO: builder-permutations ( n -- seq ) - { compose curry } swap permutations - [ >quotation ] map ; foldable +: builder-permutations ( n -- seq ) + { [ compose ] [ swap curry ] } swap permutations + [ concat ] map ; foldable : all-quot-permutations ( seq -- newseq ) dup length 1- builder-permutations @@ -103,3 +103,4 @@ MEMO: builder-permutations ( n -- seq ) [ swap [ >r seq>stack r> call ] curry* map ] curry* map ; ! clear { map sq 10 } all-quot-permutations [ [ [ [ [ call ] keep datastack length 2 = [ . .s nl ] when ] catch ] in-thread drop ] each ] each +! clear { map sq sq 10 } all-quot-permutations [ [ [ [ [ call ] keep datastack length 2 = [ . .s nl ] when ] catch ] in-thread drop ] each ] each From ddd55ac4faab03e1c3ec2b7e7c1e2ecdc374bd58 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 18:09:08 -0600 Subject: [PATCH 07/50] Experimental find-binary and find-library words --- core/io/files/files.factor | 14 ++++++++++++++ extra/io/windows/windows.factor | 12 +++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 1dd4259bb6..03bcb77731 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -126,3 +126,17 @@ TUPLE: pathname string ; C: pathname M: pathname <=> [ pathname-string ] compare ; + +HOOK: library-roots io-backend ( -- seq ) +HOOK: binary-roots io-backend ( -- seq ) + +: find-file ( seq str -- path/f ) + [ + [ path+ exists? ] curry find nip + ] keep over [ path+ ] [ drop ] if ; + +: find-library ( str -- path/f ) + library-roots swap find-file ; + +: find-binary ( str -- path/f ) + binary-roots swap find-file ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index d112a99cae..2defa48298 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -4,13 +4,23 @@ USING: alien alien.c-types arrays destructors io io.backend io.buffers io.files io.nonblocking io.sockets io.binary io.sockets.impl windows.errors strings io.streams.duplex kernel math namespaces sequences windows windows.kernel32 -windows.winsock splitting ; +windows.shell32 windows.winsock splitting ; IN: io.windows TUPLE: windows-nt-io ; TUPLE: windows-ce-io ; UNION: windows-io windows-nt-io windows-ce-io ; +M: windows-io library-roots ( -- seq ) + [ + windows , + ] { } make ; + +M: windows-io binary-roots ( -- seq ) + [ + windows , + ] { } make ; + M: windows-io destruct-handle CloseHandle drop ; M: windows-io destruct-socket closesocket drop ; From 583b3abd7417d66eaa5a972b2fe26bbbdc71ae79 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 18:10:55 -0600 Subject: [PATCH 08/50] Add windows word to shell32 --- extra/windows/shell32/shell32.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor index 25d265479e..501f49edfe 100644 --- a/extra/windows/shell32/shell32.factor +++ b/extra/windows/shell32/shell32.factor @@ -79,18 +79,15 @@ IN: windows.shell32 LIBRARY: shell32 -TYPEDEF: void* PIDLIST_ABSOLUTE FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ; -! SHGetSpecialFolderLocation -! SHGetSpecialFolderPath +: SHGetFolderPath SHGetFolderPathW ; inline + FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFile, LPCTSTR lpParameters, LPCTSTR lpDirectory, INT nShowCmd ) ; : ShellExecute ShellExecuteW ; inline : open-in-explorer ( dir -- ) f "open" rot f f SW_SHOWNORMAL ShellExecute drop ; -: SHGetFolderPath SHGetFolderPathW ; inline - : shell32-error ( n -- ) dup S_OK = [ drop @@ -116,6 +113,9 @@ FUNCTION: HINSTANCE ShellExecuteW ( HWND hwnd, LPCTSTR lpOperation, LPCTSTR lpFi : application-data ( -- str ) CSIDL_APPDATA shell32-directory ; +: windows ( -- str ) + CSIDL_WINDOWS shell32-directory ; + : programs ( -- str ) CSIDL_PROGRAMS shell32-directory ; From 7d30e47bca9eec18d00def7a6e9905f31b4bec5c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 19:49:29 -0600 Subject: [PATCH 09/50] Add library-roots and binary-roots for linux/mac --- extra/io/unix/files/files.factor | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index f9d642d661..8f1d05876d 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -38,3 +38,21 @@ M: unix-io make-directory ( path -- ) M: unix-io delete-directory ( path -- ) rmdir io-error ; + +M: unix-io binary-roots ( -- seq ) + { + "/bin" "/sbin" + "/usr/bin" "/usr/sbin" + "/usr/local/bin" "/usr/local/sbin" + "/opt/local/bin" "/opt/local/sbin" + "~/bin" + } ; + +M: unix-io library-roots ( -- seq ) + { + "/lib" + "/usr/lib" + "/usr/local/lib" + "/opt/local/lib" + "/lib64" + } ; From c2e2fb2304e7f10baaf1a3044a01c98b9ae5e161 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 5 Dec 2007 21:00:52 -0500 Subject: [PATCH 10/50] extra/rss now works with some Atom 0.3 feeds --- extra/rss/rss.factor | 64 +++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 30 deletions(-) diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index da810ee377..40395e720f 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -9,6 +9,9 @@ USING: xml.utilities kernel assocs : ?children>string ( tag/f -- string/f ) [ children>string ] [ f ] if* ; +: any-tag-named ( tag names -- tag-inside ) + f -rot [ tag-named nip dup ] curry* find 2drop ; + TUPLE: feed title link entries ; C: feed @@ -17,50 +20,51 @@ TUPLE: entry title link description pub-date ; C: entry +: rss1.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named children>string ] keep + [ "description" tag-named children>string ] keep + f "date" "http://purl.org/dc/elements/1.1/" + tag-named ?children>string + ; + : rss1.0 ( xml -- feed ) [ "channel" tag-named [ "title" tag-named children>string ] keep "link" tag-named children>string ] keep - "item" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named children>string ] keep - [ "description" tag-named children>string ] keep - f "date" "http://purl.org/dc/elements/1.1/" - tag-named ?children>string - - ] map ; + "item" tags-named [ rss1.0-entry ] map ; + +: rss2.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named ] keep + [ "guid" tag-named dupd ? children>string ] keep + [ "description" tag-named children>string ] keep + "pubDate" tag-named children>string ; : rss2.0 ( xml -- feed ) "channel" tag-named [ "title" tag-named children>string ] keep [ "link" tag-named children>string ] keep - "item" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named ] keep - [ "guid" tag-named dupd ? children>string ] keep - [ "description" tag-named children>string ] keep - "pubDate" tag-named children>string - ] map ; + "item" tags-named [ rss2.0-entry ] map ; + +: atom1.0-entry ( tag -- entry ) + [ "title" tag-named children>string ] keep + [ "link" tag-named "href" swap at ] keep + [ + { "content" "summary" } any-tag-named + dup tag-children [ string? not ] contains? + [ tag-children [ write-chunk ] string-out ] + [ children>string ] if + ] keep + { "published" "updated" "issued" "modified" } any-tag-named + children>string ; : atom1.0 ( xml -- feed ) [ "title" tag-named children>string ] keep [ "link" tag-named "href" swap at ] keep - "entry" tags-named [ - [ "title" tag-named children>string ] keep - [ "link" tag-named "href" swap at ] keep - [ - dup "content" tag-named - [ nip ] [ "summary" tag-named ] if* - dup tag-children [ tag? ] contains? - [ tag-children [ write-chunk ] string-out ] - [ children>string ] if - ] keep - dup "published" tag-named - [ nip ] [ "updated" tag-named ] if* - children>string - ] map ; + "entry" tags-named [ atom1.0-entry ] map ; : xml>feed ( xml -- feed ) dup name-tag { @@ -74,7 +78,7 @@ C: entry : download-feed ( url -- feed ) #! Retrieve an news syndication file, return as a feed tuple. - http-get rot 200 = [ + http-get-stream rot 200 = [ nip read-feed ] [ 2drop "Error retrieving newsfeed file" throw From 6120f5f3876e1b6d5c9caeb544622aa5099bf133 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:06:34 -0500 Subject: [PATCH 11/50] Furnace improvements --- extra/furnace/furnace.factor | 65 ++++++++++--------- extra/webapps/pastebin/annotate-paste.furnace | 7 +- extra/webapps/pastebin/modes.furnace | 7 ++ extra/webapps/pastebin/new-paste.furnace | 7 ++ extra/webapps/pastebin/paste-list.furnace | 30 +++++++-- extra/webapps/pastebin/paste-summary.furnace | 14 ++-- extra/webapps/pastebin/pastebin.factor | 37 +++++------ extra/webapps/pastebin/show-paste.furnace | 18 ++++- extra/webapps/pastebin/syntax.furnace | 7 ++ extra/webapps/planet/planet.factor | 2 +- 10 files changed, 128 insertions(+), 66 deletions(-) create mode 100644 extra/webapps/pastebin/modes.furnace create mode 100644 extra/webapps/pastebin/syntax.furnace diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index f2ce0ddf18..076b506112 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -101,36 +101,10 @@ SYMBOL: request-params : service-post ( url -- ) "response" get swap service-request ; -: explode-tuple ( tuple -- ) - dup tuple-slots swap class "slot-names" word-prop - [ set ] 2each ; - -SYMBOL: model - -: call-template ( model template -- ) - [ - >r [ dup model set explode-tuple ] when* r> - ".furnace" append resource-path run-template-file - ] with-scope ; - -: render-template ( model template -- ) - template-path get swap path+ call-template ; - -: render-page* ( model body-template head-template -- ) - [ - [ render-template ] [ f rot render-template ] html-document - ] serve-html ; - -: render-titled-page* ( model body-template head-template title -- ) - [ - [ render-template ] swap [ write f rot render-template ] curry html-document - ] serve-html ; - - -: render-page ( model template title -- ) - [ - [ render-template ] simple-html-document - ] serve-html ; +: render-template ( template -- ) + template-path get swap path+ + ".furnace" append resource-path + run-template-file ; : web-app ( name default path -- ) [ @@ -141,3 +115,34 @@ SYMBOL: model [ service-post ] "post" set ! [ service-head ] "head" set ] make-responder ; + +: explode-tuple ( tuple -- ) + dup tuple-slots swap class "slot-names" word-prop + [ set ] 2each ; + +SYMBOL: model + +: with-slots ( model quot -- ) + [ + >r [ dup model set explode-tuple ] when* r> call + ] with-scope ; + +: render-component ( model template -- ) + swap [ render-template ] with-slots ; + +! Deprecated stuff + +: render-page* ( model body-template head-template -- ) + [ + [ render-component ] [ f rot render-component ] html-document + ] serve-html ; + +: render-titled-page* ( model body-template head-template title -- ) + [ + [ render-component ] swap [ write f rot render-component ] curry html-document + ] serve-html ; + +: render-page ( model template title -- ) + [ + [ render-component ] simple-html-document + ] serve-html ; diff --git a/extra/webapps/pastebin/annotate-paste.furnace b/extra/webapps/pastebin/annotate-paste.furnace index c963e2f88f..301726209b 100644 --- a/extra/webapps/pastebin/annotate-paste.furnace +++ b/extra/webapps/pastebin/annotate-paste.furnace @@ -1,4 +1,4 @@ -<% USING: io math math.parser namespaces ; %> +<% USING: io math math.parser namespaces furnace ; %>

Annotate

@@ -18,6 +18,11 @@ + +File type: +<% "modes" render-template %> + + Contents: diff --git a/extra/webapps/pastebin/modes.furnace b/extra/webapps/pastebin/modes.furnace new file mode 100644 index 0000000000..cc09ae90ed --- /dev/null +++ b/extra/webapps/pastebin/modes.furnace @@ -0,0 +1,7 @@ +<% USING: xmode.catalog sequences kernel html.elements assocs io ; %> + + diff --git a/extra/webapps/pastebin/new-paste.furnace b/extra/webapps/pastebin/new-paste.furnace index 8a2544e801..98b9bae8b7 100644 --- a/extra/webapps/pastebin/new-paste.furnace +++ b/extra/webapps/pastebin/new-paste.furnace @@ -1,3 +1,5 @@ +<% USING: furnace ; %> +
@@ -12,6 +14,11 @@ + + + + + diff --git a/extra/webapps/pastebin/paste-list.furnace b/extra/webapps/pastebin/paste-list.furnace index 7a25ae2f50..1edc312f54 100644 --- a/extra/webapps/pastebin/paste-list.furnace +++ b/extra/webapps/pastebin/paste-list.furnace @@ -1,7 +1,29 @@ <% USING: namespaces furnace sequences ; %> -
File type:<% "modes" render-template %>
Channel:
-<% "new-paste-quot" get "New paste" render-link %> - -<% "pastes" get [ "paste-summary" render-template ] each %>
 Summary:Paste by:LinkDate
+ + + + + + Pastebin + + + + + +

[ "paste" bin ]

+ + + <% "new-paste-quot" get "New paste" render-link %> + + + + + + + <% "pastes" get [ "paste-summary" render-component ] each %> +
 Summary:Paste by:Date:
+ + diff --git a/extra/webapps/pastebin/paste-summary.furnace b/extra/webapps/pastebin/paste-summary.furnace index f5c156a27e..87c01b646d 100644 --- a/extra/webapps/pastebin/paste-summary.furnace +++ b/extra/webapps/pastebin/paste-summary.furnace @@ -1,9 +1,13 @@ <% USING: continuations namespaces io kernel math math.parser furnace ; %> -<% "n" get number>string write %> -<% "summary" get write %> -<% "author" get write %> -<% "n" get number>string "show-paste-quot" get curry "Show" render-link %> -<% "date" get print %> + <% "n" get number>string write %> + <% + "n" get number>string + "show-paste-quot" get curry + "summary" get + render-link + %> + <% "author" get write %> + <% "date" get print %> diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index f592f96448..382b7fbb85 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -1,5 +1,5 @@ -USING: calendar furnace furnace.validator io.files kernel namespaces -sequences store ; +USING: calendar furnace furnace.validator io.files kernel +namespaces sequences store ; IN: webapps.pastebin TUPLE: pastebin pastes ; @@ -7,23 +7,17 @@ TUPLE: pastebin pastes ; : ( -- pastebin ) V{ } clone pastebin construct-boa ; -TUPLE: paste n summary article author channel contents date annotations ; +TUPLE: paste +summary author channel mode contents date +annotations n ; -: ( summary author channel contents -- paste ) - V{ } clone - { - set-paste-summary - set-paste-author - set-paste-channel - set-paste-contents - set-paste-annotations - } paste construct ; +: ( summary author channel mode contents -- paste ) + f V{ } clone f paste construct-boa ; -TUPLE: annotation summary author contents ; +TUPLE: annotation summary author mode contents ; C: annotation - SYMBOL: store "pastebin.store" resource-path load-store store set-global @@ -34,12 +28,12 @@ SYMBOL: store pastebin get pastebin-pastes nth ; : show-paste ( n -- ) - get-paste "show-paste" "Paste" render-page ; + get-paste "show-paste" render-component ; \ show-paste { { "n" v-number } } define-action : new-paste ( -- ) - f "new-paste" "New paste" render-page ; + "new-paste" render-template ; \ new-paste { } define-action @@ -47,22 +41,19 @@ SYMBOL: store [ [ show-paste ] "show-paste-quot" set [ new-paste ] "new-paste-quot" set - pastebin get "paste-list" "Pastebin" render-page + pastebin get "paste-list" render-component ] with-scope ; \ paste-list { } define-action - - : save-pastebin-store ( -- ) store get-global save-store ; : add-paste ( paste pastebin -- ) >r now timestamp>http-string over set-paste-date r> - pastebin-pastes - [ length over set-paste-n ] keep push ; + pastebin-pastes 2dup length swap set-paste-n push ; -: submit-paste ( summary author channel contents -- ) +: submit-paste ( summary author channel mode contents -- ) \ pastebin get-global add-paste save-pastebin-store ; @@ -71,6 +62,7 @@ SYMBOL: store { "summary" v-required } { "author" v-required } { "channel" "#concatenative" v-default } + { "mode" "factor" v-default } { "contents" v-required } } define-action @@ -85,6 +77,7 @@ SYMBOL: store { "n" v-required v-number } { "summary" v-required } { "author" v-required } + { "mode" "factor" v-default } { "contents" v-required } } define-action diff --git a/extra/webapps/pastebin/show-paste.furnace b/extra/webapps/pastebin/show-paste.furnace index b3b4e99b6e..8213857687 100644 --- a/extra/webapps/pastebin/show-paste.furnace +++ b/extra/webapps/pastebin/show-paste.furnace @@ -1,15 +1,27 @@ <% USING: namespaces io furnace sequences ; %> -

Paste: <% "summary" get write %>

+ + + + + + + Paste: <% "summary" get write %> + + + +

[ <% "summary" get write %> ]

+
Paste by:<% "author" get write %>
Channel:<% "channel" get write %>
Created:<% "date" get write %>
File type:<% "mode" get write %>
<% "contents" get write %>
-<% "annotations" get [ "annotation" render-template ] each %> +<% "annotations" get [ "annotation" render-component ] each %> -<% model get "annotate-paste" render-template %> +<% model get "annotate-paste" render-component %> diff --git a/extra/webapps/pastebin/syntax.furnace b/extra/webapps/pastebin/syntax.furnace new file mode 100644 index 0000000000..cc09ae90ed --- /dev/null +++ b/extra/webapps/pastebin/syntax.furnace @@ -0,0 +1,7 @@ +<% USING: xmode.catalog sequences kernel html.elements assocs io ; %> + + diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 92da085128..0ddd48e36e 100644 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -121,7 +121,7 @@ SYMBOL: last-update { { "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" } - { "Chris Double" "http://www.bluishcoder.co.nz/atom.xml" "http://www.bluishcoder.co.nz/" } + { "Chris Double" "http://www.blogger.com/feeds/18561009/posts/full/-/factor" "http://www.bluishcoder.co.nz/" } { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } { "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" } { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" } From 54b52e7b01ff0b60159271c31c71bfa2f252a9c6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:06:43 -0500 Subject: [PATCH 12/50] Stacke effect fix --- extra/xmode/catalog/catalog.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index cde9c6b025..866bd69106 100644 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -26,7 +26,7 @@ TAGS> "extra/xmode/modes/catalog" resource-path read-xml parse-modes-tag ; -: modes ( -- ) +: modes ( -- assoc ) \ modes get-global [ load-catalog dup \ modes set-global ] unless* ; From 0e60982aca4090fd688b93bd4c4aee1964a3d574 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:22:35 -0500 Subject: [PATCH 13/50] Adding syntax highlighting support to the pastebin --- extra/webapps/pastebin/annotate-paste.furnace | 2 +- extra/webapps/pastebin/annotation.furnace | 2 +- extra/webapps/pastebin/new-paste.furnace | 2 +- extra/webapps/pastebin/pastebin.factor | 14 +++++++++----- extra/webapps/pastebin/show-paste.furnace | 5 +++-- extra/webapps/pastebin/syntax.furnace | 8 ++------ 6 files changed, 17 insertions(+), 16 deletions(-) mode change 100644 => 100755 extra/webapps/pastebin/annotate-paste.furnace mode change 100644 => 100755 extra/webapps/pastebin/annotation.furnace mode change 100644 => 100755 extra/webapps/pastebin/new-paste.furnace mode change 100644 => 100755 extra/webapps/pastebin/pastebin.factor mode change 100644 => 100755 extra/webapps/pastebin/show-paste.furnace mode change 100644 => 100755 extra/webapps/pastebin/syntax.furnace diff --git a/extra/webapps/pastebin/annotate-paste.furnace b/extra/webapps/pastebin/annotate-paste.furnace old mode 100644 new mode 100755 index 301726209b..89ce12fd61 --- a/extra/webapps/pastebin/annotate-paste.furnace +++ b/extra/webapps/pastebin/annotate-paste.furnace @@ -24,7 +24,7 @@ -Contents: +Content: diff --git a/extra/webapps/pastebin/annotation.furnace b/extra/webapps/pastebin/annotation.furnace old mode 100644 new mode 100755 index ed1bdac845..d4617667ed --- a/extra/webapps/pastebin/annotation.furnace +++ b/extra/webapps/pastebin/annotation.furnace @@ -8,4 +8,4 @@ Created:<% "date" get write %> -
<% "contents" get write %>
+<% "syntax" render-template % diff --git a/extra/webapps/pastebin/new-paste.furnace b/extra/webapps/pastebin/new-paste.furnace old mode 100644 new mode 100755 index 98b9bae8b7..28453f10f7 --- a/extra/webapps/pastebin/new-paste.furnace +++ b/extra/webapps/pastebin/new-paste.furnace @@ -25,7 +25,7 @@ -Contents: +Content: diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor old mode 100644 new mode 100755 index 382b7fbb85..ad2198f282 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -1,5 +1,5 @@ USING: calendar furnace furnace.validator io.files kernel -namespaces sequences store ; +namespaces sequences store http.server.responders html ; IN: webapps.pastebin TUPLE: pastebin pastes ; @@ -28,21 +28,25 @@ SYMBOL: store pastebin get pastebin-pastes nth ; : show-paste ( n -- ) - get-paste "show-paste" render-component ; + serving-html + get-paste + [ "show-paste" render-component ] with-html-stream ; \ show-paste { { "n" v-number } } define-action : new-paste ( -- ) - "new-paste" render-template ; + serving-html + [ "new-paste" render-template ] with-html-stream ; \ new-paste { } define-action : paste-list ( -- ) + serving-html [ [ show-paste ] "show-paste-quot" set [ new-paste ] "new-paste-quot" set pastebin get "paste-list" render-component - ] with-scope ; + ] with-html-stream ; \ paste-list { } define-action @@ -68,7 +72,7 @@ SYMBOL: store \ submit-paste [ paste-list ] define-redirect -: annotate-paste ( n summary author contents -- ) +: annotate-paste ( n summary author mode contents -- ) swap get-paste paste-annotations push save-pastebin-store ; diff --git a/extra/webapps/pastebin/show-paste.furnace b/extra/webapps/pastebin/show-paste.furnace old mode 100644 new mode 100755 index 8213857687..a724410b8c --- a/extra/webapps/pastebin/show-paste.furnace +++ b/extra/webapps/pastebin/show-paste.furnace @@ -1,4 +1,4 @@ -<% USING: namespaces io furnace sequences ; %> +<% USING: namespaces io furnace sequences xmode.code2html ; %> @@ -9,6 +9,7 @@ Paste: <% "summary" get write %> + <% default-stylesheet %>

[ <% "summary" get write %> ]

@@ -20,7 +21,7 @@ File type:<% "mode" get write %> -
<% "contents" get write %>
+<% "syntax" render-template %> <% "annotations" get [ "annotation" render-component ] each %> diff --git a/extra/webapps/pastebin/syntax.furnace b/extra/webapps/pastebin/syntax.furnace old mode 100644 new mode 100755 index cc09ae90ed..246b9d04b3 --- a/extra/webapps/pastebin/syntax.furnace +++ b/extra/webapps/pastebin/syntax.furnace @@ -1,7 +1,3 @@ -<% USING: xmode.catalog sequences kernel html.elements assocs io ; %> +<% USING: xmode.code2html splitting namespaces ; %> - +
<% "contents" get string-lines "mode" get htmlize-lines %>
From 59566c20e9bc3275c1a0e2bb449ebfd77e0177bb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:23:05 -0500 Subject: [PATCH 14/50] Source responder with syntax highlighting --- extra/webapps/file/file.factor | 25 +++++++++++++++++++------ extra/webapps/source/source.factor | 20 ++++++++++++++++++++ 2 files changed, 39 insertions(+), 6 deletions(-) mode change 100644 => 100755 extra/webapps/file/file.factor create mode 100755 extra/webapps/source/source.factor diff --git a/extra/webapps/file/file.factor b/extra/webapps/file/file.factor old mode 100644 new mode 100755 index d8fec990db..5ec52ab96b --- a/extra/webapps/file/file.factor +++ b/extra/webapps/file/file.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2006 Slava Pestov. +! Copyright (C) 2004, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: calendar html io io.files kernel math math.parser http.server.responders http.server.templating namespaces parser @@ -31,15 +31,24 @@ IN: webapps.file "304 Not Modified" response now timestamp>http-string "Date" associate print-header ; +! You can override how files are served in a custom responder +SYMBOL: serve-file-hook + +[ + nip + file-response + stdio get stream-copy +] serve-file-hook set-global + : serve-static ( filename mime-type -- ) over last-modified-matches? [ 2drop not-modified-response ] [ - dupd file-response "method" get "head" = [ - drop + file-response ] [ - stdio get stream-copy + >r dup r> + serve-file-hook get call ] if ] if ; @@ -53,9 +62,13 @@ SYMBOL: page : include-page ( filename -- ) "doc-root" get swap path+ run-page ; +: serve-fhtml ( filename -- ) + serving-html + "method" get "head" = [ drop ] [ run-page ] if ; + : serve-file ( filename -- ) dup mime-type dup "application/x-factor-server-page" = - [ drop serving-html run-page ] [ serve-static ] if ; + [ drop serve-fhtml ] [ serve-static ] if ; : file. ( name dirp -- ) [ "/" append ] when @@ -107,7 +120,7 @@ SYMBOL: page global [ ! Serve up our own source code - "resources" [ + "resources" [ [ "" resource-path "doc-root" set file-responder diff --git a/extra/webapps/source/source.factor b/extra/webapps/source/source.factor new file mode 100755 index 0000000000..ddc2f15759 --- /dev/null +++ b/extra/webapps/source/source.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.files namespaces webapps.file http.server.responders +xmode.code2html kernel ; +IN: webapps.source + +global [ + ! Serve up our own source code + "source" [ + [ + "" resource-path "doc-root" set + [ + drop + serving-html + htmlize-stream + ] serve-file-hook set + file-responder + ] with-scope + ] add-simple-responder +] bind From a969934061894c8be9f7d6da7983c1ac7be24d07 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:23:18 -0500 Subject: [PATCH 15/50] Various fixes --- extra/xmode/README.txt | 12 ++++---- extra/xmode/code2html/code2html.factor | 40 +++++++++++++------------- extra/xmode/loader/loader.factor | 27 ++++++++++------- extra/xmode/marker/marker-tests.factor | 18 ++++++++++++ extra/xmode/marker/marker.factor | 33 ++++++++++----------- extra/xmode/marker/state/state.factor | 1 - extra/xmode/rules/rules.factor | 26 +++++++++++++---- 7 files changed, 98 insertions(+), 59 deletions(-) mode change 100644 => 100755 extra/xmode/code2html/code2html.factor diff --git a/extra/xmode/README.txt b/extra/xmode/README.txt index bf73042030..57d9f42b22 100755 --- a/extra/xmode/README.txt +++ b/extra/xmode/README.txt @@ -32,10 +32,10 @@ to depend on: it inherits the value of the NO_WORD_SEP attribute from the previous RULES tag. - The Factor implementation does not duplicate this behavior. + The Factor implementation does not duplicate this behavior. If you + find a mode file which depends on this flaw, please fix it and submit + the changes to the jEdit project. -This is still a work in progress. If you find any behavioral differences -between the Factor implementation and the original jEdit code, please -report them as bugs. Also, if you wish to contribute a new or improved -mode file, please contact the jEdit project. Updated mode files in jEdit -will be periodically imported into the Factor source tree. +If you wish to contribute a new or improved mode file, please contact +the jEdit project. Updated mode files in jEdit will be periodically +imported into the Factor source tree. diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor old mode 100644 new mode 100755 index 02bf74dc23..5dc44841d3 --- a/extra/xmode/code2html/code2html.factor +++ b/extra/xmode/code2html/code2html.factor @@ -15,8 +15,10 @@ IN: xmode.code2html : htmlize-line ( line-context line rules -- line-context' ) tokenize-line htmlize-tokens ; -: htmlize-lines ( lines rules -- ) - 
 f -rot [ htmlize-line nl ] curry each drop
; +: htmlize-lines ( lines mode -- ) + 
+        f swap load-mode [ htmlize-line nl ] curry reduce drop
+
; : default-stylesheet ( -- ) ; +: htmlize-stream ( path stream -- ) + lines swap + + + default-stylesheet + dup write + + + over empty? + [ 2drop ] + [ over first find-mode htmlize-lines ] if + + ; + : htmlize-file ( path -- ) - dup lines dup empty? [ 2drop ] [ - swap dup ".html" append [ - [ - - - dup write - default-stylesheet - - - over first - find-mode - load-mode - htmlize-lines - - - ] with-html-stream - ] with-stream - ] if ; + dup over ".html" append + [ htmlize-stream ] with-stream ; diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor index c6b5cad9d1..db3d0fbf41 100755 --- a/extra/xmode/loader/loader.factor +++ b/extra/xmode/loader/loader.factor @@ -32,10 +32,13 @@ IN: xmode.loader swap [ at string>boolean ] curry map first3 ; : parse-literal-matcher ( tag -- matcher ) - dup children>string swap position-attrs ; + dup children>string + \ ignore-case? get [ ] when + swap position-attrs ; : parse-regexp-matcher ( tag -- matcher ) - dup children>string swap position-attrs ; + dup children>string + swap position-attrs ; ! SPAN's children token swap children>string rot set-at ; +: parse-keyword-tag ( tag keyword-map -- ) + >r dup name-tag string>token swap children>string r> set-at ; TAG: KEYWORDS ( rule-set tag -- key value ) - >r rule-set-keywords r> - child-tags [ parse-keyword-tag ] curry* each ; + \ ignore-case? get + swap child-tags [ over parse-keyword-tag ] each + swap set-rule-set-keywords ; TAGS> +: ? dup [ ] when ; + : (parse-rules-tag) ( tag -- rule-set ) { { "SET" string>rule-set-name set-rule-set-name } { "IGNORE_CASE" string>boolean set-rule-set-ignore-case? } { "HIGHLIGHT_DIGITS" string>boolean set-rule-set-highlight-digits? } - { "DIGIT_RE" set-rule-set-digit-re } ! XXX + { "DIGIT_RE" ? set-rule-set-digit-re } { "ESCAPE" f add-escape-rule } { "DEFAULT" string>token set-rule-set-default } { "NO_WORD_SEP" f set-rule-set-no-word-sep } @@ -153,9 +159,10 @@ TAGS> : parse-rules-tag ( tag -- rule-set ) dup (parse-rules-tag) [ - swap child-tags [ - parse-rule-tag - ] curry* each + [ + dup rule-set-ignore-case? \ ignore-case? set + swap child-tags [ parse-rule-tag ] curry* each + ] with-scope ] keep ; : merge-rule-set-props ( props rule-set -- ) diff --git a/extra/xmode/marker/marker-tests.factor b/extra/xmode/marker/marker-tests.factor index cb7f2960a4..5b0aff2050 100755 --- a/extra/xmode/marker/marker-tests.factor +++ b/extra/xmode/marker/marker-tests.factor @@ -109,3 +109,21 @@ IN: temporary ] [ f "$FOO" "shellscript" load-mode tokenize-line nip ] unit-test + +[ + { + T{ token f "AND" KEYWORD1 } + } +] [ + f "AND" "pascal" load-mode tokenize-line nip +] unit-test + +[ + { + T{ token f "Comment {" COMMENT1 } + T{ token f "XXX" COMMENT1 } + T{ token f "}" COMMENT1 } + } +] [ + f "Comment {XXX}" "rebol" load-mode tokenize-line nip +] unit-test diff --git a/extra/xmode/marker/marker.factor b/extra/xmode/marker/marker.factor index cd9eacbb88..dda5d64c9c 100755 --- a/extra/xmode/marker/marker.factor +++ b/extra/xmode/marker/marker.factor @@ -15,8 +15,8 @@ assocs combinators combinators.lib strings regexp splitting ; [ dup [ digit? ] contains? ] [ dup [ digit? ] all? [ - current-rule-set rule-set-digit-re dup - [ dupd 2drop f ] [ drop f ] if + current-rule-set rule-set-digit-re + dup [ dupd matches? ] [ drop f ] if ] unless* ] } && nip ; @@ -26,7 +26,7 @@ assocs combinators combinators.lib strings regexp splitting ; : resolve-delegate ( name -- rules ) dup string? [ - "::" split1 [ swap load-mode at ] [ rule-sets get at ] if* + "::" split1 [ swap load-mode ] [ rule-sets get ] if* at ] when ; : rule-set-keyword-maps ( ruleset -- seq ) @@ -45,13 +45,6 @@ assocs combinators combinators.lib strings regexp splitting ; dup mark-number [ ] [ mark-keyword ] ?if [ prev-token, ] when* ; -: check-terminate-char ( -- ) - current-rule-set rule-set-terminate-char [ - position get <= [ - terminated? on - ] when - ] when* ; - : current-char ( -- char ) position get line get nth ; @@ -74,11 +67,22 @@ GENERIC: text-matches? ( position text -- match-count/f ) M: f text-matches? 2drop f ; M: string text-matches? - ! XXX ignore case >r line get swap tail-slice r> [ head? ] keep length and ; -! M: regexp text-matches? ... ; +M: ignore-case text-matches? + >r line get swap tail-slice r> + ignore-case-string + 2dup shorter? [ + 2drop f + ] [ + [ length head-slice ] keep + [ [ >upper ] 2apply sequence= ] keep + length and + ] if ; + +M: regexp text-matches? + 2drop f ; ! >r line get swap tail-slice r> match-head ; : rule-start-matches? ( rule -- match-count/f ) dup rule-start tuck swap can-match-here? [ @@ -284,8 +288,6 @@ M: mark-previous-rule handle-rule-start : mark-token-loop ( -- ) position get line get length < [ - check-terminate-char - { [ check-end-delegate ] [ check-every-rule ] @@ -302,8 +304,7 @@ M: mark-previous-rule handle-rule-start : unwind-no-line-break ( -- ) context get line-context-parent [ - line-context-in-rule rule-no-line-break? - terminated? get or [ + line-context-in-rule rule-no-line-break? [ pop-context unwind-no-line-break ] when diff --git a/extra/xmode/marker/state/state.factor b/extra/xmode/marker/state/state.factor index cce7c7567a..958c23a2bc 100755 --- a/extra/xmode/marker/state/state.factor +++ b/extra/xmode/marker/state/state.factor @@ -16,7 +16,6 @@ SYMBOL: seen-whitespace-end? SYMBOL: escaped? SYMBOL: process-escape? SYMBOL: delegate-end-escaped? -SYMBOL: terminated? : current-rule ( -- rule ) context get line-context-in-rule ; diff --git a/extra/xmode/rules/rules.factor b/extra/xmode/rules/rules.factor index 7206668edb..906fba3140 100755 --- a/extra/xmode/rules/rules.factor +++ b/extra/xmode/rules/rules.factor @@ -1,7 +1,11 @@ USING: xmode.tokens xmode.keyword-map kernel -sequences vectors assocs strings memoize ; +sequences vectors assocs strings memoize regexp ; IN: xmode.rules +TUPLE: ignore-case string ; + +C: ignore-case + ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet TUPLE: rule-set name @@ -20,12 +24,11 @@ no-word-sep : init-rule-set ( ruleset -- ) #! Call after constructor. - >r H{ } clone H{ } clone V{ } clone f r> + >r H{ } clone H{ } clone V{ } clone r> { set-rule-set-rules set-rule-set-props set-rule-set-imports - set-rule-set-keywords } set-slots ; : ( -- ruleset ) @@ -46,8 +49,9 @@ MEMO: standard-rule-set ( id -- ruleset ) ] when* ; : rule-set-no-word-sep* ( ruleset -- str ) - dup rule-set-keywords keyword-map-no-word-sep* - swap rule-set-no-word-sep "_" 3append ; + dup rule-set-no-word-sep + swap rule-set-keywords dup [ keyword-map-no-word-sep* ] when + "_" 3append ; ! Match restrictions TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ; @@ -97,10 +101,20 @@ TUPLE: escape-rule ; escape-rule construct-rule [ set-rule-start ] keep ; +GENERIC: text-hash-char ( text -- ch ) + +M: f text-hash-char ; + +M: string text-hash-char first ; + +M: ignore-case text-hash-char ignore-case-string first ; + +M: regexp text-hash-char drop f ; + : rule-chars* ( rule -- string ) dup rule-chars swap rule-start matcher-text - dup string? [ first add ] [ drop ] if ; + text-hash-char [ add ] when* ; : add-rule ( rule ruleset -- ) >r dup rule-chars* >upper swap From e82ff27e987efe9d747b22ce6ebc314ce4fdfddb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 01:02:58 -0500 Subject: [PATCH 16/50] Overhaul pastebin --- extra/webapps/pastebin/annotate-paste.furnace | 16 +++--- extra/webapps/pastebin/annotation.furnace | 2 +- extra/webapps/pastebin/footer.furnace | 3 ++ extra/webapps/pastebin/header.furnace | 23 +++++++++ extra/webapps/pastebin/modes.furnace | 4 +- extra/webapps/pastebin/new-paste.furnace | 27 ++++++---- extra/webapps/pastebin/paste-list.furnace | 50 +++++++++---------- extra/webapps/pastebin/paste-summary.furnace | 14 +++--- extra/webapps/pastebin/pastebin.factor | 29 ++++++++++- extra/webapps/pastebin/show-paste.furnace | 19 +++---- extra/webapps/pastebin/style.css | 36 +++++++++++++ extra/webapps/pastebin/syntax.furnace | 2 +- 12 files changed, 156 insertions(+), 69 deletions(-) create mode 100644 extra/webapps/pastebin/footer.furnace create mode 100644 extra/webapps/pastebin/header.furnace create mode 100644 extra/webapps/pastebin/style.css diff --git a/extra/webapps/pastebin/annotate-paste.furnace b/extra/webapps/pastebin/annotate-paste.furnace index 89ce12fd61..abb5cc3d07 100755 --- a/extra/webapps/pastebin/annotate-paste.furnace +++ b/extra/webapps/pastebin/annotate-paste.furnace @@ -9,22 +9,22 @@ string write %>" /> -Your name: - - - - -Summary: +Summary: -File type: +Your name: + + + + +File type: <% "modes" render-template %> -Content: +Content: diff --git a/extra/webapps/pastebin/annotation.furnace b/extra/webapps/pastebin/annotation.furnace index d4617667ed..420c1625f5 100755 --- a/extra/webapps/pastebin/annotation.furnace +++ b/extra/webapps/pastebin/annotation.furnace @@ -8,4 +8,4 @@ Created:<% "date" get write %> -<% "syntax" render-template % +<% "syntax" render-template %> diff --git a/extra/webapps/pastebin/footer.furnace b/extra/webapps/pastebin/footer.furnace new file mode 100644 index 0000000000..15b90110a0 --- /dev/null +++ b/extra/webapps/pastebin/footer.furnace @@ -0,0 +1,3 @@ + + + diff --git a/extra/webapps/pastebin/header.furnace b/extra/webapps/pastebin/header.furnace new file mode 100644 index 0000000000..2c8e79a18d --- /dev/null +++ b/extra/webapps/pastebin/header.furnace @@ -0,0 +1,23 @@ +<% USING: namespaces io furnace sequences xmode.code2html webapps.pastebin ; %> + + + + + + + + <% "title" get write %> + + <% default-stylesheet %> + + + + + +
+ <% [ paste-list ] "Paste list" render-link %> | + <% [ new-paste ] "New paste" render-link %> | + <% [ feed.xml ] "Syndicate" render-link %> +
+

<% "title" get write %>

diff --git a/extra/webapps/pastebin/modes.furnace b/extra/webapps/pastebin/modes.furnace index cc09ae90ed..960b7d4e27 100644 --- a/extra/webapps/pastebin/modes.furnace +++ b/extra/webapps/pastebin/modes.furnace @@ -1,7 +1,7 @@ -<% USING: xmode.catalog sequences kernel html.elements assocs io ; %> +<% USING: xmode.catalog sequences kernel html.elements assocs io sorting ; %> diff --git a/extra/webapps/pastebin/new-paste.furnace b/extra/webapps/pastebin/new-paste.furnace index 28453f10f7..c647df82b0 100755 --- a/extra/webapps/pastebin/new-paste.furnace +++ b/extra/webapps/pastebin/new-paste.furnace @@ -1,34 +1,41 @@ -<% USING: furnace ; %> +<% USING: furnace namespaces ; %> + +<% + "new paste" "title" set + "header" render-template +%> - - - - - - + - + + + + + + - + - +
Your name:
Summary:Summary:
File type:Your name:
File type: <% "modes" render-template %>
Channel:Channel:
Content:Content:
+ +<% "footer" render-template %> diff --git a/extra/webapps/pastebin/paste-list.furnace b/extra/webapps/pastebin/paste-list.furnace index 1edc312f54..75f05c67e9 100644 --- a/extra/webapps/pastebin/paste-list.furnace +++ b/extra/webapps/pastebin/paste-list.furnace @@ -1,29 +1,29 @@ <% USING: namespaces furnace sequences ; %> - +<% + "Pastebin" "title" set + "header" render-template +%> - - - + + + + + +
+ + + + + + + <% "pastes" get [ "paste-summary" render-component ] each %> +
Summary:Paste by:Date:
+ 		+

This pastebin is written in Factor. It can be used for collaborative development over IRC. You can post code for review, and annotate other people's code. Syntax highlighting for over a hundred file types is supported. +

+

+ <% "webapps.pastebin" browse-webapp-source %>

+
- Pastebin - - - - - -

[ "paste" bin ]

- - - <% "new-paste-quot" get "New paste" render-link %> - - - - - - - <% "pastes" get [ "paste-summary" render-component ] each %> -
 Summary:Paste by:Date:
- - +<% "footer" render-template %> diff --git a/extra/webapps/pastebin/paste-summary.furnace b/extra/webapps/pastebin/paste-summary.furnace index 87c01b646d..a50f0ca140 100644 --- a/extra/webapps/pastebin/paste-summary.furnace +++ b/extra/webapps/pastebin/paste-summary.furnace @@ -1,13 +1,11 @@ -<% USING: continuations namespaces io kernel math math.parser furnace ; %> +<% USING: continuations namespaces io kernel math math.parser furnace webapps.pastebin ; %> - <% "n" get number>string write %> - <% - "n" get number>string - "show-paste-quot" get curry - "summary" get - render-link - %> + + + <% "summary" get write %> + + <% "author" get write %> <% "date" get print %> diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index ad2198f282..cd81c74828 100755 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -1,5 +1,6 @@ USING: calendar furnace furnace.validator io.files kernel -namespaces sequences store http.server.responders html ; +namespaces sequences store http.server.responders html +math.parser rss xml.writer ; IN: webapps.pastebin TUPLE: pastebin pastes ; @@ -50,6 +51,26 @@ SYMBOL: store \ paste-list { } define-action +: paste-link ( paste -- link ) + paste-n number>string [ show-paste ] curry quot-link ; + +: paste-feed ( -- entries ) + pastebin get pastebin-pastes [ + { + paste-summary + paste-link + paste-date + } get-slots "" swap + ] map ; + +: feed.xml ( -- ) + "text/xml" serving-content + "pastebin" + "http://pastebin.factorcode.org" + paste-feed feed>xml write-xml ; + +\ feed.xml { } define-action + : save-pastebin-store ( -- ) store get-global save-store ; @@ -87,4 +108,10 @@ SYMBOL: store \ annotate-paste [ "n" show-paste ] define-redirect +: style.css ( -- ) + "text/css" serving-content + "style.css" send-resource ; + +\ style.css { } define-action + "pastebin" "paste-list" "extra/webapps/pastebin" web-app diff --git a/extra/webapps/pastebin/show-paste.furnace b/extra/webapps/pastebin/show-paste.furnace index a724410b8c..56255dcd95 100755 --- a/extra/webapps/pastebin/show-paste.furnace +++ b/extra/webapps/pastebin/show-paste.furnace @@ -1,18 +1,9 @@ <% USING: namespaces io furnace sequences xmode.code2html ; %> - - - - - - - Paste: <% "summary" get write %> - - <% default-stylesheet %> - - -

[ <% "summary" get write %> ]

+<% + "Paste: " "summary" get append "title" set + "header" render-template +%> @@ -26,3 +17,5 @@ <% "annotations" get [ "annotation" render-component ] each %> <% model get "annotate-paste" render-component %> + +<% "footer" render-template %> diff --git a/extra/webapps/pastebin/style.css b/extra/webapps/pastebin/style.css new file mode 100644 index 0000000000..dda38b90d4 --- /dev/null +++ b/extra/webapps/pastebin/style.css @@ -0,0 +1,36 @@ +body { + font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif; + color:#888; +} + +h1.pastebin-title { + font-size:300%; +} + +a { + color:#222; + border-bottom:1px dotted #ccc; + text-decoration:none; +} + +a:hover { + border-bottom:1px solid #ccc; +} + +pre.code { + border:1px dashed #ccc; + background-color:#f5f5f5; + padding:5px; + font-size:150%; +} + +.navbar { + background-color:#eeeeee; + padding:5px; + border:1px solid #ccc; +} + +.infobox { + border: 1px solid #C1DAD7; + padding: 10px; +} diff --git a/extra/webapps/pastebin/syntax.furnace b/extra/webapps/pastebin/syntax.furnace index 246b9d04b3..17b64b920b 100755 --- a/extra/webapps/pastebin/syntax.furnace +++ b/extra/webapps/pastebin/syntax.furnace @@ -1,3 +1,3 @@ <% USING: xmode.code2html splitting namespaces ; %> -
<% "contents" get string-lines "mode" get htmlize-lines %>
+
<% "contents" get string-lines "mode" get htmlize-lines %>
From bb45b6702b9dbfaf1e58db7ebfcaf883cc2202b1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 01:03:10 -0500 Subject: [PATCH 17/50] Planet factor tweak --- extra/webapps/planet/planet.factor | 13 +++++---- extra/webapps/planet/planet.furnace | 4 +-- extra/webapps/planet/style.css | 45 +++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 8 deletions(-) create mode 100644 extra/webapps/planet/style.css diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 0ddd48e36e..8abc9e5bc6 100644 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -50,11 +50,6 @@ IN: webapps.planet : print-postings ( postings -- ) [ print-posting ] each ; -: browse-webapp-source ( vocab -- ) - vocab-link browser-link-href =href a> - "Browse source" write - ; - SYMBOL: default-blogroll SYMBOL: cached-postings @@ -71,12 +66,18 @@ SYMBOL: cached-postings "http://planet.factorcode.org" cached-postings get 30 head ; -: feed.xml +: feed.xml ( -- ) "text/xml" serving-content planet-feed feed>xml write-xml ; \ feed.xml { } define-action +: style.css ( -- ) + "text/css" serving-content + "style.css" send-resource ; + +\ style.css { } define-action + SYMBOL: last-update : diagnostic write print flush ; diff --git a/extra/webapps/planet/planet.furnace b/extra/webapps/planet/planet.furnace index bc9172a55a..949ee7c172 100644 --- a/extra/webapps/planet/planet.furnace +++ b/extra/webapps/planet/planet.furnace @@ -8,7 +8,7 @@ planet-factor - + @@ -28,7 +28,7 @@ Syndicate

- This webapp is written in Factor.
+ This webapp is written in Factor.
<% "webapps.planet" browse-webapp-source %>

Blogroll

diff --git a/extra/webapps/planet/style.css b/extra/webapps/planet/style.css new file mode 100644 index 0000000000..7a66d8d495 --- /dev/null +++ b/extra/webapps/planet/style.css @@ -0,0 +1,45 @@ +body { + font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif; + color:#888; +} + +h1.planet-title { + font-size:300%; +} + +a { + color:#222; + border-bottom:1px dotted #ccc; + text-decoration:none; +} + +a:hover { + border-bottom:1px solid #ccc; +} + +.posting-title { + background-color:#f5f5f5; +} + +pre, code { + color:#000000; + font-size:120%; +} + +.infobox { + border-left: 1px solid #C1DAD7; +} + +.posting-date { + text-align: right; + font-size:90%; +} + +a.more { + display:block; + padding:0 0 5px 0; + color:#333; + text-decoration:none; + text-align:right; + border:none; +} From 6bc89951062cf9b3f9d42696f7817bcfa1fb56a5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 01:03:27 -0500 Subject: [PATCH 18/50] xmode.code2html fix --- extra/xmode/code2html/code2html.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/xmode/code2html/code2html.factor b/extra/xmode/code2html/code2html.factor index 5dc44841d3..dfc50988a3 100755 --- a/extra/xmode/code2html/code2html.factor +++ b/extra/xmode/code2html/code2html.factor @@ -16,9 +16,7 @@ IN: xmode.code2html tokenize-line htmlize-tokens ; : htmlize-lines ( lines mode -- ) - 
-        f swap load-mode [ htmlize-line nl ] curry reduce drop
-
; + f swap load-mode [ htmlize-line nl ] curry reduce drop ; : default-stylesheet ( -- )
Paste by:<% "author" get write %>