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/59] 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 06893a0f224725449bb3d631b0c4bcd7acdc5096 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 14:22:17 -0600 Subject: [PATCH 02/59] Fix typo --- misc/factor.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/misc/factor.sh b/misc/factor.sh index 616119dd61..11ea2a9cdf 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -57,7 +57,7 @@ check_installed_programs() { check_library_exists() { GCC_TEST=factor-library-test.c GCC_OUT=factor-library-test.out - echo -n "Checking for library $1" + echo -n "Checking for library $1..." echo "int main(){return 0;}" > $GCC_TEST gcc $GCC_TEST -o $GCC_OUT -l $1 if [[ $? -ne 0 ]] ; then From e7cbbaa6929ead06675c11f32e87f08bd0a29aed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 14:38:36 -0600 Subject: [PATCH 03/59] Use MAX_UNICODE_PATH for outrageously long c:\windows directory names --- vm/os-windows-nt.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vm/os-windows-nt.c b/vm/os-windows-nt.c index be9dde1fa8..da54b794d1 100755 --- a/vm/os-windows-nt.c +++ b/vm/os-windows-nt.c @@ -10,9 +10,9 @@ s64 current_millis(void) DEFINE_PRIMITIVE(cwd) { - F_CHAR buf[MAX_PATH + 4]; + F_CHAR buf[MAX_UNICODE_PATH]; - if(!GetCurrentDirectory(MAX_PATH + 4, buf)) + if(!GetCurrentDirectory(MAX_UNICODE_PATH, buf)) io_error(); box_u16_string(buf); From 023a1defb5122ef913d9e6827975b64cf996ebd2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 15:12:47 -0600 Subject: [PATCH 04/59] Fix bootstrap --- extra/random-tester/random/random.factor | 37 ++++++++---------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/extra/random-tester/random/random.factor b/extra/random-tester/random/random.factor index da9a5c26d8..7cd669becf 100755 --- a/extra/random-tester/random/random.factor +++ b/extra/random-tester/random/random.factor @@ -1,22 +1,12 @@ -USING: kernel math sequences namespaces errors hashtables words -arrays parser compiler syntax io tools prettyprint optimizer -inference ; +USING: kernel math sequences namespaces hashtables words +arrays parser compiler syntax io prettyprint optimizer +random math.constants math.functions layouts random-tester.utils ; IN: random-tester ! Tweak me : max-length 15 ; inline : max-value 1000000000 ; inline -: 10% ( -- bool ) 10 random 8 > ; -: 20% ( -- bool ) 10 random 7 > ; -: 30% ( -- bool ) 10 random 6 > ; -: 40% ( -- bool ) 10 random 5 > ; -: 50% ( -- bool ) 10 random 4 > ; -: 60% ( -- bool ) 10 random 3 > ; -: 70% ( -- bool ) 10 random 2 > ; -: 80% ( -- bool ) 10 random 1 > ; -: 90% ( -- bool ) 10 random 0 > ; - ! varying bit-length random number : random-bits ( n -- int ) random 2 swap ^ random ; @@ -31,32 +21,29 @@ IN: random-tester SYMBOL: special-integers [ { -1 0 1 } % most-negative-fixnum , most-positive-fixnum , first-bignum , ] { } make \ special-integers set-global -: special-integers ( -- seq ) \ special-integers get ; SYMBOL: special-floats [ { 0.0 -0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ] { } make \ special-floats set-global -: special-floats ( -- seq ) \ special-floats get ; SYMBOL: special-complexes [ - { -1 0 1 i -i } % + { -1 0 1 C{ 0 1 } C{ 0 -1 } } % e , e neg , pi , pi neg , 0 pi rect> , 0 pi neg rect> , pi neg 0 rect> , pi pi rect> , pi pi neg rect> , pi neg pi rect> , pi neg pi neg rect> , e neg e neg rect> , e e rect> , ] { } make \ special-complexes set-global -: special-complexes ( -- seq ) \ special-complexes get ; : random-fixnum ( -- fixnum ) - most-positive-fixnum random 1+ coin-flip [ neg 1- ] when >fixnum ; + most-positive-fixnum random 1+ 50% [ neg 1- ] when >fixnum ; : random-bignum ( -- bignum ) - 400 random-bits first-bignum + coin-flip [ neg ] when ; + 400 random-bits first-bignum + 50% [ neg ] when ; : random-integer ( -- n ) - coin-flip [ + 50% [ random-fixnum ] [ - coin-flip [ random-bignum ] [ special-integers random ] if + 50% [ random-bignum ] [ special-integers get random ] if ] if ; : random-positive-integer ( -- int ) @@ -67,12 +54,12 @@ SYMBOL: special-complexes ] if ; : random-ratio ( -- ratio ) - 1000000000 dup [ random ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; + 1000000000 dup [ random ] 2apply 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; : random-float ( -- float ) - coin-flip [ random-ratio ] [ special-floats random ] if - coin-flip - [ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if + 50% [ random-ratio ] [ special-floats get random ] if + 50% + [ .0000000000000000001 /f ] [ 50% [ .00000000000000001 * ] when ] if >float ; : random-number ( -- number ) From db3add2690a9405ef44d02c78469c184fe3e8e34 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 15:45:59 -0600 Subject: [PATCH 05/59] Add editors to changelog --- extra/help/handbook/handbook.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor index ef25e91191..c59524be6e 100755 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -273,7 +273,11 @@ ARTICLE: "changes" "Changes in the latest release" { { $vocab-link "channels" } " - concurrent message passing over message channels" } { { $vocab-link "destructors" } " - deterministic scope-based resource deallocation (Doug Coleman)" } { { $vocab-link "dlists" } " - various updates (Doug Coleman)" } + { { $vocab-link "editors.emeditor" } " - EmEditor integration (Doug Coleman)" } + { { $vocab-link "editors.editplus" } " - EditPlus integration (Aaron Schaefer)" } { { $vocab-link "editors.notepadpp" } " - Notepad++ integration (Doug Coleman)" } + { { $vocab-link "editors.ted-notepad" } " - TED Notepad integration (Doug Coleman)" } + { { $vocab-link "editors.ultraedit" } " - UltraEdit integration (Doug Coleman)" } { { $vocab-link "heaps" } " - updated for new module system and cleaned up (Doug Coleman)" } { { $vocab-link "peg" } " - Parser Expression Grammars, a new appoach to parser construction, similar to parser combinators (Chris Double)" } { { $vocab-link "regexp" } " - revived from " { $snippet "unmaintained/" } " and completely redesigned (Doug Coleman)" } From 09aad9868725b2add264f189bf6255a54fe5aabc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 18:16:15 -0600 Subject: [PATCH 06/59] Fix UI bug that puts mouse-captured objects in the datastack while walking code I don't understand why it does this, but removing the spurious call to release-capture in the raise-window word fixes the problem --- extra/ui/windows/windows.factor | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 43b30d7a9f..3d95e281aa 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -257,14 +257,12 @@ M: windows-ui-backend (close-window) : prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world ) nip >r mouse-event>gesture r> >lo-hi rot window ; -: mouse-captured? ( -- ? ) - mouse-captured get ; - : set-capture ( hwnd -- ) mouse-captured get [ drop ] [ - [ SetCapture drop ] keep mouse-captured set + [ SetCapture drop ] keep + mouse-captured set ] if ; : release-capture ( -- ) @@ -276,7 +274,7 @@ M: windows-ui-backend (close-window) prepare-mouse send-button-down ; : handle-wm-buttonup ( hWnd uMsg wParam lParam -- ) - mouse-captured? [ release-capture ] when + mouse-captured get [ release-capture ] when prepare-mouse send-button-up ; : make-TRACKMOUSEEVENT ( hWnd -- alien ) @@ -434,7 +432,7 @@ M: windows-ui-backend flush-gl-context ( handle -- ) ! Move window to front M: windows-ui-backend raise-window ( world -- ) world-handle [ - win-hWnd SetFocus drop release-capture + win-hWnd SetFocus drop ] when* ; M: windows-ui-backend set-title ( string world -- ) From 00eeb7074f9349f7d25f72df0da40bd3baf8d86f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Dec 2007 23:57:17 -0600 Subject: [PATCH 07/59] Fix hardware-info on Windows --- extra/hardware-info/windows/ce/ce.factor | 4 ++-- extra/hardware-info/windows/nt/nt.factor | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/hardware-info/windows/ce/ce.factor b/extra/hardware-info/windows/ce/ce.factor index 1ae908c6ef..42fd9e5343 100644 --- a/extra/hardware-info/windows/ce/ce.factor +++ b/extra/hardware-info/windows/ce/ce.factor @@ -1,7 +1,7 @@ -USING: alien.c-types hardware-info kernel math namespaces windows windows.kernel32 ; +USING: alien.c-types hardware-info hardware-info.windows +kernel math namespaces windows windows.kernel32 ; IN: hardware-info.windows.ce -TUPLE: wince ; T{ wince } os set-global : memory-status ( -- MEMORYSTATUS ) diff --git a/extra/hardware-info/windows/nt/nt.factor b/extra/hardware-info/windows/nt/nt.factor index fafcb58dca..2b2522e6ee 100644 --- a/extra/hardware-info/windows/nt/nt.factor +++ b/extra/hardware-info/windows/nt/nt.factor @@ -1,8 +1,8 @@ -USING: alien alien.c-types hardware-info kernel libc math namespaces +USING: alien alien.c-types hardware-info hardware-info.windows +kernel libc math namespaces windows windows.advapi32 windows.kernel32 ; IN: hardware-info.windows.nt -TUPLE: winnt ; T{ winnt } os set-global : memory-status ( -- MEMORYSTATUSEX ) From baf0ef79e55c40893b0488893044aa9f90fc8fa7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:03:35 -0600 Subject: [PATCH 08/59] Add more win32 bindings Bind to shell32 and add desktop, program-files... --- extra/windows/kernel32/kernel32.factor | 9 +- extra/windows/nt/nt.factor | 3 + extra/windows/shell32/shell32.factor | 127 +++++++++++++++++++++++++ extra/windows/windows.factor | 1 + 4 files changed, 137 insertions(+), 3 deletions(-) create mode 100644 extra/windows/shell32/shell32.factor diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor index bb8919dd70..5e0f4ddc65 100755 --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -1010,7 +1010,8 @@ FUNCTION: HANDLE GetStdHandle ( DWORD nStdHandle ) ; ! FUNCTION: GetSystemDefaultLCID ! FUNCTION: GetSystemDefaultUILanguage ! FUNCTION: GetSystemDirectoryA -! FUNCTION: GetSystemDirectoryW +FUNCTION: UINT GetSystemDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ; +: GetSystemDirectory GetSystemDirectoryW ; inline FUNCTION: void GetSystemInfo ( LPSYSTEM_INFO lpSystemInfo ) ; ! FUNCTION: GetSystemPowerStatus ! FUNCTION: GetSystemRegistryQuota @@ -1019,7 +1020,8 @@ FUNCTION: void GetSystemTime ( LPSYSTEMTIME lpSystemTime ) ; FUNCTION: void GetSystemTimeAsFileTime ( LPFILETIME lpSystemTimeAsFileTime ) ; ! FUNCTION: GetSystemTimes ! FUNCTION: GetSystemWindowsDirectoryA -! FUNCTION: GetSystemWindowsDirectoryW +FUNCTION: UINT GetSystemWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ; +: GetSystemWindowsDirectory GetSystemWindowsDirectoryW ; inline ! FUNCTION: GetSystemWow64DirectoryA ! FUNCTION: GetSystemWow64DirectoryW ! FUNCTION: GetTapeParameters @@ -1057,7 +1059,8 @@ FUNCTION: BOOL GetVersionExW ( LPOSVERSIONINFO lpVersionInfo ) ; ! FUNCTION: GetVolumePathNamesForVolumeNameW ! FUNCTION: GetVolumePathNameW ! FUNCTION: GetWindowsDirectoryA -! FUNCTION: GetWindowsDirectoryW +FUNCTION: UINT GetWindowsDirectoryW ( LPTSTR lpBuffer, UINT uSize ) ; +: GetWindowsDirectory GetWindowsDirectoryW ; inline ! FUNCTION: GetWriteWatch ! FUNCTION: GlobalAddAtomA ! FUNCTION: GlobalAddAtomW diff --git a/extra/windows/nt/nt.factor b/extra/windows/nt/nt.factor index d9e8f58cc2..a485beba00 100644 --- a/extra/windows/nt/nt.factor +++ b/extra/windows/nt/nt.factor @@ -6,9 +6,12 @@ USING: alien sequences ; { "kernel32" "kernel32.dll" "stdcall" } { "winsock" "ws2_32.dll" "stdcall" } { "mswsock" "mswsock.dll" "stdcall" } + { "shell32" "shell32.dll" "stdcall" } { "libc" "msvcrt.dll" "cdecl" } { "libm" "msvcrt.dll" "cdecl" } { "gl" "opengl32.dll" "stdcall" } { "glu" "glu32.dll" "stdcall" } { "freetype" "freetype6.dll" "cdecl" } } [ first3 add-library ] each + +USING: windows.shell32 ; diff --git a/extra/windows/shell32/shell32.factor b/extra/windows/shell32/shell32.factor new file mode 100644 index 0000000000..a6599df637 --- /dev/null +++ b/extra/windows/shell32/shell32.factor @@ -0,0 +1,127 @@ +USING: alien alien.c-types alien.syntax combinators +kernel windows ; +IN: windows.shell32 + +: CSIDL_DESKTOP HEX: 00 ; inline +: CSIDL_INTERNET HEX: 01 ; inline +: CSIDL_PROGRAMS HEX: 02 ; inline +: CSIDL_CONTROLS HEX: 03 ; inline +: CSIDL_PRINTERS HEX: 04 ; inline +: CSIDL_PERSONAL HEX: 05 ; inline +: CSIDL_FAVORITES HEX: 06 ; inline +: CSIDL_STARTUP HEX: 07 ; inline +: CSIDL_RECENT HEX: 08 ; inline +: CSIDL_SENDTO HEX: 09 ; inline +: CSIDL_BITBUCKET HEX: 0a ; inline +: CSIDL_STARTMENU HEX: 0b ; inline +: CSIDL_MYDOCUMENTS HEX: 0c ; inline +: CSIDL_MYMUSIC HEX: 0d ; inline +: CSIDL_MYVIDEO HEX: 0e ; inline +: CSIDL_DESKTOPDIRECTORY HEX: 10 ; inline +: CSIDL_DRIVES HEX: 11 ; inline +: CSIDL_NETWORK HEX: 12 ; inline +: CSIDL_NETHOOD HEX: 13 ; inline +: CSIDL_FONTS HEX: 14 ; inline +: CSIDL_TEMPLATES HEX: 15 ; inline +: CSIDL_COMMON_STARTMENU HEX: 16 ; inline +: CSIDL_COMMON_PROGRAMS HEX: 17 ; inline +: CSIDL_COMMON_STARTUP HEX: 18 ; inline +: CSIDL_COMMON_DESKTOPDIRECTORY HEX: 19 ; inline +: CSIDL_APPDATA HEX: 1a ; inline +: CSIDL_PRINTHOOD HEX: 1b ; inline +: CSIDL_LOCAL_APPDATA HEX: 1c ; inline +: CSIDL_ALTSTARTUP HEX: 1d ; inline +: CSIDL_COMMON_ALTSTARTUP HEX: 1e ; inline +: CSIDL_COMMON_FAVORITES HEX: 1f ; inline +: CSIDL_INTERNET_CACHE HEX: 20 ; inline +: CSIDL_COOKIES HEX: 21 ; inline +: CSIDL_HISTORY HEX: 22 ; inline +: CSIDL_COMMON_APPDATA HEX: 23 ; inline +: CSIDL_WINDOWS HEX: 24 ; inline +: CSIDL_SYSTEM HEX: 25 ; inline +: CSIDL_PROGRAM_FILES HEX: 26 ; inline +: CSIDL_MYPICTURES HEX: 27 ; inline +: CSIDL_PROFILE HEX: 28 ; inline +: CSIDL_SYSTEMX86 HEX: 29 ; inline +: CSIDL_PROGRAM_FILESX86 HEX: 2a ; inline +: CSIDL_PROGRAM_FILES_COMMON HEX: 2b ; inline +: CSIDL_PROGRAM_FILES_COMMONX86 HEX: 2c ; inline +: CSIDL_COMMON_TEMPLATES HEX: 2d ; inline +: CSIDL_COMMON_DOCUMENTS HEX: 2e ; inline +: CSIDL_COMMON_ADMINTOOLS HEX: 2f ; inline +: CSIDL_ADMINTOOLS HEX: 30 ; inline +: CSIDL_CONNECTIONS HEX: 31 ; inline +: CSIDL_COMMON_MUSIC HEX: 35 ; inline +: CSIDL_COMMON_PICTURES HEX: 36 ; inline +: CSIDL_COMMON_VIDEO HEX: 37 ; inline +: CSIDL_RESOURCES HEX: 38 ; inline +: CSIDL_RESOURCES_LOCALIZED HEX: 39 ; inline +: CSIDL_COMMON_OEM_LINKS HEX: 3a ; inline +: CSIDL_CDBURN_AREA HEX: 3b ; inline +: CSIDL_COMPUTERSNEARME HEX: 3d ; inline +: CSIDL_PROFILES HEX: 3e ; inline +: CSIDL_FOLDER_MASK HEX: ff ; inline +: CSIDL_FLAG_PER_USER_INIT HEX: 800 ; inline +: CSIDL_FLAG_NO_ALIAS HEX: 1000 ; inline +: CSIDL_FLAG_DONT_VERIFY HEX: 4000 ; inline +: CSIDL_FLAG_CREATE HEX: 8000 ; inline +: CSIDL_FLAG_MASK HEX: ff00 ; 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 + +LIBRARY: shell32 + +TYPEDEF: void* PIDLIST_ABSOLUTE +FUNCTION: HRESULT SHGetFolderPathW ( HWND hwndOwner, int nFolder, HANDLE hToken, DWORD dwReserved, LPTSTR pszPath ) ; +! SHGetSpecialFolderLocation +! SHGetSpecialFolderPath + +: SHGetFolderPath SHGetFolderPathW ; inline + +: shell32-error ( n -- ) + dup S_OK = [ + drop + ] [ + { + ! { ERROR_FILE_NOT_FOUND [ "file not found" throw ] } + ! { E_INVALIDARG [ "invalid arg" throw ] } + [ (win32-error-string) throw ] + } case + ] if ; + +: shell32-directory ( n -- str ) + f swap f SHGFP_TYPE_DEFAULT + MAX_UNICODE_PATH "ushort" + [ SHGetFolderPath shell32-error ] keep alien>u16-string ; + +: desktop ( -- str ) + CSIDL_DESKTOPDIRECTORY shell32-directory ; + +: my-documents ( -- str ) + CSIDL_PERSONAL shell32-directory ; + +: application-data ( -- str ) + CSIDL_APPDATA shell32-directory ; + +: programs ( -- str ) + CSIDL_PROGRAMS shell32-directory ; + +: program-files ( -- str ) + CSIDL_PROGRAM_FILES shell32-directory ; + +: program-files-x86 ( -- str ) + CSIDL_PROGRAM_FILESX86 shell32-directory ; + +: program-files-common ( -- str ) + CSIDL_PROGRAM_FILES_COMMON shell32-directory ; + +: program-files-common-x86 ( -- str ) + CSIDL_PROGRAM_FILES_COMMONX86 shell32-directory ; diff --git a/extra/windows/windows.factor b/extra/windows/windows.factor index 657a8e8a7c..e07c504781 100755 --- a/extra/windows/windows.factor +++ b/extra/windows/windows.factor @@ -7,6 +7,7 @@ IN: windows : lo-word ( wparam -- lo ) *short ; inline : hi-word ( wparam -- hi ) -16 shift lo-word ; inline +: MAX_UNICODE_PATH 32768 ; inline ! You must LocalFree the return value! FUNCTION: void* error_message ( DWORD id ) ; From e63e96d7e14e3059a2514036b8bf7443d55264ed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:04:23 -0600 Subject: [PATCH 09/59] Add word to get windows directory --- extra/hardware-info/windows/windows.factor | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/extra/hardware-info/windows/windows.factor b/extra/hardware-info/windows/windows.factor index bbae541ab4..88e9a8cfb5 100644 --- a/extra/hardware-info/windows/windows.factor +++ b/extra/hardware-info/windows/windows.factor @@ -1,5 +1,6 @@ USING: alien alien.c-types kernel libc math namespaces -windows windows.kernel32 windows.advapi32 hardware-info ; +windows windows.kernel32 windows.advapi32 hardware-info +words ; IN: hardware-info.windows TUPLE: wince ; @@ -53,6 +54,22 @@ M: windows cpus ( -- n ) : sse3? ( -- ? ) PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ; +: ( n -- obj ) + "ushort" ; + +: get-directory ( word -- str ) + >r MAX_UNICODE_PATH [ ] keep dupd r> + execute win32-error=0/f alien>u16-string ; inline + +: windows-directory ( -- str ) + \ GetWindowsDirectory get-directory ; + +: system-directory ( -- str ) + \ GetSystemDirectory get-directory ; + +: system-windows-directory ( -- str ) + \ GetSystemWindowsDirectory get-directory ; + USE-IF: wince? hardware-info.windows.ce USE-IF: winnt? hardware-info.windows.nt From adb540e4851964ca698a9c211c649e4382938e46 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:21:52 -0600 Subject: [PATCH 10/59] Wordpad integration (it's default installed on windows, handles \n, but no line numbers) --- extra/editors/wordpad/authors.txt | 1 + extra/editors/wordpad/summary.txt | 1 + extra/editors/wordpad/wordpad.factor | 13 +++++++++++++ 3 files changed, 15 insertions(+) create mode 100644 extra/editors/wordpad/authors.txt create mode 100644 extra/editors/wordpad/summary.txt create mode 100644 extra/editors/wordpad/wordpad.factor diff --git a/extra/editors/wordpad/authors.txt b/extra/editors/wordpad/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/editors/wordpad/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/editors/wordpad/summary.txt b/extra/editors/wordpad/summary.txt new file mode 100644 index 0000000000..016c602e75 --- /dev/null +++ b/extra/editors/wordpad/summary.txt @@ -0,0 +1 @@ +Wordpad editor integration diff --git a/extra/editors/wordpad/wordpad.factor b/extra/editors/wordpad/wordpad.factor new file mode 100644 index 0000000000..4369013b50 --- /dev/null +++ b/extra/editors/wordpad/wordpad.factor @@ -0,0 +1,13 @@ +USING: editors hardware-info.windows io.launcher kernel +math.parser namespaces sequences windows.shell32 ; +IN: editors.wordpad + +: wordpad ( file line -- ) + [ + \ wordpad get-global % drop " " % % + ] "" make run-detached ; + +program-files "\\Windows NT\\Accessories\\wordpad.exe" append +\ wordpad set-global + +[ wordpad ] edit-hook set-global From f4600ded0cc8b4f789d0dc17a92a786afd0b8ab2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:25:22 -0600 Subject: [PATCH 11/59] Put "" around the filename for wordpad --- extra/editors/wordpad/wordpad.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/editors/wordpad/wordpad.factor b/extra/editors/wordpad/wordpad.factor index 4369013b50..e1646a0855 100644 --- a/extra/editors/wordpad/wordpad.factor +++ b/extra/editors/wordpad/wordpad.factor @@ -4,7 +4,7 @@ IN: editors.wordpad : wordpad ( file line -- ) [ - \ wordpad get-global % drop " " % % + \ wordpad get-global % drop " " % "\"" % % "\"" % ] "" make run-detached ; program-files "\\Windows NT\\Accessories\\wordpad.exe" append From 3d0304e61445c8fc345aab1a96545c7548fe5bb2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Dec 2007 01:44:20 -0600 Subject: [PATCH 12/59] 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 13/59] 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 14/59] 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 15/59] 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 16/59] 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 17/59] 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 18/59] 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 19/59] 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 214974ec52d97de3d9917b29d7bd122d821e2c83 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 5 Dec 2007 23:16:13 -0500 Subject: [PATCH 20/59] Fix feed>xml --- extra/rss/rss.factor | 9 ++++++--- extra/webapps/planet/{planet.fhtml => planet.furnace} | 7 ++++++- 2 files changed, 12 insertions(+), 4 deletions(-) rename extra/webapps/planet/{planet.fhtml => planet.furnace} (83%) diff --git a/extra/rss/rss.factor b/extra/rss/rss.factor index da810ee377..0e78208f86 100644 --- a/extra/rss/rss.factor +++ b/extra/rss/rss.factor @@ -74,7 +74,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 @@ -84,12 +84,15 @@ C: entry : simple-tag, ( content name -- ) [ , ] tag, ; +: simple-tag*, ( content name attrs -- ) + [ , ] tag*, ; + : entry, ( entry -- ) "entry" [ - dup entry-title "title" simple-tag, + dup entry-title "title" { { "type" "html" } } simple-tag*, "link" over entry-link "href" associate contained*, dup entry-pub-date "published" simple-tag, - entry-description "content" simple-tag, + entry-description "content" { { "type" "html" } } simple-tag*, ] tag, ; : feed>xml ( feed -- xml ) diff --git a/extra/webapps/planet/planet.fhtml b/extra/webapps/planet/planet.furnace similarity index 83% rename from extra/webapps/planet/planet.fhtml rename to extra/webapps/planet/planet.furnace index fb5a673077..bc9172a55a 100644 --- a/extra/webapps/planet/planet.fhtml +++ b/extra/webapps/planet/planet.furnace @@ -9,6 +9,7 @@ planet-factor + @@ -23,7 +24,11 @@ Planet Lisp.

- This webapp is written in Factor. + + Syndicate +

+

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

Blogroll

From 4eb4982e60264f62bc3c2341bb9046d2a4dee11b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 5 Dec 2007 23:16:20 -0500 Subject: [PATCH 21/59] RSS feed in planet --- extra/webapps/planet/planet.factor | 135 ++++++++++++++--------------- 1 file changed, 65 insertions(+), 70 deletions(-) diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 9fdafe033b..92da085128 100644 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -1,41 +1,14 @@ USING: sequences rss arrays concurrency kernel sorting html.elements io assocs namespaces math threads vocabs html furnace http.server.templating calendar math.parser splitting -continuations debugger system http.server.responders ; +continuations debugger system http.server.responders +xml.writer ; IN: webapps.planet -TUPLE: posting author title date link body ; - -: diagnostic write print flush ; - -: fetch-feed ( pair -- feed ) - second - dup "Fetching " diagnostic - dup download-feed feed-entries - swap "Done fetching " diagnostic ; - -: fetch-blogroll ( blogroll -- entries ) - #! entries is an array of { author entries } pairs. - dup [ - [ fetch-feed ] [ error. drop f ] recover - ] parallel-map - [ [ >r first r> 2array ] curry* map ] 2map concat ; - -: sort-entries ( entries -- entries' ) - [ [ second entry-pub-date ] compare ] sort ; - -: ( pair -- posting ) - #! pair has shape { author entry } - first2 - { entry-title entry-pub-date entry-link entry-description } - get-slots posting construct-boa ; - : print-posting-summary ( posting -- )

- dup posting-title write
- "- " write - dup posting-author write bl - + dup entry-title write
+ "Read More..." write

; @@ -63,14 +36,16 @@ TUPLE: posting author title date link body ; : print-posting ( posting -- )

- - dup posting-title write-html - " - " write - dup posting-author write + + dup entry-title write-html

-

dup posting-body write-html

-

posting-date format-date write

; +

+ dup entry-description write-html +

+

+ entry-pub-date format-date write +

; : print-postings ( postings -- ) [ print-posting ] each ; @@ -83,38 +58,56 @@ TUPLE: posting author title date link body ; SYMBOL: default-blogroll SYMBOL: cached-postings -: update-cached-postings ( -- ) - default-blogroll get fetch-blogroll sort-entries - [ ] map - cached-postings set-global ; - : mini-planet-factor ( -- ) cached-postings get 4 head print-posting-summaries ; : planet-factor ( -- ) - serving-html [ - "resource:extra/webapps/planet/planet.fhtml" - run-template-file - ] with-html-stream ; + serving-html [ "planet" render-template ] with-html-stream ; \ planet-factor { } define-action -{ - { "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/" } - { "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/" } - { "Kio M. Smallwood" - "http://sekenre.wordpress.com/feed/atom/" - "http://sekenre.wordpress.com/" } - { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } - { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" } - { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" } -} default-blogroll set-global +: planet-feed ( -- feed ) + "[ planet-factor ]" + "http://planet.factorcode.org" + cached-postings get 30 head ; + +: feed.xml + "text/xml" serving-content + planet-feed feed>xml write-xml ; + +\ feed.xml { } define-action SYMBOL: last-update +: diagnostic write print flush ; + +: fetch-feed ( triple -- feed ) + second + dup "Fetching " diagnostic + dup download-feed feed-entries + swap "Done fetching " diagnostic ; + +: ( author entry -- entry' ) + clone + [ ": " swap entry-title 3append ] keep + [ set-entry-title ] keep ; + +: ?fetch-feed ( triple -- feed/f ) + [ fetch-feed ] [ error. drop f ] recover ; + +: fetch-blogroll ( blogroll -- entries ) + dup 0 + swap [ ?fetch-feed ] parallel-map + [ [ ] curry* map ] 2map concat ; + +: sort-entries ( entries -- entries' ) + [ [ entry-pub-date ] compare ] sort ; + +: update-cached-postings ( -- ) + default-blogroll get + fetch-blogroll sort-entries + cached-postings set-global ; + : update-thread ( -- ) millis last-update set-global [ update-cached-postings ] in-thread @@ -126,14 +119,16 @@ SYMBOL: last-update "planet" "planet-factor" "extra/webapps/planet" web-app -: merge-feeds ( feeds -- feed ) - [ feed-entries ] map concat sort-entries ; - -: planet-feed ( -- feed ) - default-blogroll get [ second download-feed ] map merge-feeds - >r "[ planet-factor ]" "http://planet.factorcode.org" r> - feed>xml ; - -: feed.xml planet-feed ; - -\ feed.xml { } define-action +{ + { "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/" } + { "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/" } + { "Kio M. Smallwood" + "http://sekenre.wordpress.com/feed/atom/" + "http://sekenre.wordpress.com/" } + ! { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } + { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" } + { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" } +} default-blogroll set-global From 6120f5f3876e1b6d5c9caeb544622aa5099bf133 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Dec 2007 00:06:34 -0500 Subject: [PATCH 22/59] 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 23/59] 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 24/59] 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 25/59] 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 26/59] 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 27/59] 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 28/59] 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 29/59] 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 %>