From d6c3cff581ad514c6bf8be9b9a65d4c97e91d82a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 8 Mar 2019 21:08:26 -0600 Subject: [PATCH 01/69] debian: Don't install gcc g++ on debian. gmake assumes default CC is cc, CXX is g++ (not c++). In order to make this sane (c++), we check if the shell variable CXX was set and if so we honor it, else we set CXX to c++. --- GNUmakefile | 8 ++++++++ build.sh | 2 +- vm/Config.linux | 5 ++++- 3 files changed, 13 insertions(+), 2 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index df11a97a66..2a779b4855 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -5,6 +5,14 @@ ifdef CONFIG DEBUG ?= 0 REPRODUCIBLE ?= 0 + # gmake's default CXX is g++, we prefer c++ + SHELL_CXX = $(shell printenv CXX) + ifeq ($(SHELL_CXX),) + CXX=c++ + else + CXX=$(SHELL_CXX) + endif + include $(CONFIG) CFLAGS = -Wall \ diff --git a/build.sh b/build.sh index 35f10176d0..f23dd16671 100755 --- a/build.sh +++ b/build.sh @@ -686,7 +686,7 @@ make_boot_image() { } install_deps_apt() { - sudo apt install --yes libc6-dev libpango1.0-dev libx11-dev xorg-dev libgtk2.0-dev gtk2-engines-pixbuf libgtkglext1-dev wget git git-doc rlwrap clang gcc make screen tmux libssl-dev g++ + sudo apt install --yes libc6-dev libpango1.0-dev libx11-dev xorg-dev libgtk2.0-dev gtk2-engines-pixbuf libgtkglext1-dev wget git git-doc rlwrap clang make screen tmux libssl-dev check_ret sudo } diff --git a/vm/Config.linux b/vm/Config.linux index aac32fa3c3..fae2cd4f0e 100644 --- a/vm/Config.linux +++ b/vm/Config.linux @@ -5,6 +5,9 @@ LIBS = -ldl -lm -lrt -lpthread -Wl,--export-dynamic # clang spams warnings if we use -Wl,--no-as-needed with -c # -Wl,--no-as-needed is a gcc optimization, not required -ifneq ($(CXX),clang++) +# we want to work with g++ aliased as c++ here, too +IS_GCC = $(shell $(CXX) --version | grep '(GCC)') + +ifdef ($(IS_GCC)) SITE_CFLAGS += -Wl,--no-as-needed endif From 5048c39e0f4e45dbb58e75fdcb86b02988dd13e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 8 Mar 2019 21:35:53 -0600 Subject: [PATCH 02/69] build.sh: add compile/recopile to docs --- build.sh | 3 +++ 1 file changed, 3 insertions(+) diff --git a/build.sh b/build.sh index f23dd16671..66cf8f2dc5 100755 --- a/build.sh +++ b/build.sh @@ -729,6 +729,8 @@ usage() { $ECHO " self-update - git pull, recompile, make local boot image, bootstrap" $ECHO " quick-update - git pull, refresh-all, save" $ECHO " update|latest - git pull, recompile, download a boot image, bootstrap" + $ECHO " compile - compile the binary" + $ECHO " recompile - recompile the binary" $ECHO " bootstrap - bootstrap with existing boot image" $ECHO " net-bootstrap - recompile, download a boot image, bootstrap" $ECHO " make-target - find and print the os-arch-cpu string" @@ -770,6 +772,7 @@ case "$1" in quick-update) update; refresh_image ;; update|latest) update; download_and_bootstrap ;; compile) find_build_info; make_factor ;; + recompile) find_build_info; make_clean; make_factor ;; bootstrap) get_config_info; bootstrap ;; net-bootstrap) net_bootstrap_no_pull ;; make-target) FIND_MAKE_TARGET=true; ECHO=false; find_build_info; exit_script ;; From 49d9d21124ea1ce3c6325c5c555cf004186c58c3 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 16:48:41 -0700 Subject: [PATCH 03/69] crontab: cleanup empty lines differently. --- extra/crontab/crontab.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index c214cec8fb..f9c010b22e 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -101,4 +101,4 @@ CONSTANT: aliases H{ now 0 >>second [ next-time-after ] keep ; : parse-crontab ( -- entries ) - lines [ [ f ] [ parse-cronentry ] if-empty ] map harvest ; + lines harvest [ parse-cronentry ] map ; From d4fc53f10eb1a77d7cb8a41056bdbe614010f8a6 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 16:56:05 -0700 Subject: [PATCH 04/69] models.delay: use restart-timer, it should actually be working. --- basis/models/delay/delay.factor | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/basis/models/delay/delay.factor b/basis/models/delay/delay.factor index cb903b6150..7e5d488bcc 100644 --- a/basis/models/delay/delay.factor +++ b/basis/models/delay/delay.factor @@ -16,9 +16,6 @@ TUPLE: delay < model model timeout timer ; [ add-dependency ] keep ; M: delay model-changed - ! BUG: timer can't be "restart-timer" inside of its quotation? - ! nip timer>> restart-timer ; - nip timer>> [ stop-timer ] [ start-timer ] bi ; - + nip timer>> restart-timer ; M: delay model-activated update-delay-model ; From ada81e77f54f6e4a92345bb2f8e5b02cc2c8ecc9 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 19:58:07 -0700 Subject: [PATCH 05/69] generalizations: fix funny mnapply/nspread* bug for n > 3. It accidentally worked for n <= 3, now it purposefully works. --- basis/generalizations/generalizations-tests.factor | 6 ++++++ basis/generalizations/generalizations.factor | 8 ++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor index 360c3e5dbe..c083dc5c21 100644 --- a/basis/generalizations/generalizations-tests.factor +++ b/basis/generalizations/generalizations-tests.factor @@ -99,6 +99,12 @@ IN: generalizations.tests { { 1 2 } { 3 4 } { 5 6 } } [ 1 2 3 4 5 6 [ 2array ] 2 3 mnapply ] unit-test +{ 1 4 9 16 } +[ 1 1 2 2 3 3 4 4 [ * ] 2 4 mnapply ] unit-test + +{ 1 8 27 64 125 } +[ 1 1 1 2 2 2 3 3 3 4 4 4 5 5 5 [ * * ] 3 5 mnapply ] unit-test + { { 1 2 3 } { 4 5 6 } } [ 1 2 3 4 5 6 [ 3array ] 3 2 mnapply ] unit-test diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index b45ce52785..34bccc727e 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -92,10 +92,10 @@ MACRO: nspread* ( m n -- quot ) [ drop [ ] ] [ [ * 0 ] [ drop neg ] 2bi rest >array dup length - [ - '[ [ [ _ ndip ] curry ] _ ndip ] - ] 2map dup rest-slice [ [ compose ] compose ] map! drop - [ ] concat-as [ call ] compose + [ '[ [ [ _ ndip ] curry ] _ ndip ] ] 2map + [ [ ] concat-as ] + [ length 1 - [ compose ] concat append ] bi + [ call ] compose ] if-zero ; MACRO: cleave* ( n -- quot ) From b942caf3d7f763a2e5ef68e3e17056d101f39e73 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 20:29:19 -0700 Subject: [PATCH 06/69] io.directories.search: fix traversal test case cross-platform issues. on Linux and macOS mojave they entries might traverse (a,c,b) instead of (a,b.c) so we preserve the traversal method order but sort for cross-platform testing. --- .../io/directories/search/search-tests.factor | 94 +++++++++---------- 1 file changed, 46 insertions(+), 48 deletions(-) diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index b182692937..91831b8a8a 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -1,7 +1,7 @@ USING: combinators fry io.directories io.directories.hierarchy -io.directories.search io.files.unique io.pathnames kernel -namespaces sequences sorting splitting strings system -tools.test ; +io.directories.search io.files.unique io.pathnames kernel math +namespaces sequences sorting splitting splitting.monotonic +strings tools.test ; { t } [ [ @@ -47,49 +47,42 @@ tools.test ; [ drop f ] find-up-to-root ] unit-test -os linux? [ +[ { - V{ 1 2 3 2 3 1 2 3 2 3 1 2 3 2 3 } - V{ 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 } + "/a" + "/a/a" + "/a/a/a" + "/a/b" + "/a/b/a" + "/b" + "/b/a" + "/b/a/a" + "/b/b" + "/b/b/a" + "/c" + "/c/a" + "/c/a/a" + "/c/b" + "/c/b/a" + } + { + "/a" + "/b" + "/c" + "/a/a" + "/a/b" + "/b/a" + "/b/b" + "/c/a" + "/c/b" + "/a/a/a" + "/a/b/a" + "/b/a/a" + "/b/b/a" + "/c/a/a" + "/c/b/a" } ] [ - { - V{ - "/a" - "/a/a" - "/a/a/a" - "/a/b" - "/a/b/a" - "/b" - "/b/a" - "/b/a/a" - "/b/b" - "/b/b/a" - "/c" - "/c/a" - "/c/a/a" - "/c/b" - "/c/b/a" - } - V{ - "/a" - "/b" - "/c" - "/a/a" - "/a/b" - "/b/a" - "/b/b" - "/c/a" - "/c/b" - "/a/a/a" - "/a/b/a" - "/b/a/a" - "/b/b/a" - "/c/a/a" - "/c/b/a" - } - } -] if [ [ "a" make-directory "a/a" make-directory @@ -110,16 +103,21 @@ os linux? [ +depth-first+ traversal-method [ "." recursive-directory-files current-directory get '[ _ ?head drop ] map + + ! preserve file traversal order, but sort + ! alphabetically for cross-platform testing + [ [ length ] bi@ < ] monotonic-split + [ natural-sort ] map natural-sort concat ] with-variable +breadth-first+ traversal-method [ "." recursive-directory-files current-directory get '[ _ ?head drop ] map - ] with-variable - ! Linux doesn't return alphabetic ordering - os linux? [ - [ [ path-components length ] map ] bi@ - ] when + ! preserve file traversal order, but sort + ! alphabetically for cross-platform testing + [ [ length ] bi@ = ] monotonic-split + [ natural-sort ] map concat + ] with-variable ] with-test-directory ] unit-test From 447e30ad4169886295e4d9452d01c0d6b196a2ea Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 20:33:16 -0700 Subject: [PATCH 07/69] ui.tools.listener: use ?first. --- basis/ui/tools/listener/listener.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 89fe0cd74a..6e56407301 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -149,7 +149,7 @@ M: word (print-input) [ interactor-yield ] [ interactor-finish ] bi ; M: interactor stream-readln - interactor-read dup [ first ] when ; + interactor-read ?first ; : (call-listener) ( quot command listener -- ) input>> dup interactor-busy? [ 3drop ] [ From 64d835e2bfe2dc2f4a070b31be1add2c62fef19e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 16 Mar 2019 20:33:40 -0700 Subject: [PATCH 08/69] parser: use ?first. --- core/parser/parser.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 2e7540c0c6..a6ddb9beb6 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs classes combinators -compiler.units continuations definitions effects io -io.encodings.utf8 io.files kernel lexer math.parser namespaces -parser.notes quotations sequences sets slots source-files -vectors vocabs vocabs.parser words words.symbol ; +USING: accessors arrays classes combinators compiler.units +continuations definitions effects io io.encodings.utf8 io.files +kernel lexer math.parser namespaces parser.notes quotations +sequences sets slots source-files vectors vocabs vocabs.parser +words words.symbol ; IN: parser : location ( -- loc ) @@ -180,7 +180,7 @@ print-use-hook [ [ ] ] initialize : filter-moved ( set1 set2 -- seq ) swap diff members [ { - { [ dup where dup [ first ] when current-source-file get path>> = not ] [ f ] } + { [ dup where ?first current-source-file get path>> = not ] [ f ] } { [ dup reader-method? ] [ f ] } { [ dup writer-method? ] [ f ] } [ t ] From 112263ca3cc5700c26f91d1f29abb662ce759cdd Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 17 Mar 2019 08:55:36 -0700 Subject: [PATCH 09/69] crontab: avoid next-time being minutes in the past. --- extra/crontab/crontab-tests.factor | 6 +++++- extra/crontab/crontab.factor | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor index e0ba8d6dea..5701b8b145 100644 --- a/extra/crontab/crontab-tests.factor +++ b/extra/crontab/crontab-tests.factor @@ -1,4 +1,4 @@ -USING: calendar crontab kernel tools.test ; +USING: calendar crontab kernel math.order tools.test ; { T{ timestamp @@ -20,3 +20,7 @@ USING: calendar crontab kernel tools.test ; { gmt-offset T{ duration { hour -8 } } } } [ next-time-after ] keep ] unit-test + +{ +lt+ } [ + now "*/1 * * * *" parse-cronentry next-time <=> +] unit-test diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index f9c010b22e..50c9e06951 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -55,6 +55,10 @@ CONSTANT: aliases H{ :: next-time-after ( cronentry timestamp -- ) + timestamp second>> 0 > [ + timestamp 0 >>second 1 minutes (time+) 2drop + ] when + timestamp month>> :> month cronentry months>> [ month >= ] find nip [ dup month = [ drop f ] [ timestamp month<< t ] if @@ -98,7 +102,7 @@ CONSTANT: aliases H{ ] unless-zero ; : next-time ( cronentry -- timestamp ) - now 0 >>second [ next-time-after ] keep ; + now [ next-time-after ] keep ; : parse-crontab ( -- entries ) lines harvest [ parse-cronentry ] map ; From baafbb8b34b048b45856b1c5459e970f4588a6d4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 16 Mar 2019 21:24:12 -0500 Subject: [PATCH 10/69] windows: Add all shell32 function stubs. Add more com. --- basis/windows/com/com.factor | 14 + basis/windows/ole32/ole32.factor | 28 +- basis/windows/shell32/shell32.factor | 484 +++++++++++++++++++++++++++ basis/windows/user32/user32.factor | 10 +- 4 files changed, 507 insertions(+), 29 deletions(-) diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index 15abd924d8..4334eda29d 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -25,12 +25,26 @@ COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046} HRESULT DUnadvise ( DWORD pdwConnection ) HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ; +COM-INTERFACE: IDropSource IUnknown {00000121-0000-0000-C000-000000000046} + HRESULT GiveFeedback ( DWORD dwEffect ) + HRESULT QueryContinueDrag ( BOOL fEscapePressed, DWORD grfKeyState ) ; + COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046} HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) HRESULT DragLeave ( ) HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ; +TYPEDEF: IDataObject* LPDATAOBJECT +TYPEDEF: IDropSource* LPDROPSOURCE + +FUNCTION: HRESULT DoDragDrop ( + LPDATAOBJECT pDataObj, + LPDROPSOURCE pDropSource, + DWORD dwOKEffects, + LPDWORD pdwEffect +) + COM-INTERFACE: ISequentialStream IUnknown {0C733A30-2A1C-11CE-ADE5-00AA0044773D} HRESULT Read ( void* pv, ULONG cb, ULONG* pcbRead ) HRESULT Write ( void* pv, ULONG cb, ULONG* pcbWritten ) ; diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 89a54b8f58..84e3935ea5 100644 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -29,6 +29,10 @@ FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) CONSTANT: S_OK 0 CONSTANT: S_FALSE 1 +CONSTANT: DRAGDROP_S_DROP 0x00040100 +CONSTANT: DRAGDROP_S_CANCEL 0x00040101 +CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102 + CONSTANT: E_NOINTERFACE 0x80004002 CONSTANT: E_FAIL 0x80004005 CONSTANT: E_INVALIDARG 0x80070057 @@ -45,30 +49,6 @@ CONSTANT: DD_DEFSCROLLINTERVAL 50 CONSTANT: DD_DEFDRAGDELAY 200 CONSTANT: DD_DEFDRAGMINDIST 2 -CONSTANT: CF_TEXT 1 -CONSTANT: CF_BITMAP 2 -CONSTANT: CF_METAFILEPICT 3 -CONSTANT: CF_SYLK 4 -CONSTANT: CF_DIF 5 -CONSTANT: CF_TIFF 6 -CONSTANT: CF_OEMTEXT 7 -CONSTANT: CF_DIB 8 -CONSTANT: CF_PALETTE 9 -CONSTANT: CF_PENDATA 10 -CONSTANT: CF_RIFF 11 -CONSTANT: CF_WAVE 12 -CONSTANT: CF_UNICODETEXT 13 -CONSTANT: CF_ENHMETAFILE 14 -CONSTANT: CF_HDROP 15 -CONSTANT: CF_LOCALE 16 -CONSTANT: CF_MAX 17 - -CONSTANT: CF_OWNERDISPLAY 0x0080 -CONSTANT: CF_DSPTEXT 0x0081 -CONSTANT: CF_DSPBITMAP 0x0082 -CONSTANT: CF_DSPMETAFILEPICT 0x0083 -CONSTANT: CF_DSPENHMETAFILE 0x008E - CONSTANT: DVASPECT_CONTENT 1 CONSTANT: DVASPECT_THUMBNAIL 2 CONSTANT: DVASPECT_ICON 4 diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 387d11824b..25b1ecca8a 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -243,6 +243,10 @@ TYPEDEF: ITEMIDLIST* LPCITEMIDLIST TYPEDEF: ITEMIDLIST ITEMID_CHILD TYPEDEF: ITEMID_CHILD* PITEMID_CHILD TYPEDEF: ITEMID_CHILD* PCUITEMID_CHILD +TYPEDEF: ITEMIDLIST ITEMIDLIST_RELATIVE +TYPEDEF: ITEMIDLIST ITEMIDLIST_ABSOLUTE +TYPEDEF: ITEMIDLIST_ABSOLUTE* PIDLIST_ABSOLUTE +TYPEDEF: ITEMIDLIST_ABSOLUTE* PCIDLIST_ABSOLUTE CONSTANT: STRRET_WSTR 0 CONSTANT: STRRET_OFFSET 1 @@ -379,3 +383,483 @@ STRUCT: NOTIFYICONDATA TYPEDEF: NOTIFYICONDATA* PNOTIFYICONDATA FUNCTION: BOOL Shell_NotifyIcon ( DWORD dwMessage, PNOTIFYICONDATA lpdata ) + +TYPEDEF: HRESULT SHSTDAPI + +FUNCTION: SHSTDAPI SHBindToParent ( + PCIDLIST_ABSOLUTE pidl, + REFIID riid, + void **ppv, + PCUITEMID_CHILD *ppidlLast +) + +! FUNCTION: AppCompat_RunDLLW +! FUNCTION: AssocCreateForClasses +! FUNCTION: AssocGetDetailsOfPropKey +! FUNCTION: CDefFolderMenu_Create2 +! FUNCTION: CheckEscapesW +! FUNCTION: CIDLData_CreateFromIDArray +! FUNCTION: CommandLineToArgvW +! FUNCTION: Control_RunDLL +! FUNCTION: Control_RunDLLA +! FUNCTION: Control_RunDLLAsUserW +! FUNCTION: Control_RunDLLW +! FUNCTION: CreateStorageItemFromPath_FullTrustCaller +! FUNCTION: CreateStorageItemFromPath_FullTrustCaller_ForPackage +! FUNCTION: CreateStorageItemFromPath_PartialTrustCaller +! FUNCTION: CreateStorageItemFromShellItem_FullTrustCaller +! FUNCTION: CreateStorageItemFromShellItem_FullTrustCaller_ForPackage +! FUNCTION: CreateStorageItemFromShellItem_FullTrustCaller_ForPackage_WithProcessHandle +! FUNCTION: CreateStorageItemFromShellItem_FullTrustCaller_UseImplicitFlagsAndPackage +! FUNCTION: CStorageItem_GetValidatedStorageItemObject +! FUNCTION: DAD_AutoScroll +! FUNCTION: DAD_DragEnterEx +! FUNCTION: DAD_DragEnterEx2 +! FUNCTION: DAD_DragLeave +! FUNCTION: DAD_DragMove +! FUNCTION: DAD_SetDragImage +! FUNCTION: DAD_ShowDragImage +! FUNCTION: DllCanUnloadNow +! FUNCTION: DllGetActivationFactory +! FUNCTION: DllGetClassObject +! FUNCTION: DllGetVersion +! FUNCTION: DllInstall +! FUNCTION: DllRegisterServer +! FUNCTION: DllUnregisterServer +! FUNCTION: DoEnvironmentSubstA +! FUNCTION: DoEnvironmentSubstW +! FUNCTION: DragQueryFileA +! FUNCTION: DragQueryFileAorW +! FUNCTION: DriveType +! FUNCTION: DuplicateIcon +! FUNCTION: ExtractAssociatedIconA +! FUNCTION: ExtractAssociatedIconExA +! FUNCTION: ExtractAssociatedIconExW +! FUNCTION: ExtractAssociatedIconW +! FUNCTION: ExtractIconA +! FUNCTION: ExtractIconEx +! FUNCTION: ExtractIconExA +! FUNCTION: ExtractIconExW +! FUNCTION: ExtractIconW +! FUNCTION: FindExecutableA +! FUNCTION: FindExecutableW +! FUNCTION: FreeIconList +! FUNCTION: GetCurrentProcessExplicitAppUserModelID +! FUNCTION: GetFileNameFromBrowse +! FUNCTION: GetSystemPersistedStorageItemList +! FUNCTION: ILAppendID +! FUNCTION: ILClone +! FUNCTION: ILCloneFirst +! FUNCTION: ILCombine +! FUNCTION: ILCreateFromPath +! FUNCTION: ILCreateFromPathA +! FUNCTION: ILCreateFromPathW +! FUNCTION: ILFindChild +! FUNCTION: ILFindLastID +! FUNCTION: ILFree +! FUNCTION: ILGetNext +! FUNCTION: ILGetSize +! FUNCTION: ILIsEqual +! FUNCTION: ILIsParent +! FUNCTION: ILLoadFromStreamEx +! FUNCTION: ILRemoveLastID +! FUNCTION: ILSaveToStream +! FUNCTION: InitNetworkAddressControl +! FUNCTION: InternalExtractIconListA +! FUNCTION: InternalExtractIconListW +! FUNCTION: IsDesktopExplorerProcess +! FUNCTION: IsLFNDrive +! FUNCTION: IsLFNDriveA +! FUNCTION: IsLFNDriveW +! FUNCTION: IsNetDrive +! FUNCTION: IsProcessAnExplorer +! FUNCTION: LaunchMSHelp_RunDLLW +! FUNCTION: OpenAs_RunDLL +! FUNCTION: OpenAs_RunDLLA +! FUNCTION: OpenAs_RunDLLW +! FUNCTION: OpenRegStream +! FUNCTION: Options_RunDLL +! FUNCTION: Options_RunDLLA +! FUNCTION: Options_RunDLLW +! FUNCTION: PathCleanupSpec +! FUNCTION: PathGetShortPath +! FUNCTION: PathIsExe +! FUNCTION: PathIsSlowA +! FUNCTION: PathIsSlowW +! FUNCTION: PathMakeUniqueName +! FUNCTION: PathQualify +! FUNCTION: PathResolve +! FUNCTION: PathYetAnotherMakeUniqueName +! FUNCTION: PickIconDlg +! FUNCTION: PifMgr_CloseProperties +! FUNCTION: PifMgr_GetProperties +! FUNCTION: PifMgr_OpenProperties +! FUNCTION: PifMgr_SetProperties +! FUNCTION: PrepareDiscForBurnRunDllW +! FUNCTION: PrintersGetCommand_RunDLL +! FUNCTION: PrintersGetCommand_RunDLLA +! FUNCTION: PrintersGetCommand_RunDLLW +! FUNCTION: ReadCabinetState +! FUNCTION: RealDriveType +! FUNCTION: RealShellExecuteA +! FUNCTION: RealShellExecuteExA +! FUNCTION: RealShellExecuteExW +! FUNCTION: RealShellExecuteW +! FUNCTION: RegenerateUserEnvironment +! FUNCTION: RestartDialog +! FUNCTION: RestartDialogEx +! FUNCTION: RunAsNewUser_RunDLLW +! FUNCTION: SetCurrentProcessExplicitAppUserModelID +! FUNCTION: SHAddDefaultPropertiesByExt +! FUNCTION: SHAddFromPropSheetExtArray +! FUNCTION: SHAddToRecentDocs +! FUNCTION: SHAlloc +! FUNCTION: SHAppBarMessage +! FUNCTION: SHAssocEnumHandlers +! FUNCTION: SHAssocEnumHandlersForProtocolByApplication +! FUNCTION: SHBindToFolderIDListParent +! FUNCTION: SHBindToFolderIDListParentEx +! FUNCTION: SHBindToObject +! FUNCTION: SHBrowseForFolder +! FUNCTION: SHBrowseForFolderA +! FUNCTION: SHBrowseForFolderW +! FUNCTION: SHChangeNotification_Lock +! FUNCTION: SHChangeNotification_Unlock +! FUNCTION: SHChangeNotify +! FUNCTION: SHChangeNotifyDeregister +! FUNCTION: SHChangeNotifyRegister +! FUNCTION: SHChangeNotifyRegisterThread +! FUNCTION: SHChangeNotifySuspendResume +! FUNCTION: SHCloneSpecialIDList +! FUNCTION: SHCLSIDFromString +! FUNCTION: SHCoCreateInstance +! FUNCTION: SHCoCreateInstanceWorker +! FUNCTION: SHCreateAssociationRegistration +! FUNCTION: SHCreateCategoryEnum +! FUNCTION: SHCreateDataObject +! FUNCTION: SHCreateDefaultContextMenu +! FUNCTION: SHCreateDefaultExtractIcon +! FUNCTION: SHCreateDefaultPropertiesOp +! FUNCTION: SHCreateDirectory +! FUNCTION: SHCreateDirectoryExA +! FUNCTION: SHCreateDirectoryExW +! FUNCTION: SHCreateDrvExtIcon +! FUNCTION: SHCreateFileExtractIconW +! FUNCTION: SHCreateItemFromIDList +! FUNCTION: SHCreateItemFromParsingName +! FUNCTION: SHCreateItemFromRelativeName +! FUNCTION: SHCreateItemInKnownFolder +! FUNCTION: SHCreateItemWithParent +! FUNCTION: SHCreateLocalServerRunDll +! FUNCTION: SHCreateProcessAsUserW +! FUNCTION: SHCreatePropSheetExtArray +! FUNCTION: SHCreateQueryCancelAutoPlayMoniker +! FUNCTION: SHCreateShellFolderView +! FUNCTION: SHCreateShellFolderViewEx +! FUNCTION: SHCreateShellItem +! FUNCTION: SHCreateShellItemArray +! FUNCTION: SHCreateShellItemArrayFromDataObject +! FUNCTION: SHCreateShellItemArrayFromIDLists +! FUNCTION: SHCreateShellItemArrayFromShellItem +! FUNCTION: SHCreateStdEnumFmtEtc +! FUNCTION: SHDefExtractIconA +! FUNCTION: SHDefExtractIconW +! FUNCTION: SHDestroyPropSheetExtArray +! FUNCTION: SHDoDragDrop +! FUNCTION: SheChangeDirA +! FUNCTION: SheChangeDirExW +! FUNCTION: SheGetDirA +! FUNCTION: SHELL32_AddToBackIconTable +! FUNCTION: SHELL32_AddToFrontIconTable +! FUNCTION: SHELL32_AreAllItemsAvailable +! FUNCTION: SHELL32_BindToFilePlaceholderHandler +! FUNCTION: SHELL32_CallFileCopyHooks +! FUNCTION: SHELL32_CanDisplayWin8CopyDialog +! FUNCTION: SHELL32_CCommonPlacesFolder_CreateInstance +! FUNCTION: SHELL32_CDBurn_CloseSession +! FUNCTION: SHELL32_CDBurn_DriveSupportedForDataBurn +! FUNCTION: SHELL32_CDBurn_Erase +! FUNCTION: SHELL32_CDBurn_GetCDInfo +! FUNCTION: SHELL32_CDBurn_GetLiveFSDiscInfo +! FUNCTION: SHELL32_CDBurn_GetStagingPathOrNormalPath +! FUNCTION: SHELL32_CDBurn_GetTaskInfo +! FUNCTION: SHELL32_CDBurn_IsBlankDisc +! FUNCTION: SHELL32_CDBurn_IsBlankDisc2 +! FUNCTION: SHELL32_CDBurn_IsLiveFS +! FUNCTION: SHELL32_CDBurn_OnDeviceChange +! FUNCTION: SHELL32_CDBurn_OnEject +! FUNCTION: SHELL32_CDBurn_OnMediaChange +! FUNCTION: SHELL32_CDefFolderMenu_Create2 +! FUNCTION: SHELL32_CDefFolderMenu_Create2Ex +! FUNCTION: SHELL32_CDefFolderMenu_MergeMenu +! FUNCTION: SHELL32_CDrives_CreateSFVCB +! FUNCTION: SHELL32_CDrivesContextMenu_Create +! FUNCTION: SHELL32_CDrivesDropTarget_Create +! FUNCTION: SHELL32_CFillPropertiesTask_CreateInstance +! FUNCTION: SHELL32_CFSDropTarget_CreateInstance +! FUNCTION: SHELL32_CFSFolderCallback_Create +! FUNCTION: SHELL32_CLibraryDropTarget_CreateInstance +! FUNCTION: SHELL32_CLocationContextMenu_Create +! FUNCTION: SHELL32_CLocationFolderUI_CreateInstance +! FUNCTION: SHELL32_CloseAutoplayPrompt +! FUNCTION: SHELL32_CMountPoint_DoAutorun +! FUNCTION: SHELL32_CMountPoint_DoAutorunPrompt +! FUNCTION: SHELL32_CMountPoint_IsAutoRunDriveAndEnabledByPolicy +! FUNCTION: SHELL32_CMountPoint_ProcessAutoRunFile +! FUNCTION: SHELL32_CMountPoint_WantAutorunUI +! FUNCTION: SHELL32_CMountPoint_WantAutorunUIGetReady +! FUNCTION: SHELL32_CommandLineFromMsiDescriptor +! FUNCTION: SHELL32_CopyFilePlaceholderToNewFile +! FUNCTION: SHELL32_CopySecondaryTiles +! FUNCTION: SHELL32_CPL_CategoryIdArrayFromVariant +! FUNCTION: SHELL32_CPL_IsLegacyCanonicalNameListedUnderKey +! FUNCTION: SHELL32_CPL_ModifyWowDisplayName +! FUNCTION: SHELL32_Create_IEnumUICommand +! FUNCTION: SHELL32_CreateConfirmationInterrupt +! FUNCTION: SHELL32_CreateConflictInterrupt +! FUNCTION: SHELL32_CreateDefaultOperationDataProvider +! FUNCTION: SHELL32_CreateFileFolderContextMenu +! FUNCTION: SHELL32_CreateLinkInfoW +! FUNCTION: SHELL32_CreatePlaceholderFile +! FUNCTION: SHELL32_CreateQosRecorder +! FUNCTION: SHELL32_CreateSharePointView +! FUNCTION: SHELL32_CRecentDocsContextMenu_CreateInstance +! FUNCTION: SHELL32_CSyncRootManager_CreateInstance +! FUNCTION: SHELL32_CTransferConfirmation_CreateInstance +! FUNCTION: SHELL32_DestroyLinkInfo +! FUNCTION: SHELL32_EncryptDirectory +! FUNCTION: SHELL32_EncryptedFileKeyInfo +! FUNCTION: SHELL32_EnumCommonTasks +! FUNCTION: SHELL32_FilePlaceholder_BindToPrimaryStream +! FUNCTION: SHELL32_FilePlaceholder_CreateInstance +! FUNCTION: SHELL32_FreeEncryptedFileKeyInfo +! FUNCTION: SHELL32_GenerateAppID +! FUNCTION: SHELL32_GetAppIDRoot +! FUNCTION: SHELL32_GetCommandProviderForFolderType +! FUNCTION: SHELL32_GetDiskCleanupPath +! FUNCTION: SHELL32_GetDPIAdjustedLogicalSize +! FUNCTION: SHELL32_GetFileNameFromBrowse +! FUNCTION: SHELL32_GetIconOverlayManager +! FUNCTION: SHELL32_GetLinkInfoData +! FUNCTION: SHELL32_GetPlaceholderStatesFromFileAttributesAndReparsePointTag +! FUNCTION: SHELL32_GetRatingBucket +! FUNCTION: SHELL32_GetSkyDriveNetworkStates +! FUNCTION: SHELL32_GetSqmableFileName +! FUNCTION: SHELL32_GetThumbnailAdornerFromFactory +! FUNCTION: SHELL32_GetThumbnailAdornerFromFactory2 +! FUNCTION: SHELL32_HandleUnrecognizedFileSystem +! FUNCTION: SHELL32_IconCache_AboutToExtractIcons +! FUNCTION: SHELL32_IconCache_DoneExtractingIcons +! FUNCTION: SHELL32_IconCache_ExpandEnvAndSearchPath +! FUNCTION: SHELL32_IconCache_RememberRecentlyExtractedIconsW +! FUNCTION: SHELL32_IconCacheCreate +! FUNCTION: SHELL32_IconCacheDestroy +! FUNCTION: SHELL32_IconCacheHandleAssociationChanged +! FUNCTION: SHELL32_IconCacheRestore +! FUNCTION: SHELL32_IconOverlayManagerInit +! FUNCTION: SHELL32_IsGetKeyboardLayoutPresent +! FUNCTION: SHELL32_IsSystemUpgradeInProgress +! FUNCTION: SHELL32_IsValidLinkInfo +! FUNCTION: SHELL32_LegacyEnumSpecialTasksByType +! FUNCTION: SHELL32_LegacyEnumTasks +! FUNCTION: SHELL32_LookupBackIconIndex +! FUNCTION: SHELL32_LookupFrontIconIndex +! FUNCTION: SHELL32_NormalizeRating +! FUNCTION: SHELL32_NotifyLinkTrackingServiceOfMove +! FUNCTION: SHELL32_PifMgr_CloseProperties +! FUNCTION: SHELL32_PifMgr_GetProperties +! FUNCTION: SHELL32_PifMgr_OpenProperties +! FUNCTION: SHELL32_PifMgr_SetProperties +! FUNCTION: SHELL32_Printers_CreateBindInfo +! FUNCTION: SHELL32_Printjob_GetPidl +! FUNCTION: SHELL32_PurgeSystemIcon +! FUNCTION: SHELL32_RefreshOverlayImages +! FUNCTION: SHELL32_ResolveLinkInfoW +! FUNCTION: SHELL32_SendToMenu_InvokeTargetedCommand +! FUNCTION: SHELL32_SendToMenu_VerifyTargetedCommand +! FUNCTION: SHELL32_SetPlaceholderReparsePointAttribute +! FUNCTION: SHELL32_SetPlaceholderReparsePointAttribute2 +! FUNCTION: SHELL32_SHAddSparseIcon +! FUNCTION: SHELL32_SHCreateByValueOperationInterrupt +! FUNCTION: SHELL32_SHCreateDefaultContextMenu +! FUNCTION: SHELL32_SHCreateLocalServer +! FUNCTION: SHELL32_SHCreateShellFolderView +! FUNCTION: SHELL32_SHDuplicateEncryptionInfoFile +! FUNCTION: SHELL32_SHEncryptFile +! FUNCTION: SHELL32_SHFormatDriveAsync +! FUNCTION: SHELL32_SHGetThreadUndoManager +! FUNCTION: SHELL32_SHGetUserNameW +! FUNCTION: SHELL32_SHIsVirtualDevice +! FUNCTION: SHELL32_SHLaunchPropSheet +! FUNCTION: SHELL32_SHLogILFromFSIL +! FUNCTION: SHELL32_SHOpenWithDialog +! FUNCTION: SHELL32_ShowHideIconOnlyOnDesktop +! FUNCTION: SHELL32_SHStartNetConnectionDialogW +! FUNCTION: SHELL32_SHUICommandFromGUID +! FUNCTION: SHELL32_SimpleRatingToFilterCondition +! FUNCTION: SHELL32_StampIconForFile +! FUNCTION: SHELL32_SuspendUndo +! FUNCTION: SHELL32_TryVirtualDiscImageDriveEject +! FUNCTION: SHELL32_UpdateFilePlaceholderStates +! FUNCTION: SHELL32_VerifySaferTrust +! FUNCTION: Shell_GetCachedImageIndex +! FUNCTION: Shell_GetCachedImageIndexA +! FUNCTION: Shell_GetCachedImageIndexW +! FUNCTION: Shell_GetImageLists +! FUNCTION: Shell_MergeMenus +! FUNCTION: Shell_NotifyIconA +! FUNCTION: Shell_NotifyIconGetRect +! FUNCTION: Shell_NotifyIconW +! FUNCTION: ShellAboutA +! FUNCTION: ShellAboutW +! FUNCTION: ShellExec_RunDLL +! FUNCTION: ShellExec_RunDLLA +! FUNCTION: ShellExec_RunDLLW +! FUNCTION: ShellExecuteA +! FUNCTION: ShellExecuteEx +! FUNCTION: ShellExecuteExA +! FUNCTION: ShellExecuteExW +! FUNCTION: ShellHookProc +! FUNCTION: ShellMessageBoxA +! FUNCTION: ShellMessageBoxW +! FUNCTION: SHEmptyRecycleBinA +! FUNCTION: SHEmptyRecycleBinW +! FUNCTION: SHEnableServiceObject +! FUNCTION: SHEnumerateUnreadMailAccountsW +! FUNCTION: SheSetCurDrive +! FUNCTION: SHEvaluateSystemCommandTemplate +! FUNCTION: SHExtractIconsW +! FUNCTION: SHFileOperation +! FUNCTION: SHFileOperationA +! FUNCTION: SHFileOperationW +! FUNCTION: SHFind_InitMenuPopup +! FUNCTION: SHFindFiles +! FUNCTION: SHFlushSFCache +! FUNCTION: SHFormatDrive +! FUNCTION: SHFree +! FUNCTION: SHFreeNameMappings +! FUNCTION: SHGetAttributesFromDataObject +! FUNCTION: SHGetDataFromIDListA +! FUNCTION: SHGetDataFromIDListW +! FUNCTION: SHGetDiskFreeSpaceA +! FUNCTION: SHGetDiskFreeSpaceExA +! FUNCTION: SHGetDiskFreeSpaceExW +! FUNCTION: SHGetDriveMedia +! FUNCTION: SHGetFileInfo +! FUNCTION: SHGetFileInfoA +! FUNCTION: SHGetFolderLocation +! FUNCTION: SHGetFolderPathA +! FUNCTION: SHGetFolderPathAndSubDirA +! FUNCTION: SHGetFolderPathAndSubDirW +! FUNCTION: SHGetFolderPathEx +! FUNCTION: SHGetIconOverlayIndexA +! FUNCTION: SHGetIconOverlayIndexW +! FUNCTION: SHGetIDListFromObject +! FUNCTION: SHGetImageList +! FUNCTION: SHGetInstanceExplorer +! FUNCTION: SHGetItemFromDataObject +! FUNCTION: SHGetItemFromObject +! FUNCTION: SHGetKnownFolderIDList +! FUNCTION: SHGetKnownFolderItem +! FUNCTION: SHGetKnownFolderPath +! FUNCTION: SHGetLocalizedName +! FUNCTION: SHGetMalloc +! FUNCTION: SHGetNameFromIDList +! FUNCTION: SHGetNewLinkInfo +! FUNCTION: SHGetNewLinkInfoA +! FUNCTION: SHGetNewLinkInfoW +! FUNCTION: SHGetPathFromIDList +! FUNCTION: SHGetPathFromIDListA +! FUNCTION: SHGetPathFromIDListEx +! FUNCTION: SHGetPathFromIDListW +! FUNCTION: SHGetPropertyStoreForWindow +! FUNCTION: SHGetPropertyStoreFromIDList +! FUNCTION: SHGetPropertyStoreFromParsingName +! FUNCTION: SHGetRealIDL +! FUNCTION: SHGetSetFolderCustomSettings +! FUNCTION: SHGetSetSettings +! FUNCTION: SHGetSettings +! FUNCTION: SHGetSpecialFolderLocation +! FUNCTION: SHGetSpecialFolderPathA +! FUNCTION: SHGetSpecialFolderPathW +! FUNCTION: SHGetStockIconInfo +! FUNCTION: SHGetTemporaryPropertyForItem +! FUNCTION: SHGetUnreadMailCountW +! FUNCTION: SHHandleUpdateImage +! FUNCTION: SHHelpShortcuts_RunDLL +! FUNCTION: SHHelpShortcuts_RunDLLA +! FUNCTION: SHHelpShortcuts_RunDLLW +! FUNCTION: SHILCreateFromPath +! FUNCTION: SHInvokePrinterCommandA +! FUNCTION: SHInvokePrinterCommandW +! FUNCTION: SHIsFileAvailableOffline +! FUNCTION: SHLimitInputEdit +! FUNCTION: SHLoadInProc +! FUNCTION: SHLoadNonloadedIconOverlayIdentifiers +! FUNCTION: SHMapPIDLToSystemImageListIndex +! FUNCTION: SHMultiFileProperties +! FUNCTION: SHObjectProperties +! FUNCTION: SHOpenFolderAndSelectItems +! FUNCTION: SHOpenPropSheetW +! FUNCTION: SHOpenWithDialog +! FUNCTION: SHParseDisplayName +! FUNCTION: SHPathPrepareForWriteA +! FUNCTION: SHPathPrepareForWriteW +! FUNCTION: SHPropStgCreate +! FUNCTION: SHPropStgReadMultiple +! FUNCTION: SHPropStgWriteMultiple +! FUNCTION: SHQueryRecycleBinA +! FUNCTION: SHQueryRecycleBinW +! FUNCTION: SHQueryUserNotificationState +! FUNCTION: SHRemoveLocalizedName +! FUNCTION: SHReplaceFromPropSheetExtArray +! FUNCTION: SHResolveLibrary +! FUNCTION: SHRestricted +! FUNCTION: SHSetDefaultProperties +! FUNCTION: SHSetFolderPathA +! FUNCTION: SHSetFolderPathW +! FUNCTION: SHSetInstanceExplorer +! FUNCTION: SHSetKnownFolderPath +! FUNCTION: SHSetLocalizedName +! FUNCTION: SHSetTemporaryPropertyForItem +! FUNCTION: SHSetUnreadMailCountW +! FUNCTION: SHShellFolderView_Message +! FUNCTION: SHShowManageLibraryUI +! FUNCTION: SHSimpleIDListFromPath +! FUNCTION: SHStartNetConnectionDialogW +! FUNCTION: SHTestTokenMembership +! FUNCTION: SHUpdateImageA +! FUNCTION: SHUpdateImageW +! FUNCTION: SHUpdateRecycleBinIcon +! FUNCTION: SHValidateUNC +! FUNCTION: SignalFileOpen +! FUNCTION: StgMakeUniqueName +! FUNCTION: StrChrA +! FUNCTION: StrChrIA +! FUNCTION: StrChrIW +! FUNCTION: StrChrW +! FUNCTION: StrCmpNA +! FUNCTION: StrCmpNIA +! FUNCTION: StrCmpNIW +! FUNCTION: StrCmpNW +! FUNCTION: StrNCmpA +! FUNCTION: StrNCmpIA +! FUNCTION: StrNCmpIW +! FUNCTION: StrNCmpW +! FUNCTION: StrRChrA +! FUNCTION: StrRChrIA +! FUNCTION: StrRChrIW +! FUNCTION: StrRChrW +! FUNCTION: StrRStrA +! FUNCTION: StrRStrIA +! FUNCTION: StrRStrIW +! FUNCTION: StrRStrW +! FUNCTION: StrStrA +! FUNCTION: StrStrIA +! FUNCTION: StrStrIW +! FUNCTION: StrStrW +! FUNCTION: UsersLibrariesFolderUI_CreateInstance +! FUNCTION: WaitForExplorerRestartW +! FUNCTION: Win32DeleteFile +! FUNCTION: WOWShellExecute +! FUNCTION: WriteCabinetState diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index fe1844802c..d961e8de85 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -183,11 +183,11 @@ CONSTANT: CF_LOCALE 16 CONSTANT: CF_DIBV5 17 CONSTANT: CF_MAX 18 -CONSTANT: CF_OWNERDISPLAY 0x0080 -CONSTANT: CF_DSPTEXT 0x0081 -CONSTANT: CF_DSPBITMAP 0x0082 -CONSTANT: CF_DSPMETAFILEPICT 0x0083 -CONSTANT: CF_DSPENHMETAFILE 0x008E +CONSTANT: CF_OWNERDISPLAY 0x0080 +CONSTANT: CF_DSPTEXT 0x0081 +CONSTANT: CF_DSPBITMAP 0x0082 +CONSTANT: CF_DSPMETAFILEPICT 0x0083 +CONSTANT: CF_DSPENHMETAFILE 0x008E ! "Private" formats don't get GlobalFree()'d CONSTANT: CF_PRIVATEFIRST 0x200 From 4df7773a58e58cc99c2a5a86b713cb4e97e440d5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 Mar 2019 10:00:07 -0500 Subject: [PATCH 11/69] io.files.windows: Reloading io.pathnames overwrites these two object methods. Make them windows methods instead. --- basis/io/files/windows/windows.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 2ed1926cdb..684d8f13d7 100644 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -346,9 +346,9 @@ PRIVATE> M: windows canonicalize-path remove-unicode-prefix canonicalize-path* ; -M: object root-path remove-unicode-prefix root-path* ; +M: windows root-path remove-unicode-prefix root-path* ; -M: object relative-path remove-unicode-prefix relative-path* ; +M: windows relative-path remove-unicode-prefix relative-path* ; M: windows normalize-path ( string -- string' ) dup unc-path? [ From a3d5e3ffcb8ff60ec16c3bf8cadda4aa02300609 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 17 Mar 2019 09:24:16 -0700 Subject: [PATCH 12/69] crontab: instead of after= make it after. --- extra/crontab/crontab.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 50c9e06951..addedb7e29 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -55,9 +55,7 @@ CONSTANT: aliases H{ :: next-time-after ( cronentry timestamp -- ) - timestamp second>> 0 > [ - timestamp 0 >>second 1 minutes (time+) 2drop - ] when + timestamp 0 >>second 1 minutes (time+) 2drop timestamp month>> :> month cronentry months>> [ month >= ] find nip [ From 2136abc1d64705805c5274337a799077f4b317e4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 17 Mar 2019 09:52:53 -0700 Subject: [PATCH 13/69] regexp: fix take-until to handle escapes at the end of a regexp. this worked: R\ //.\ this didn't: R\ //\ --- basis/regexp/regexp.factor | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 19d2d8710b..c31571c718 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -200,10 +200,11 @@ PRIVATE> : take-until ( lexer -- string ) dup skip-blank [ dupd [ - [ CHAR: / -rot index-from ] keep - over [ "Unterminated regexp" throw ] unless - 2dup [ 1 - ] dip nth CHAR: \\ = - [ [ [ 1 + ] dip ] when ] keep + [ [ "\\/" member? ] find-from ] keep swap [ + CHAR: \ = [ [ 2 + ] dip t ] [ f ] if + ] [ + "Unterminated regexp" throw + ] if* ] loop over [ subseq ] dip 1 + ] change-lexer-column ; From f4d17d3ba394c4bac21ad800c2d5d05fb443d5ad Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 Mar 2019 12:12:04 -0500 Subject: [PATCH 14/69] io.sockets: Allow f in the port of an inet4. Fixes #2019. --- basis/io/sockets/sockets.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index bd006ca2ab..cfeed9ab03 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -107,7 +107,7 @@ M: ipv4 empty-sockaddr drop sockaddr-in ; sockaddr-in AF_INET >>family swap - port>> htons >>port ; inline + port>> 0 or htons >>port ; inline M: ipv4 make-sockaddr ( inet -- sockaddr ) [ make-sockaddr-part ] @@ -122,7 +122,7 @@ M: ipv4 make-sockaddr-outgoing ( inet -- sockaddr ) M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec ) [ addr>> uint ] dip inet-ntop ; -TUPLE: inet4 < ipv4 { port integer read-only } ; +TUPLE: inet4 < ipv4 { port maybe{ integer } read-only } ; : ( host port -- inet4 ) over check-ipv4 inet4 boa ; From d59292faf68094dbc219aeb7ff63947423c21fe6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 Mar 2019 12:23:34 -0500 Subject: [PATCH 15/69] io.sockets: fix for inet6 too. "::1" 0 utf8 "::1" f utf8 Fixes #2109 --- basis/io/sockets/sockets.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index cfeed9ab03..a6ef8984b5 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -179,7 +179,7 @@ M: ipv6 empty-sockaddr drop sockaddr-in6 ; sockaddr-in6 AF_INET6 >>family swap - port>> htons >>port ; inline + port>> 0 or htons >>port ; inline M: ipv6 make-sockaddr ( inet -- sockaddr ) [ make-sockaddr-in6-part ] @@ -201,7 +201,7 @@ M: ipv6 present [ host>> ] [ scope-id>> ] bi [ number>string "%" glue ] unless-zero ; -TUPLE: inet6 < ipv6 { port integer read-only } ; +TUPLE: inet6 < ipv6 { port maybe{ integer } read-only } ; : ( host port -- inet6 ) [ dup check-ipv6 0 ] dip inet6 boa ; From 9f0bce762259878c63d15ef171c17931276c066e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 17 Mar 2019 13:12:41 -0700 Subject: [PATCH 16/69] regexp: slightly more complicated tokenization to handle another case. R/ [^/]/ R/ (/|abc)/ --- basis/regexp/regexp.factor | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index c31571c718..14310ddc30 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -197,11 +197,27 @@ PRIVATE> tokens + col line [ + [ [ tokens member? ] find-from ] keep swap [ + CHAR: \ = [ [ 2 + ] dip t ] [ [ 1 + ] dip f ] if + ] [ + "Unterminated regexp" throw + ] if* + ] loop ; + +:: take-until ( lexer -- string ) + lexer skip-blank + lexer [ dupd [ - [ [ "\\/" member? ] find-from ] keep swap [ - CHAR: \ = [ [ 2 + ] dip t ] [ f ] if + [ [ "[(\\/" member? ] find-from ] keep swap [ + { + { CHAR: [ [ CHAR: ] (take-until) t ] } + { CHAR: ( [ CHAR: ) (take-until) t ] } + { CHAR: \ [ [ 2 + ] dip t ] } + { CHAR: / [ f ] } + } case ] [ "Unterminated regexp" throw ] if* From 31f309a829160c52854cefeb86a0b6a85937b2e8 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 17 Mar 2019 13:13:27 -0700 Subject: [PATCH 17/69] globs: simpler separator regexp. --- basis/globs/globs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index 3a540e2b23..0cb9694910 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -7,10 +7,10 @@ unicode multiline ; IN: globs : not-path-separator ( -- sep ) - os windows? R/ [^\\/\\]/ R/ [^\\/]/ ? ; foldable + os windows? R/ [^\\/]/ R/ [^/]/ ? ; foldable : wild-path-separator ( -- sep ) - os windows? R/ [^\\/\\][\\/\\]|[^\\/\\]/ R/ [^\\/][\\/]|[^\\/]/ ? ; foldable + os windows? R/ [^\\/][\\/]|[^\\/]/ R/ [^/][/]|[^/]/ ? ; foldable EBNF: [=[ From 1ab1ef7f6836d5d6a3459343a3cbeaa7b4d37cd2 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 18 Mar 2019 10:42:23 -0700 Subject: [PATCH 18/69] Revert "globs: simpler separator regexp." This reverts commit 31f309a829160c52854cefeb86a0b6a85937b2e8. --- basis/globs/globs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index 0cb9694910..3a540e2b23 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -7,10 +7,10 @@ unicode multiline ; IN: globs : not-path-separator ( -- sep ) - os windows? R/ [^\\/]/ R/ [^/]/ ? ; foldable + os windows? R/ [^\\/\\]/ R/ [^\\/]/ ? ; foldable : wild-path-separator ( -- sep ) - os windows? R/ [^\\/][\\/]|[^\\/]/ R/ [^/][/]|[^/]/ ? ; foldable + os windows? R/ [^\\/\\][\\/\\]|[^\\/\\]/ R/ [^\\/][\\/]|[^\\/]/ ? ; foldable EBNF: [=[ From 633955836805f0ac6dac1f67f1aab269f0602ffc Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 18 Mar 2019 10:42:29 -0700 Subject: [PATCH 19/69] Revert "regexp: slightly more complicated tokenization to handle another case." This reverts commit 9f0bce762259878c63d15ef171c17931276c066e. --- basis/regexp/regexp.factor | 24 ++++-------------------- 1 file changed, 4 insertions(+), 20 deletions(-) diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 14310ddc30..c31571c718 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -197,27 +197,11 @@ PRIVATE> tokens - col line [ - [ [ tokens member? ] find-from ] keep swap [ - CHAR: \ = [ [ 2 + ] dip t ] [ [ 1 + ] dip f ] if - ] [ - "Unterminated regexp" throw - ] if* - ] loop ; - -:: take-until ( lexer -- string ) - lexer skip-blank - lexer [ +: take-until ( lexer -- string ) + dup skip-blank [ dupd [ - [ [ "[(\\/" member? ] find-from ] keep swap [ - { - { CHAR: [ [ CHAR: ] (take-until) t ] } - { CHAR: ( [ CHAR: ) (take-until) t ] } - { CHAR: \ [ [ 2 + ] dip t ] } - { CHAR: / [ f ] } - } case + [ [ "\\/" member? ] find-from ] keep swap [ + CHAR: \ = [ [ 2 + ] dip t ] [ f ] if ] [ "Unterminated regexp" throw ] if* From b3bcf537cc360d0ba892391e48b50c704ec6b101 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 18 Mar 2019 10:42:40 -0700 Subject: [PATCH 20/69] Revert "regexp: fix take-until to handle escapes at the end of a regexp." This reverts commit 2136abc1d64705805c5274337a799077f4b317e4. --- basis/regexp/regexp.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index c31571c718..19d2d8710b 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -200,11 +200,10 @@ PRIVATE> : take-until ( lexer -- string ) dup skip-blank [ dupd [ - [ [ "\\/" member? ] find-from ] keep swap [ - CHAR: \ = [ [ 2 + ] dip t ] [ f ] if - ] [ - "Unterminated regexp" throw - ] if* + [ CHAR: / -rot index-from ] keep + over [ "Unterminated regexp" throw ] unless + 2dup [ 1 - ] dip nth CHAR: \\ = + [ [ [ 1 + ] dip ] when ] keep ] loop over [ subseq ] dip 1 + ] change-lexer-column ; From ca9f74e9935a585422d90025b8c40a422694880f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 10:55:22 -0700 Subject: [PATCH 21/69] Revert "crontab: instead of after= make it after." This reverts commit a3d5e3ffcb8ff60ec16c3bf8cadda4aa02300609. --- extra/crontab/crontab.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index addedb7e29..50c9e06951 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -55,7 +55,9 @@ CONSTANT: aliases H{ :: next-time-after ( cronentry timestamp -- ) - timestamp 0 >>second 1 minutes (time+) 2drop + timestamp second>> 0 > [ + timestamp 0 >>second 1 minutes (time+) 2drop + ] when timestamp month>> :> month cronentry months>> [ month >= ] find nip [ From 26abdf4a23def8a62513d60d96dade8554ef9c0e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 13:29:15 -0700 Subject: [PATCH 22/69] regexp: try again to fix the issue with backslashes. the new simple rule is inside R/ syntax all backslashes should be escaped to allow easy regexp literal tokenization: R/ [\/]/ but in the constructor they shouldn't be: "[/]" When the regexp is prettyprinted we make sure to visually escape the backslashes in the raw regexp. --- basis/globs/globs.factor | 4 ++-- basis/regexp/parser/parser.factor | 14 ++++++++------ basis/regexp/prettyprint/prettyprint.factor | 2 +- basis/regexp/regexp-tests.factor | 7 +++++++ basis/regexp/regexp.factor | 9 +++++---- basis/validators/validators.factor | 2 +- extra/metar/metar.factor | 16 ++++++++-------- extra/xkcd/xkcd.factor | 2 +- 8 files changed, 33 insertions(+), 23 deletions(-) diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index 3a540e2b23..e2bbb99aee 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -7,10 +7,10 @@ unicode multiline ; IN: globs : not-path-separator ( -- sep ) - os windows? R/ [^\\/\\]/ R/ [^\\/]/ ? ; foldable + os windows? R/ [^\/\\]/ R/ [^\/]/ ? ; foldable : wild-path-separator ( -- sep ) - os windows? R/ [^\\/\\][\\/\\]|[^\\/\\]/ R/ [^\\/][\\/]|[^\\/]/ ? ; foldable + os windows? R/ [^\/\\][\/\\]|[^\/\\]/ R/ [^\/][\/]|[^\/]/ ? ; foldable EBNF: [=[ diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 931843542c..f28aa61c39 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -3,7 +3,8 @@ USING: accessors arrays assocs combinators combinators.short-circuit interval-maps kernel locals math.parser memoize multiline peg.ebnf regexp.ast regexp.classes -sequences sets splitting strings unicode unicode.data unicode.script ; +sequences sets splitting strings unicode unicode.data +unicode.script ; IN: regexp.parser : allowed-char? ( ch -- ? ) @@ -70,13 +71,14 @@ MEMO: simple-category-table ( -- table ) : lookup-escape ( char -- ast ) { - { CHAR: t [ CHAR: \t ] } + { CHAR: a [ CHAR: \a ] } + { CHAR: e [ CHAR: \e ] } + { CHAR: f [ CHAR: \f ] } { CHAR: n [ CHAR: \n ] } { CHAR: r [ CHAR: \r ] } - { CHAR: f [ 0xc ] } - { CHAR: a [ 0x7 ] } - { CHAR: e [ 0x1b ] } - { CHAR: \\ [ CHAR: \\ ] } + { CHAR: t [ CHAR: \t ] } + { CHAR: v [ CHAR: \v ] } + { CHAR: 0 [ CHAR: \0 ] } { CHAR: w [ c-identifier-class ] } { CHAR: W [ c-identifier-class ] } diff --git a/basis/regexp/prettyprint/prettyprint.factor b/basis/regexp/prettyprint/prettyprint.factor index 372ef69062..ae3877c7d7 100644 --- a/basis/regexp/prettyprint/prettyprint.factor +++ b/basis/regexp/prettyprint/prettyprint.factor @@ -7,7 +7,7 @@ IN: regexp.prettyprint M: regexp pprint* [ [ - [ raw>> "\\/" "\\\\/" replace "R/ " % % "/" % ] + [ raw>> "/" "\\/" replace "R/ " % % "/" % ] [ options>> options>string % ] bi ] "" make ] keep present-text ; diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 30ec30a6d9..36e877a03f 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -49,6 +49,9 @@ IN: regexp.tests { t } [ "a" ".+" matches? ] unit-test { t } [ "ab" ".+" matches? ] unit-test +{ t } [ "\0" "[\\0]" matches? ] unit-test +{ f } [ "0" "[\\0]" matches? ] unit-test + { t } [ " " "[\\s]" matches? ] unit-test { f } [ "a" "[\\s]" matches? ] unit-test { f } [ " " "[\\S]" matches? ] unit-test @@ -335,6 +338,10 @@ unit-test { "XhXXlXlXoX XwXoXrXlXdX" } [ "hello world" R/ e*/ "X" re-replace ] unit-test { "-- title --" } [ "== title ==" R/ =/ "-" re-replace ] unit-test +{ "abc" } [ "a/ \\bc" "/.*\\" "" re-replace ] unit-test +{ "ac" } [ "a/ \\bc" R/ \/.*\\./ "" re-replace ] unit-test +{ "abc" } [ "a/ \\bc" R/ \/.*\\/ "" re-replace ] unit-test + { "" } [ "ab" "a(?!b)" first-match >string ] unit-test { "a" } [ "ac" "a(?!b)" first-match >string ] unit-test { t } [ "fxxbar" ".{3}(?!foo)bar" matches? ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 19d2d8710b..c31571c718 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -200,10 +200,11 @@ PRIVATE> : take-until ( lexer -- string ) dup skip-blank [ dupd [ - [ CHAR: / -rot index-from ] keep - over [ "Unterminated regexp" throw ] unless - 2dup [ 1 - ] dip nth CHAR: \\ = - [ [ [ 1 + ] dip ] when ] keep + [ [ "\\/" member? ] find-from ] keep swap [ + CHAR: \ = [ [ 2 + ] dip t ] [ f ] if + ] [ + "Unterminated regexp" throw + ] if* ] loop over [ subseq ] dip 1 + ] change-lexer-column ; diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index c3b800ae57..cb3d2eca31 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -65,7 +65,7 @@ IN: validators v-regexp ; : v-url ( str -- str ) - "URL" R/ (?:ftp|http|https):\\/\\/\S+/ v-regexp ; + "URL" R/ (?:ftp|http|https):\/\/\S+/ v-regexp ; : v-captcha ( str -- str ) dup empty? [ "must remain blank" throw ] unless ; diff --git a/extra/metar/metar.factor b/extra/metar/metar.factor index e4a98b8e99..f01f538744 100644 --- a/extra/metar/metar.factor +++ b/extra/metar/metar.factor @@ -283,11 +283,11 @@ CONSTANT: sky H{ CONSTANT: re-timestamp R/ \d{6}Z/ CONSTANT: re-station R/ \w{4}/ -CONSTANT: re-temperature R/ [M]?\d{2}\\/([M]?\d{2})?/ +CONSTANT: re-temperature R/ [M]?\d{2}\/([M]?\d{2})?/ CONSTANT: re-wind R/ (VRB|\d{3})\d{2,3}(G\d{2,3})?KT/ CONSTANT: re-wind-variable R/ \d{3}V\d{3}/ -CONSTANT: re-visibility R/ [MP]?\d+(\\/\d+)?SM/ -CONSTANT: re-rvr R/ R\d{2}[RLC]?\\/\d{4}(V\d{4})?FT/ +CONSTANT: re-visibility R/ [MP]?\d+(\/\d+)?SM/ +CONSTANT: re-rvr R/ R\d{2}[RLC]?\/\d{4}(V\d{4})?FT/ CONSTANT: re-weather R/ [+-]?(VC)?(\w{2}|\w{4})/ CONSTANT: re-sky-condition R/ (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)/ CONSTANT: re-altimeter R/ [AQ]\d{4}/ @@ -519,23 +519,23 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/ { [ dup R/ 1\d{4}/ matches? ] [ parse-6hr-max-temp ] } { [ dup R/ 2\d{4}/ matches? ] [ parse-6hr-min-temp ] } { [ dup R/ 4\d{8}/ matches? ] [ parse-24hr-temp ] } - { [ dup R/ 4\\/\d{3}/ matches? ] [ parse-snow-depth ] } + { [ dup R/ 4\/\d{3}/ matches? ] [ parse-snow-depth ] } { [ dup R/ 5\d{4}/ matches? ] [ parse-1hr-pressure ] } - { [ dup R/ 6[\d\\/]{4}/ matches? ] [ parse-6hr-precipitation ] } + { [ dup R/ 6[\d\/]{4}/ matches? ] [ parse-6hr-precipitation ] } { [ dup R/ 7\d{4}/ matches? ] [ parse-24hr-precipitation ] } - { [ dup R/ 8\\/\d{3}/ matches? ] [ parse-cloud-cover ] } + { [ dup R/ 8\/\d{3}/ matches? ] [ parse-cloud-cover ] } { [ dup R/ 931\d{3}/ matches? ] [ parse-6hr-snowfall ] } { [ dup R/ 933\d{3}/ matches? ] [ parse-water-equivalent-snow ] } { [ dup R/ 98\d{3}/ matches? ] [ parse-duration-of-sunshine ] } { [ dup R/ T\d{4,8}/ matches? ] [ parse-1hr-temp ] } - { [ dup R/ \d{3}\d{2,3}\\/\d{2,4}/ matches? ] [ parse-peak-wind ] } + { [ dup R/ \d{3}\d{2,3}\/\d{2,4}/ matches? ] [ parse-peak-wind ] } { [ dup R/ P\d{4}/ matches? ] [ parse-1hr-precipitation ] } { [ dup R/ SLP\d{3}/ matches? ] [ parse-sea-level-pressure ] } { [ dup R/ LTG\w+/ matches? ] [ parse-lightning ] } { [ dup R/ PROB\d+/ matches? ] [ parse-probability ] } { [ dup R/ \d{3}V\d{3}/ matches? ] [ parse-varying ] } { [ dup R/ [^-]+(-[^-]+)+/ matches? ] [ parse-from-to ] } - { [ dup R/ [^\\/]+(\\/[^\\/]+)+/ matches? ] [ ] } + { [ dup R/ [^\/]+(\/[^\/]+)+/ matches? ] [ ] } { [ dup R/ \d+.\d+/ matches? ] [ ] } { [ dup re-recent-weather matches? ] [ parse-recent-weather ] } { [ dup re-weather matches? ] [ parse-weather ] } diff --git a/extra/xkcd/xkcd.factor b/extra/xkcd/xkcd.factor index f9a5f06b69..8b9546f64a 100644 --- a/extra/xkcd/xkcd.factor +++ b/extra/xkcd/xkcd.factor @@ -13,7 +13,7 @@ IN: xkcd : comic-image ( url -- image ) http-get nip - R/ \/\/imgs\.xkcd\.com\\/comics\\/[^\.]+\.(png|jpg)/ + R/ \/\/imgs\.xkcd\.com\/comics\/[^\.]+\.(png|jpg)/ first-match >string "http:" prepend load-http-image ; : comic-image. ( url -- ) From ba09f64b6b144f217e94e52312f2dc0fab94b119 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 21 Mar 2019 18:31:22 -0500 Subject: [PATCH 23/69] travis: Add required packages. ==== FAILING TESTS --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index c4e9048d23..72c09be6c8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -31,6 +31,8 @@ addons: - cmake - libaio-dev - libsnappy-dev + - libgtk2.0-dev + - gtk2-engines-pixbuf before_install: - uname -s - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then ./build.sh deps-macosx ; else ./build.sh deps-apt-get ; fi From 0b794f5a076bad8b2face01eac65dc414cba70b6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 21 Mar 2019 18:38:47 -0500 Subject: [PATCH 24/69] windows.dragdrop-listener: Fix using --- basis/windows/dragdrop-listener/dragdrop-listener.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 67437415b5..39238c61c2 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -7,7 +7,7 @@ math namespaces prettyprint sequences specialized-arrays ui.backend.windows ui.gadgets.worlds ui.gestures ui.tools.listener windows.com windows.com.wrapper windows.dropfiles windows.kernel32 windows.ole32 windows.shell32 -windows.types ; +windows.types windows.user32 ; SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: WCHAR IN: windows.dragdrop-listener From c3cfc177cd4e781acea9fccd7c1136f7ad261738 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 21 Mar 2019 19:41:26 -0500 Subject: [PATCH 25/69] io.directories.search: Fix the order of the depth/breadth traversals. This unit test kind of sucks. --- .../io/directories/search/search-tests.factor | 40 ++----------------- 1 file changed, 4 insertions(+), 36 deletions(-) diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 91831b8a8a..1d8bd99d5f 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -47,42 +47,9 @@ strings tools.test ; [ drop f ] find-up-to-root ] unit-test -[ - { - "/a" - "/a/a" - "/a/a/a" - "/a/b" - "/a/b/a" - "/b" - "/b/a" - "/b/a/a" - "/b/b" - "/b/b/a" - "/c" - "/c/a" - "/c/a/a" - "/c/b" - "/c/b/a" - } - { - "/a" - "/b" - "/c" - "/a/a" - "/a/b" - "/b/a" - "/b/b" - "/c/a" - "/c/b" - "/a/a/a" - "/a/b/a" - "/b/a/a" - "/b/b/a" - "/c/a/a" - "/c/b/a" - } -] [ +{ + t +} [ [ "a" make-directory "a/a" make-directory @@ -120,4 +87,5 @@ strings tools.test ; [ natural-sort ] map concat ] with-variable ] with-test-directory + [ natural-sort ] bi@ sequence= ] unit-test From d6ffd151850f366c9e4c3e12dd1e8091b895cf1f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 21 Mar 2019 19:52:07 -0500 Subject: [PATCH 26/69] libc.freebsd: platforms.txt not platform.txt Fixes linux bootstrap --- basis/libc/freebsd/{platform.txt => platforms.txt} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename basis/libc/freebsd/{platform.txt => platforms.txt} (100%) diff --git a/basis/libc/freebsd/platform.txt b/basis/libc/freebsd/platforms.txt similarity index 100% rename from basis/libc/freebsd/platform.txt rename to basis/libc/freebsd/platforms.txt From 1c44494b32f94582556df51f3fb67101bae78be0 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 19:23:13 -0700 Subject: [PATCH 27/69] Revert "io.directories.search: Fix the order of the depth/breadth traversals." This reverts commit c3cfc177cd4e781acea9fccd7c1136f7ad261738. --- .../io/directories/search/search-tests.factor | 40 +++++++++++++++++-- 1 file changed, 36 insertions(+), 4 deletions(-) diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 1d8bd99d5f..91831b8a8a 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -47,9 +47,42 @@ strings tools.test ; [ drop f ] find-up-to-root ] unit-test -{ - t -} [ +[ + { + "/a" + "/a/a" + "/a/a/a" + "/a/b" + "/a/b/a" + "/b" + "/b/a" + "/b/a/a" + "/b/b" + "/b/b/a" + "/c" + "/c/a" + "/c/a/a" + "/c/b" + "/c/b/a" + } + { + "/a" + "/b" + "/c" + "/a/a" + "/a/b" + "/b/a" + "/b/b" + "/c/a" + "/c/b" + "/a/a/a" + "/a/b/a" + "/b/a/a" + "/b/b/a" + "/c/a/a" + "/c/b/a" + } +] [ [ "a" make-directory "a/a" make-directory @@ -87,5 +120,4 @@ strings tools.test ; [ natural-sort ] map concat ] with-variable ] with-test-directory - [ natural-sort ] bi@ sequence= ] unit-test From 25b29e084d1f82833076f1dcf44dbfd108094281 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 19:36:05 -0700 Subject: [PATCH 28/69] io.directories.search: a better fix for the linux entry ordering issue. --- basis/io/directories/search/search-tests.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 91831b8a8a..62c8105630 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -1,7 +1,7 @@ -USING: combinators fry io.directories io.directories.hierarchy -io.directories.search io.files.unique io.pathnames kernel math -namespaces sequences sorting splitting splitting.monotonic -strings tools.test ; +USING: combinators fry grouping io.directories +io.directories.hierarchy io.directories.search io.files.unique +io.pathnames kernel math namespaces sequences sorting splitting +splitting.monotonic strings tools.test ; { t } [ [ @@ -106,8 +106,8 @@ strings tools.test ; ! preserve file traversal order, but sort ! alphabetically for cross-platform testing - [ [ length ] bi@ < ] monotonic-split - [ natural-sort ] map natural-sort concat + dup length 3 / group natural-sort + [ natural-sort ] map concat ] with-variable +breadth-first+ traversal-method [ From 4f401a158528f615528045dea798801dc5454f1c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 19:54:06 -0700 Subject: [PATCH 29/69] windows.dragdrop-listener: cleanup using. --- .../dragdrop-listener/dragdrop-listener.factor | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 39238c61c2..4250c37aab 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -1,15 +1,10 @@ ! Copyright (C) 2008, 2009 Joe Groff, Slava Pestov. ! Copyright (C) 2017-2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.accessors alien.c-types alien.data -alien.strings classes.struct io.encodings.utf16n kernel make -math namespaces prettyprint sequences specialized-arrays -ui.backend.windows ui.gadgets.worlds ui.gestures -ui.tools.listener windows.com windows.com.wrapper -windows.dropfiles windows.kernel32 windows.ole32 windows.shell32 -windows.types windows.user32 ; -SPECIALIZED-ARRAY: ushort -SPECIALIZED-ARRAY: WCHAR +USING: accessors alien.accessors classes.struct kernel +namespaces sequences ui.backend.windows ui.gadgets.worlds +ui.gestures windows.com windows.com.wrapper windows.dropfiles +windows.kernel32 windows.ole32 windows.user32 ; IN: windows.dragdrop-listener CONSTANT: E_OUTOFMEMORY -2147024882 ! 0x8007000e From ebc1c1ef584a9507cfd8254d818d6c0cbad3ef75 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 21 Mar 2019 20:11:46 -0700 Subject: [PATCH 30/69] ascii: faster capitalize. --- basis/ascii/ascii.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ascii/ascii.factor b/basis/ascii/ascii.factor index d2e12ac551..a98bdd7f93 100644 --- a/basis/ascii/ascii.factor +++ b/basis/ascii/ascii.factor @@ -24,7 +24,7 @@ IN: ascii [ [ 1 ] when-zero cut-slice swap ] [ f 0 rot [ length ] keep ] if* ] produce nip ; -: capitalize ( str -- str' ) unclip [ >lower ] [ ch>upper ] bi* prefix ; +: capitalize ( str -- str' ) >lower 0 over [ ch>upper ] change-nth ; : >title ( str -- title ) >words [ capitalize ] map concat ; HINTS: >lower string ; From d575ac084f3841602933b0bf3cf7958c17f43afe Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 21 Mar 2019 22:52:17 -0500 Subject: [PATCH 31/69] resolv-conf: Parse edns0, refactor some words, and add a unit test. --- extra/resolv-conf/resolv-conf-tests.factor | 18 ++++++++++++++++++ extra/resolv-conf/resolv-conf.factor | 12 +++++++++--- 2 files changed, 27 insertions(+), 3 deletions(-) create mode 100644 extra/resolv-conf/resolv-conf-tests.factor diff --git a/extra/resolv-conf/resolv-conf-tests.factor b/extra/resolv-conf/resolv-conf-tests.factor new file mode 100644 index 0000000000..59c52cffe2 --- /dev/null +++ b/extra/resolv-conf/resolv-conf-tests.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2019 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test resolv-conf ; +IN: resolv-conf.tests +{ + T{ resolv.conf + { nameserver V{ "127.0.0.53" } } + { domain V{ } } + { lookup V{ } } + { search V{ "localdomain" } } + { sortlist V{ } } + { options T{ options { edns0? t } } } + } +} [ + "nameserver 127.0.0.53 + options edns0 + search localdomain" string>resolv.conf +] unit-test \ No newline at end of file diff --git a/extra/resolv-conf/resolv-conf.factor b/extra/resolv-conf/resolv-conf.factor index f5c098c8a8..8a271e42ea 100644 --- a/extra/resolv-conf/resolv-conf.factor +++ b/extra/resolv-conf/resolv-conf.factor @@ -68,6 +68,7 @@ ERROR: unsupported-resolv.conf-option string ; { [ "rotate" ?head ] [ drop t >>rotate? ] } { [ "no-check-names" ?head ] [ drop t >>no-check-names? ] } { [ "inet6" ?head ] [ drop t >>inet6? ] } + { [ "edns0" ?head ] [ drop t >>edns0? ] } [ unsupported-resolv.conf-option ] } cond drop ; @@ -86,12 +87,17 @@ ERROR: unsupported-resolv.conf-line string ; PRIVATE> -: parse-resolve.conf ( path -- resolv.conf ) +: lines>resolv.conf ( lines -- resolv.conf ) [ ] dip - utf8 file-lines [ [ blank? ] trim ] map harvest [ "#" head? ] reject [ parse-resolv.conf-line ] each ; +: string>resolv.conf ( string -- resolv.conf ) + string-lines lines>resolv.conf ; + +: path>resolv.conf ( path -- resolv.conf ) + utf8 file-lines lines>resolv.conf ; + : default-resolv.conf ( -- resolv.conf ) - "/etc/resolv.conf" parse-resolve.conf ; + "/etc/resolv.conf" path>resolv.conf ; From 60c80e4b786b32b292347c428104727d7a503f09 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 00:07:38 -0500 Subject: [PATCH 32/69] make: Use the MacOSX 10.13 SDK for x86 support. Bugfix - CFLAGS += instead of CFLAGS = because it would get overwritten otherwise. Also allow overwriting of XCODE_PATH for non-standard path. Download the 10.13 SDK from https://github.com/phracker/MacOSX-SDKs/releases ```bash wget https://github.com/phracker/MacOSX-SDKs/releases/download/10.13/MacOSX10.13.sdk.tar.xz xz --uncompress MacOSX10.13.sdk.tar.xz tar xvf MacOSX10.13.sdk.tar mv MacOSX10.13.sdk /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/ ``` --- GNUmakefile | 4 +++- vm/Config.macosx.x86.32 | 4 ++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/GNUmakefile b/GNUmakefile index 2a779b4855..1f43b333bb 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -13,9 +13,11 @@ ifdef CONFIG CXX=$(SHELL_CXX) endif + XCODE_PATH ?= /Applications/Xcode.app + include $(CONFIG) - CFLAGS = -Wall \ + CFLAGS += -Wall \ -pedantic \ -DFACTOR_VERSION="$(VERSION)" \ -DFACTOR_GIT_LABEL="$(GIT_LABEL)" \ diff --git a/vm/Config.macosx.x86.32 b/vm/Config.macosx.x86.32 index 5c0d4e0ede..68eaa9c0d1 100644 --- a/vm/Config.macosx.x86.32 +++ b/vm/Config.macosx.x86.32 @@ -1,2 +1,6 @@ include vm/Config.macosx include vm/Config.x86.32 + +# The last SDK to support x86 +CFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.13.sdk +CXXFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.13.sdk From 5609370be69dfbb9d5b20de9eba6c94a470c8d7f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 01:32:28 -0500 Subject: [PATCH 33/69] make: Allow overriding macosx sdk MACOSX_SDK=MacOSX10.11.sdk ./build.sh update macosx-x86-32 --- GNUmakefile | 1 + vm/Config.macosx.x86.32 | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index 1f43b333bb..e69c1781f7 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -14,6 +14,7 @@ ifdef CONFIG endif XCODE_PATH ?= /Applications/Xcode.app + MACOSX_SDK ?= MacOSX10.13.sdk include $(CONFIG) diff --git a/vm/Config.macosx.x86.32 b/vm/Config.macosx.x86.32 index 68eaa9c0d1..d7e5edc6b8 100644 --- a/vm/Config.macosx.x86.32 +++ b/vm/Config.macosx.x86.32 @@ -1,6 +1,6 @@ include vm/Config.macosx include vm/Config.x86.32 -# The last SDK to support x86 -CFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.13.sdk -CXXFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.13.sdk +# The last SDK to support x86 is 10.13 +CFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/$(MACOSX_SDK) +CXXFLAGS += --sysroot=$(XCODE_PATH)/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/$(MACOSX_SDK) From 799bf88daf09ab223b024c4536cbfd6d02bc00d8 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 15:20:32 -0700 Subject: [PATCH 34/69] crontab: some fixes and additional test case. --- extra/crontab/crontab-tests.factor | 23 +++++++++- extra/crontab/crontab.factor | 68 +++++++++++++++++------------- 2 files changed, 60 insertions(+), 31 deletions(-) diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor index 5701b8b145..b3749f9435 100644 --- a/extra/crontab/crontab-tests.factor +++ b/extra/crontab/crontab-tests.factor @@ -18,9 +18,30 @@ USING: calendar crontab kernel math.order tools.test ; { hour 12 } { minute 6 } { gmt-offset T{ duration { hour -8 } } } - } [ next-time-after ] keep + } next-time-after ] unit-test { +lt+ } [ now "*/1 * * * *" parse-cronentry next-time <=> ] unit-test + +{ + T{ timestamp + { year 2019 } + { month 8 } + { day 1 } + { minute 5 } + { gmt-offset T{ duration { hour -7 } } } + } +} [ + "5 0 * 8 *" parse-cronentry + T{ timestamp + { year 2019 } + { month 3 } + { day 22 } + { hour 15 } + { minute 16 } + { second 36+590901/1000000 } + { gmt-offset T{ duration { hour -7 } } } + } next-time-after +] unit-test diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 50c9e06951..c4189935d7 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -47,62 +47,70 @@ CONSTANT: aliases H{ " " split1 " " split1 " " split1 " " split1 " " split1 { [ [ string>number ] T{ range f 0 60 1 } parse-value ] [ [ string>number ] T{ range f 0 24 1 } parse-value ] - [ [ string>number ] T{ range f 0 31 1 } parse-value ] - [ [ parse-month ] T{ range f 0 12 1 } parse-value ] + [ [ string>number ] T{ range f 1 31 1 } parse-value ] + [ [ parse-month ] T{ range f 1 12 1 } parse-value ] [ [ parse-day ] T{ range f 0 7 1 } parse-value ] [ ] } spread cronentry boa ; -:: next-time-after ( cronentry timestamp -- ) - - timestamp second>> 0 > [ - timestamp 0 >>second 1 minutes (time+) 2drop - ] when +> :> month cronentry months>> [ month >= ] find nip [ - dup month = [ drop f ] [ timestamp month<< t ] if + dup month = [ drop f ] [ + timestamp 1 >>day 0 >>hour 0 >>minute month<< t + ] if ] [ - timestamp cronentry months>> first >>month 1 +year - ] if* [ cronentry timestamp next-time-after ] when + timestamp 1 >>day 0 >>hour 0 >>minute + cronentry months>> first >>month 1 +year + ] if* [ cronentry timestamp (next-time-after) ] when + + timestamp day>> :> day + cronentry days>> [ day >= ] find nip [ + dup day = [ drop f ] [ timestamp day<< t ] if + ] [ + timestamp cronentry days>> first >>day 1 +month + ] if* [ cronentry timestamp (next-time-after) ] when timestamp hour>> :> hour cronentry hours>> [ hour >= ] find nip [ dup hour = [ drop f ] [ - timestamp hour<< 0 timestamp minute<< t + timestamp 0 >>hour minute<< t ] if ] [ - timestamp cronentry hours>> first >>hour 1 +day - ] if* [ cronentry timestamp next-time-after ] when + timestamp 0 >>minute + cronentry hours>> first >>hour 1 +day + ] if* [ cronentry timestamp (next-time-after) ] when timestamp minute>> :> minute cronentry minutes>> [ minute >= ] find nip [ dup minute = [ drop f ] [ timestamp minute<< t ] if ] [ timestamp cronentry minutes>> first >>minute 1 +hour - ] if* [ cronentry timestamp next-time-after ] when + ] if* [ cronentry timestamp (next-time-after) ] when timestamp day-of-week :> weekday cronentry days-of-week>> [ weekday >= ] find nip [ cronentry days-of-week>> first 7 + - ] unless* weekday - - - timestamp day>> :> day - cronentry days>> [ day >= ] find nip [ - day - - ] [ - timestamp 1 months time+ - cronentry days>> first >>day - day-of-year timestamp day-of-year - - ] if* - - min [ + ] unless* weekday - [ timestamp swap +day drop - cronentry timestamp next-time-after + cronentry timestamp (next-time-after) ] unless-zero ; -: next-time ( cronentry -- timestamp ) - now [ next-time-after ] keep ; +PRIVATE> -: parse-crontab ( -- entries ) +: next-time-after ( cronentry timestamp -- timestamp ) + 1 minutes time+ 0 >>second [ (next-time-after) ] keep ; + +: next-time ( cronentry -- timestamp ) + now next-time-after ; + +: next-times-after ( cronentry n timestamp -- timestamps ) + swap [ dupd next-time-after dup ] replicate 2nip ; + +: next-times ( cronentry n -- timestamps ) + now next-times-after ; + +: read-crontab ( -- entries ) lines harvest [ parse-cronentry ] map ; From 63166703462ad273ed3bc214e3b1474bfeede65a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 17:56:28 -0500 Subject: [PATCH 35/69] cleaning: update copyright year. use the same order for build directions. --- LICENSE.txt | 2 +- README.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/LICENSE.txt b/LICENSE.txt index 3eb608b9ce..9e25f74a59 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,4 +1,4 @@ -Copyright (c) 2018, Slava Pestov, et al. +Copyright (c) 2019, Slava Pestov, et al. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md index d4e520163b..c3c666a075 100644 --- a/README.md +++ b/README.md @@ -34,8 +34,8 @@ To check out Factor: To build the latest complete Factor system from git, either use the build script: -* Windows: `build.cmd` * Unix: `./build.sh update` +* Windows: `build.cmd` or download the correct boot image for your system from http://downloads.factorcode.org/images/master/, put it in the factor From fed9249a909d052cb652f727f3854357af83e98f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 18:28:52 -0500 Subject: [PATCH 36/69] zoneinfo: update to 2018i --- extra/zoneinfo/africa | 12 ++- extra/zoneinfo/calendars | 173 +++++++++++++++++++++++++++++++++++++++ extra/zoneinfo/version | 1 + 3 files changed, 185 insertions(+), 1 deletion(-) create mode 100644 extra/zoneinfo/calendars create mode 100644 extra/zoneinfo/version diff --git a/extra/zoneinfo/africa b/extra/zoneinfo/africa index a83c3875ee..0a0f5863bf 100644 --- a/extra/zoneinfo/africa +++ b/extra/zoneinfo/africa @@ -1144,10 +1144,20 @@ Zone Indian/Reunion 3:41:52 - LMT 1911 Jun # Saint-Denis # the switch is from 01:00 to 02:00 ... [Decree No. 25/2017] # http://www.mnec.gov.st/index.php/publicacoes/documentos/file/90-decreto-lei-n-25-2017 +# From Vadim Nasardinov (2018-12-29): +# São Tomé and Príncipe is about to do the following on Jan 1, 2019: +# https://www.stp-press.st/2018/12/05/governo-jesus-ja-decidiu-repor-hora-legal-sao-tomense/ +# +# From Michael Deckers (2018-12-30): +# https://www.legis-palop.org/download.jsp?idFile=102818 +# ... [The legal time of the country, which coincides with universal +# coordinated time, will be restituted at 2 o'clock on day 1 of January, 2019.] + Zone Africa/Sao_Tome 0:26:56 - LMT 1884 -0:36:45 - LMT 1912 Jan 1 00:00u # Lisbon MT 0:00 - GMT 2018 Jan 1 01:00 - 1:00 - WAT + 1:00 - WAT 2019 Jan 1 02:00 + 0:00 - GMT # Senegal # See Africa/Abidjan. diff --git a/extra/zoneinfo/calendars b/extra/zoneinfo/calendars new file mode 100644 index 0000000000..8bc70626eb --- /dev/null +++ b/extra/zoneinfo/calendars @@ -0,0 +1,173 @@ +----- Calendrical issues ----- + +As mentioned in Theory.html, although calendrical issues are out of +scope for tzdb, they indicate the sort of problems that we would run +into if we extended tzdb further into the past. The following +information and sources go beyond Theory.html's brief discussion. +They sometimes disagree. + + +France + +Gregorian calendar adopted 1582-12-20. +French Revolutionary calendar used 1793-11-24 through 1805-12-31, +and (in Paris only) 1871-05-06 through 1871-05-23. + + +Russia + +From Chris Carrier (1996-12-02): +On 1929-10-01 the Soviet Union instituted an "Eternal Calendar" +with 30-day months plus 5 holidays, with a 5-day week. +On 1931-12-01 it changed to a 6-day week; in 1934 it reverted to the +Gregorian calendar while retaining the 6-day week; on 1940-06-27 it +reverted to the 7-day week. With the 6-day week the usual days +off were the 6th, 12th, 18th, 24th and 30th of the month. +(Source: Evitiar Zerubavel, _The Seven Day Circle_) + + +Mark Brader reported a similar story in "The Book of Calendars", edited +by Frank Parise (1982, Facts on File, ISBN 0-8719-6467-8), page 377. But: + +From: Petteri Sulonen (via Usenet) +Date: 14 Jan 1999 00:00:00 GMT +... + +If your source is correct, how come documents between 1929 and 1940 were +still dated using the conventional, Gregorian calendar? + +I can post a scan of a document dated December 1, 1934, signed by +Yenukidze, the secretary, on behalf of Kalinin, the President of the +Executive Committee of the Supreme Soviet, if you like. + + + +Sweden (and Finland) + +From: Mark Brader +Subject: Re: Gregorian reform - a part of locale? + +Date: 1996-07-06 + +In 1700, Denmark made the transition from Julian to Gregorian. Sweden +decided to *start* a transition in 1700 as well, but rather than have one of +those unsightly calendar gaps :-), they simply decreed that the next leap +year after 1696 would be in 1744 - putting the whole country on a calendar +different from both Julian and Gregorian for a period of 40 years. + +However, in 1704 something went wrong and the plan was not carried through; +they did, after all, have a leap year that year. And one in 1708. In 1712 +they gave it up and went back to Julian, putting 30 days in February that +year!... + +Then in 1753, Sweden made the transition to Gregorian in the usual manner, +getting there only 13 years behind the original schedule. + +(A previous posting of this story was challenged, and Swedish readers +produced the following references to support it: "Tideräkning och historia" +by Natanael Beckman (1924) and "Tid, en bok om tideräkning och +kalenderväsen" by Lars-Olof Lodén (1968). + + +Grotefend's data + +From: "Michael Palmer" [with one obvious typo fixed] +Subject: Re: Gregorian Calendar (was Re: Another FHC related question +Newsgroups: soc.genealogy.german +Date: Tue, 9 Feb 1999 02:32:48 -800 +... + +The following is a(n incomplete) listing, arranged chronologically, of +European states, with the date they converted from the Julian to the +Gregorian calendar: + +04/15 Oct 1582 - Italy (with exceptions), Spain, Portugal, Poland (Roman + Catholics and Danzig only) +09/20 Dec 1582 - France, Lorraine + +21 Dec 1582/ + 01 Jan 1583 - Holland, Brabant, Flanders, Hennegau +10/21 Feb 1583 - bishopric of Liege (Lüttich) +13/24 Feb 1583 - bishopric of Augsburg +04/15 Oct 1583 - electorate of Trier +05/16 Oct 1583 - Bavaria, bishoprics of Freising, Eichstedt, Regensburg, + Salzburg, Brixen +13/24 Oct 1583 - Austrian Oberelsaß and Breisgau +20/31 Oct 1583 - bishopric of Basel +02/13 Nov 1583 - duchy of Jülich-Berg +02/13 Nov 1583 - electorate and city of Köln +04/15 Nov 1583 - bishopric of Würzburg +11/22 Nov 1583 - electorate of Mainz +16/27 Nov 1583 - bishopric of Strassburg and the margraviate of Baden +17/28 Nov 1583 - bishopric of Münster and duchy of Cleve +14/25 Dec 1583 - Steiermark + +06/17 Jan 1584 - Austria and Bohemia +11/22 Jan 1584 - Lucerne, Uri, Schwyz, Zug, Freiburg, Solothurn +12/23 Jan 1584 - Silesia and the Lausitz +22 Jan/ + 02 Feb 1584 - Hungary (legally on 21 Oct 1587) + Jun 1584 - Unterwalden +01/12 Jul 1584 - duchy of Westfalen + +16/27 Jun 1585 - bishopric of Paderborn + +14/25 Dec 1590 - Transylvania + +22 Aug/ + 02 Sep 1612 - duchy of Prussia + +13/24 Dec 1614 - Pfalz-Neuburg + + 1617 - duchy of Kurland (reverted to the Julian calendar in + 1796) + + 1624 - bishopric of Osnabrück + + 1630 - bishopric of Minden + +15/26 Mar 1631 - bishopric of Hildesheim + + 1655 - Kanton Wallis + +05/16 Feb 1682 - city of Strassburg + +18 Feb/ + 01 Mar 1700 - Protestant Germany (including Swedish possessions in + Germany), Denmark, Norway +30 Jun/ + 12 Jul 1700 - Gelderland, Zutphen +10 Nov/ + 12 Dec 1700 - Utrecht, Overijssel + +31 Dec 1700/ + 12 Jan 1701 - Friesland, Groningen, Zürich, Bern, Basel, Geneva, + Turgau, and Schaffhausen + + 1724 - Glarus, Appenzell, and the city of St. Gallen + +01 Jan 1750 - Pisa and Florence + +02/14 Sep 1752 - Great Britain + +17 Feb/ + 01 Mar 1753 - Sweden + +1760-1812 - Graubünden + +The Russian empire (including Finland and the Baltic states) did not +convert to the Gregorian calendar until the Soviet revolution of 1917. + +Source: H. Grotefend, _Taschenbuch der Zeitrechnung des deutschen +Mittelalters und der Neuzeit_, herausgegeben von Dr. O. Grotefend +(Hannover: Hahnsche Buchhandlung, 1941), pp. 26-28. + +----- + +This file is in the public domain, so clarified as of 2009-05-17 by +Arthur David Olson. + +----- +Local Variables: +coding: utf-8 +End: diff --git a/extra/zoneinfo/version b/extra/zoneinfo/version new file mode 100644 index 0000000000..63f58006ee --- /dev/null +++ b/extra/zoneinfo/version @@ -0,0 +1 @@ +2018i From a1a0bdfa4ea268e8a6a28e8931b1b73b902dee84 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 21:30:01 -0500 Subject: [PATCH 37/69] windows.kernel32: add almost useless timezone function --- basis/windows/kernel32/kernel32.factor | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index c6a86e2824..d1b994f82d 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -270,6 +270,20 @@ STRUCT: TIME_ZONE_INFORMATION { DaylightDate SYSTEMTIME } { DaylightBias LONG } ; +STRUCT: DYNAMIC_TIME_ZONE_INFORMATION + { Bias LONG } + { StandardName WCHAR[32] } + { StandardDate SYSTEMTIME } + { StandardBias LONG } + { DaylightName WCHAR[32] } + { DaylightDate SYSTEMTIME } + { DaylightBias LONG } + { TimeZoneKeyName WCHAR[128] } + { DynamicDaylightTimeDisabled BOOLEAN } ; + +TYPEDEF: DYNAMIC_TIME_ZONE_INFORMATION* PDYNAMIC_TIME_ZONE_INFORMATION + + STRUCT: FILETIME { dwLowDateTime DWORD } { dwHighDateTime DWORD } ; @@ -1366,6 +1380,9 @@ ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW ! FUNCTION: GetDriveTypeA FUNCTION: UINT GetDriveTypeW ( LPCTSTR lpRootPathName ) ALIAS: GetDriveType GetDriveTypeW + +FUNCTION: DWORD GetDynamicTimeZoneInformation ( PDYNAMIC_TIME_ZONE_INFORMATION pTimeZoneInformation ) + FUNCTION: void* GetEnvironmentStringsW ( ) ! FUNCTION: GetEnvironmentStringsA ALIAS: GetEnvironmentStrings GetEnvironmentStringsW From 3ea506e5b30dc6d9eadb33122530064d28e5f7ab Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 Mar 2019 21:30:18 -0500 Subject: [PATCH 38/69] checksums.multi: fix test for 2019 --- extra/checksums/multi/multi-tests.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/checksums/multi/multi-tests.factor b/extra/checksums/multi/multi-tests.factor index 9c9db21d9f..3d3b5f2acc 100644 --- a/extra/checksums/multi/multi-tests.factor +++ b/extra/checksums/multi/multi-tests.factor @@ -6,10 +6,10 @@ IN: checksums.multi.tests { { - B{ 9 143 107 205 70 33 211 115 202 222 78 131 38 39 180 246 } + B{ 155 181 180 45 142 211 121 3 86 11 19 254 46 110 208 53 } B{ - 169 74 143 229 204 177 155 166 28 76 8 115 211 145 233 - 135 152 47 187 211 + 185 16 47 6 163 92 254 132 223 97 1 55 165 73 57 87 243 + 209 7 104 } } } [ From c228aaf836e01831e23a35577cfe6c2d8b013f5c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 20:08:19 -0700 Subject: [PATCH 39/69] io.backend: remove comment from years ago. --- core/io/backend/backend.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 8d39d1cc68..07d866b56a 100644 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -27,7 +27,5 @@ HOOK: normalize-path io-backend ( path -- path' ) io-backend set-global init-io init-stdio "io.files" startup-hooks get at call( -- ) ; -! Note that we have 'alien' in our using list so that the alien -! init hook runs before this one. [ init-io embedded? [ init-stdio ] unless ] "io.backend" add-startup-hook From 0f0099b08d73138366e7e364a4ca58b5ad45915e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 20:36:16 -0700 Subject: [PATCH 40/69] crontab: some more fixes. --- extra/crontab/crontab.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index c4189935d7..fc64c93251 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -68,15 +68,18 @@ CONSTANT: aliases H{ timestamp day>> :> day cronentry days>> [ day >= ] find nip [ - dup day = [ drop f ] [ timestamp day<< t ] if + dup day = [ drop f ] [ + timestamp 0 >>hour 0 >>minute day<< t + ] if ] [ - timestamp cronentry days>> first >>day 1 +month + timestamp 0 >>hour 0 >>minute + cronentry days>> first >>day 1 +month ] if* [ cronentry timestamp (next-time-after) ] when timestamp hour>> :> hour cronentry hours>> [ hour >= ] find nip [ dup hour = [ drop f ] [ - timestamp 0 >>hour minute<< t + timestamp 0 >>minute hour<< t ] if ] [ timestamp 0 >>minute From ea83c1c1ee8f9dc7eb30d662b164c190b0b00eda Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 20:42:46 -0700 Subject: [PATCH 41/69] crontab: constraint order is month, day, day-of-week, hour, minute. --- extra/crontab/crontab.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index fc64c93251..0b09c3c07e 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -76,6 +76,14 @@ CONSTANT: aliases H{ cronentry days>> first >>day 1 +month ] if* [ cronentry timestamp (next-time-after) ] when + timestamp day-of-week :> weekday + cronentry days-of-week>> [ weekday >= ] find nip [ + cronentry days-of-week>> first 7 + + ] unless* weekday - [ + timestamp 0 >>hour 0 >>minute swap +day drop + cronentry timestamp (next-time-after) + ] unless-zero + timestamp hour>> :> hour cronentry hours>> [ hour >= ] find nip [ dup hour = [ drop f ] [ @@ -91,15 +99,7 @@ CONSTANT: aliases H{ dup minute = [ drop f ] [ timestamp minute<< t ] if ] [ timestamp cronentry minutes>> first >>minute 1 +hour - ] if* [ cronentry timestamp (next-time-after) ] when - - timestamp day-of-week :> weekday - cronentry days-of-week>> [ weekday >= ] find nip [ - cronentry days-of-week>> first 7 + - ] unless* weekday - [ - timestamp swap +day drop - cronentry timestamp (next-time-after) - ] unless-zero ; + ] if* [ cronentry timestamp (next-time-after) ] when ; PRIVATE> From 3afc3447b43c638b7fb4a49c1ee3263358a2d0e8 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 20:52:33 -0700 Subject: [PATCH 42/69] crontab: simplify common code paths in (next-time-after). --- extra/crontab/crontab.factor | 50 +++++++++++++++--------------------- 1 file changed, 21 insertions(+), 29 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 0b09c3c07e..1f5b8e0f6a 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -56,25 +56,20 @@ CONSTANT: aliases H{ > :> month - cronentry months>> [ month >= ] find nip [ - dup month = [ drop f ] [ - timestamp 1 >>day 0 >>hour 0 >>minute month<< t - ] if - ] [ - timestamp 1 >>day 0 >>hour 0 >>minute - cronentry months>> first >>month 1 +year - ] if* [ cronentry timestamp (next-time-after) ] when + cronentry months>> [ month >= ] find nip + dup month = [ drop f ] [ + [ cronentry months>> first timestamp 1 +year drop ] unless* + timestamp 1 >>day 0 >>hour 0 >>minute month<< t + ] if [ cronentry timestamp (next-time-after) ] when timestamp day>> :> day - cronentry days>> [ day >= ] find nip [ - dup day = [ drop f ] [ - timestamp 0 >>hour 0 >>minute day<< t - ] if - ] [ - timestamp 0 >>hour 0 >>minute - cronentry days>> first >>day 1 +month - ] if* [ cronentry timestamp (next-time-after) ] when + cronentry days>> [ day >= ] find nip + dup day = [ drop f ] [ + [ cronentry days>> first timestamp 1 +month drop ] unless* + timestamp 0 >>hour 0 >>minute day<< t + ] if [ cronentry timestamp (next-time-after) ] when timestamp day-of-week :> weekday cronentry days-of-week>> [ weekday >= ] find nip [ @@ -85,21 +80,18 @@ CONSTANT: aliases H{ ] unless-zero timestamp hour>> :> hour - cronentry hours>> [ hour >= ] find nip [ - dup hour = [ drop f ] [ - timestamp 0 >>minute hour<< t - ] if - ] [ - timestamp 0 >>minute - cronentry hours>> first >>hour 1 +day - ] if* [ cronentry timestamp (next-time-after) ] when + cronentry hours>> [ hour >= ] find nip + dup hour = [ drop f ] [ + [ cronentry hours>> first timestamp 1 +day drop ] unless* + timestamp 0 >>minute hour<< t + ] if [ cronentry timestamp (next-time-after) ] when timestamp minute>> :> minute - cronentry minutes>> [ minute >= ] find nip [ - dup minute = [ drop f ] [ timestamp minute<< t ] if - ] [ - timestamp cronentry minutes>> first >>minute 1 +hour - ] if* [ cronentry timestamp (next-time-after) ] when ; + cronentry minutes>> [ minute >= ] find nip + dup minute = [ drop f ] [ + [ cronentry minutes>> first timestamp 1 +hour drop ] unless* + timestamp minute<< t + ] if [ cronentry timestamp (next-time-after) ] when ; PRIVATE> From ffbb4c8289479c9052589c843dec160724035310 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 22 Mar 2019 20:57:50 -0700 Subject: [PATCH 43/69] crontab: simplify (next-time-after) recursion. --- extra/crontab/crontab.factor | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 1f5b8e0f6a..2289c7ec26 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -57,41 +57,44 @@ CONSTANT: aliases H{ :: (next-time-after) ( cronentry timestamp -- ) + f ! should we keep searching for a matching time + timestamp month>> :> month cronentry months>> [ month >= ] find nip - dup month = [ drop f ] [ + dup month = [ drop ] [ [ cronentry months>> first timestamp 1 +year drop ] unless* - timestamp 1 >>day 0 >>hour 0 >>minute month<< t - ] if [ cronentry timestamp (next-time-after) ] when + timestamp 1 >>day 0 >>hour 0 >>minute month<< drop t + ] if timestamp day>> :> day cronentry days>> [ day >= ] find nip - dup day = [ drop f ] [ + dup day = [ drop ] [ [ cronentry days>> first timestamp 1 +month drop ] unless* - timestamp 0 >>hour 0 >>minute day<< t - ] if [ cronentry timestamp (next-time-after) ] when + timestamp 0 >>hour 0 >>minute day<< drop t + ] if timestamp day-of-week :> weekday cronentry days-of-week>> [ weekday >= ] find nip [ cronentry days-of-week>> first 7 + ] unless* weekday - [ - timestamp 0 >>hour 0 >>minute swap +day drop - cronentry timestamp (next-time-after) + timestamp 0 >>hour 0 >>minute swap +day 2drop t ] unless-zero timestamp hour>> :> hour cronentry hours>> [ hour >= ] find nip - dup hour = [ drop f ] [ + dup hour = [ drop ] [ [ cronentry hours>> first timestamp 1 +day drop ] unless* - timestamp 0 >>minute hour<< t - ] if [ cronentry timestamp (next-time-after) ] when + timestamp 0 >>minute hour<< drop t + ] if timestamp minute>> :> minute cronentry minutes>> [ minute >= ] find nip - dup minute = [ drop f ] [ + dup minute = [ drop ] [ [ cronentry minutes>> first timestamp 1 +hour drop ] unless* - timestamp minute<< t - ] if [ cronentry timestamp (next-time-after) ] when ; + timestamp minute<< drop t + ] if + + [ cronentry timestamp (next-time-after) ] when ; PRIVATE> From e4c94e7d989a1b048dda7d8b27a08aac2c5804b7 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 23 Mar 2019 07:20:31 -0700 Subject: [PATCH 44/69] checksums.multi: fix tests. --- extra/checksums/multi/multi-tests.factor | 26 +++++++++++++----------- 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/extra/checksums/multi/multi-tests.factor b/extra/checksums/multi/multi-tests.factor index 3d3b5f2acc..0a9d2fa755 100644 --- a/extra/checksums/multi/multi-tests.factor +++ b/extra/checksums/multi/multi-tests.factor @@ -4,6 +4,20 @@ USING: byte-arrays checksums checksums.md5 checksums.multi checksums.sha io io.encodings.binary io.files namespaces tools.test ; IN: checksums.multi.tests +{ + { + B{ + 9 143 107 205 70 33 211 115 202 222 78 131 38 39 180 246 + } + B{ + 169 74 143 229 204 177 155 166 28 76 8 115 211 145 233 + 135 152 47 187 211 + } + } +} [ + "test" >byte-array { md5 sha1 } checksum-bytes +] unit-test + { { B{ 155 181 180 45 142 211 121 3 86 11 19 254 46 110 208 53 } @@ -12,18 +26,6 @@ IN: checksums.multi.tests 209 7 104 } } -} [ - "test" >byte-array { md5 sha1 } checksum-bytes -] unit-test - -{ - { - B{ 220 158 207 218 50 163 198 36 234 90 122 65 197 14 224 16 } - B{ - 132 132 148 224 101 202 198 114 38 53 127 18 70 170 108 - 53 25 255 174 207 - } - } } [ "resource:LICENSE.txt" binary [ input-stream get { md5 sha1 } checksum-stream From deb4b7c0d60cab2200ce6ac11885f3d0b6f479cf Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 23 Mar 2019 08:21:26 -0700 Subject: [PATCH 45/69] crontab: fix day-of-week to be OR instead of AND days. --- extra/crontab/crontab.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 2289c7ec26..5745b97a78 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -68,15 +68,16 @@ CONSTANT: aliases H{ timestamp day>> :> day cronentry days>> [ day >= ] find nip - dup day = [ drop ] [ - [ cronentry days>> first timestamp 1 +month drop ] unless* - timestamp 0 >>hour 0 >>minute day<< drop t - ] if + [ day - ] [ + timestamp days-in-month cronentry days>> first - + ] if* timestamp day-of-week :> weekday cronentry days-of-week>> [ weekday >= ] find nip [ cronentry days-of-week>> first 7 + - ] unless* weekday - [ + ] unless* weekday - + + min [ timestamp 0 >>hour 0 >>minute swap +day 2drop t ] unless-zero From 357d504719a855d155649bf5bcd9e247e7c74e9f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 23 Mar 2019 12:57:26 -0500 Subject: [PATCH 46/69] tests: Don't depend on license.txt not changing. It's probably bad to have the year in the license file, but it's worse to depend on the license never changing. Add a dummy file to crc32, and for multi checksums, the file we were checksumming is not really integral to the test since it's read into a buffer first. --- core/checksums/checksums-docs.factor | 4 ++-- core/checksums/crc32/crc-me.txt | 1 + extra/checksums/multi/multi-docs.factor | 20 ++------------------ extra/checksums/multi/multi-tests.factor | 16 +--------------- 4 files changed, 6 insertions(+), 35 deletions(-) create mode 100644 core/checksums/crc32/crc-me.txt diff --git a/core/checksums/checksums-docs.factor b/core/checksums/checksums-docs.factor index 9b2ae6d052..0cd52997a6 100644 --- a/core/checksums/checksums-docs.factor +++ b/core/checksums/checksums-docs.factor @@ -40,8 +40,8 @@ HELP: checksum-file { $examples { $example "USING: checksums checksums.crc32 prettyprint ;" - "\"resource:LICENSE.txt\" crc32 checksum-file ." - "B{ 125 29 106 28 }" + "\"resource:core/checksums/crc32/crc-me.txt\" crc32 checksum-file ." + "B{ 196 202 117 155 }" } } ; diff --git a/core/checksums/crc32/crc-me.txt b/core/checksums/crc32/crc-me.txt new file mode 100644 index 0000000000..3a88cf1cbd --- /dev/null +++ b/core/checksums/crc32/crc-me.txt @@ -0,0 +1 @@ +crc me 123 diff --git a/extra/checksums/multi/multi-docs.factor b/extra/checksums/multi/multi-docs.factor index c029e813a8..d0ee53ec57 100644 --- a/extra/checksums/multi/multi-docs.factor +++ b/extra/checksums/multi/multi-docs.factor @@ -16,7 +16,7 @@ $nl { $example "USING: byte-arrays checksums checksums.md5 " " checksums.multi checksums.sha ;" "\"test\" >byte-array { md5 sha1 } checksum-bytes ." - "{ +"{ B{ 9 143 107 205 70 33 211 115 202 222 78 131 38 39 180 246 } @@ -24,26 +24,10 @@ $nl 169 74 143 229 204 177 155 166 28 76 8 115 211 145 233 135 152 47 187 211 } -}" } - $nl - { $example "USING: checksums checksums.common checksums.md5 " - "checksums.multi checksums.sha io io.encodings.binary namespaces ;" - "\"resource:LICENSE.txt\" binary [" - " input-stream get { md5 sha1 } checksum-stream" - "] with-file-reader ." - "{ - B{ - 220 158 207 218 50 163 198 36 234 90 122 65 197 14 224 - 16 +}" } - B{ - 132 132 148 224 101 202 198 114 38 53 127 18 70 170 108 - 53 25 255 174 207 - } -}" } } ; - HELP: { $values { "checksums" sequence } diff --git a/extra/checksums/multi/multi-tests.factor b/extra/checksums/multi/multi-tests.factor index 0a9d2fa755..c3be4be5be 100644 --- a/extra/checksums/multi/multi-tests.factor +++ b/extra/checksums/multi/multi-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2018 Alexander Ilin. ! See http://factorcode.org/license.txt for BSD license. USING: byte-arrays checksums checksums.md5 checksums.multi -checksums.sha io io.encodings.binary io.files namespaces tools.test ; +checksums.sha tools.test ; IN: checksums.multi.tests { @@ -17,17 +17,3 @@ IN: checksums.multi.tests } [ "test" >byte-array { md5 sha1 } checksum-bytes ] unit-test - -{ - { - B{ 155 181 180 45 142 211 121 3 86 11 19 254 46 110 208 53 } - B{ - 185 16 47 6 163 92 254 132 223 97 1 55 165 73 57 87 243 - 209 7 104 - } - } -} [ - "resource:LICENSE.txt" binary [ - input-stream get { md5 sha1 } checksum-stream - ] with-file-reader -] unit-test From 6f8ee02569cc7fea4157b21ed504baa0d9fbdcf4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sat, 23 Mar 2019 14:15:45 -0700 Subject: [PATCH 47/69] crontab: test a lot more things. --- extra/crontab/crontab-tests.factor | 162 ++++++++++++++++++++++------- extra/crontab/crontab.factor | 21 ++-- 2 files changed, 136 insertions(+), 47 deletions(-) diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor index b3749f9435..e329be35ac 100644 --- a/extra/crontab/crontab-tests.factor +++ b/extra/crontab/crontab-tests.factor @@ -1,47 +1,131 @@ -USING: calendar crontab kernel math.order tools.test ; +USING: calendar calendar.format crontab kernel math.order +sequences tools.test ; -{ - T{ timestamp - { year 2018 } - { month 3 } - { day 9 } - { hour 12 } - { minute 23 } - { gmt-offset T{ duration { hour -8 } } } - } -} [ - "23 0-20/2 * * *" parse-cronentry - T{ timestamp - { year 2018 } - { month 3 } - { day 9 } - { hour 12 } - { minute 6 } - { gmt-offset T{ duration { hour -8 } } } - } next-time-after -] unit-test +IN: crontab.tests { +lt+ } [ now "*/1 * * * *" parse-cronentry next-time <=> ] unit-test +CONSTANT: start-timestamp T{ timestamp + { year 2019 } + { month 3 } + { day 23 } + { hour 14 } + { second 16+4353/8000 } + { gmt-offset T{ duration { hour -7 } } } +} + +: next-few-times ( pattern -- timestamps ) + parse-cronentry 5 start-timestamp next-times-after + [ timestamp>rfc822 ] map ; + +! At 04:05. { - T{ timestamp - { year 2019 } - { month 8 } - { day 1 } - { minute 5 } - { gmt-offset T{ duration { hour -7 } } } + { + "Sun, 24 Mar 2019 04:05:00 -0700" + "Mon, 25 Mar 2019 04:05:00 -0700" + "Tue, 26 Mar 2019 04:05:00 -0700" + "Wed, 27 Mar 2019 04:05:00 -0700" + "Thu, 28 Mar 2019 04:05:00 -0700" } -} [ - "5 0 * 8 *" parse-cronentry - T{ timestamp - { year 2019 } - { month 3 } - { day 22 } - { hour 15 } - { minute 16 } - { second 36+590901/1000000 } - { gmt-offset T{ duration { hour -7 } } } - } next-time-after -] unit-test +} [ "5 4 * * *" next-few-times ] unit-test + +! At 00:05 in August. +{ + { + "Thu, 1 Aug 2019 00:05:00 -0700" + "Fri, 2 Aug 2019 00:05:00 -0700" + "Sat, 3 Aug 2019 00:05:00 -0700" + "Sun, 4 Aug 2019 00:05:00 -0700" + "Mon, 5 Aug 2019 00:05:00 -0700" + } +} [ "5 0 * 8 *" next-few-times ] unit-test + +! At 14:15 on day-of-month 1. +{ + { + "Mon, 1 Apr 2019 14:15:00 -0700" + "Wed, 1 May 2019 14:15:00 -0700" + "Sat, 1 Jun 2019 14:15:00 -0700" + "Mon, 1 Jul 2019 14:15:00 -0700" + "Thu, 1 Aug 2019 14:15:00 -0700" + } +} [ "15 14 1 * *" next-few-times ] unit-test + +! At 22:00 on every day-of-week from Monday through Friday. +{ + { + "Mon, 25 Mar 2019 22:00:00 -0700" + "Tue, 26 Mar 2019 22:00:00 -0700" + "Wed, 27 Mar 2019 22:00:00 -0700" + "Thu, 28 Mar 2019 22:00:00 -0700" + "Fri, 29 Mar 2019 22:00:00 -0700" + } +} [ "0 22 * * 1-5" next-few-times ] unit-test + +! At minute 23 past every 2nd hour from 0 through 20. +{ + { + "Sat, 23 Mar 2019 14:23:00 -0700" + "Sat, 23 Mar 2019 16:23:00 -0700" + "Sat, 23 Mar 2019 18:23:00 -0700" + "Sat, 23 Mar 2019 20:23:00 -0700" + "Sun, 24 Mar 2019 00:23:00 -0700" + } +} [ "23 0-20/2 * * *" next-few-times ] unit-test + +! At 04:05 on Sunday. +{ + { + "Sun, 24 Mar 2019 04:05:00 -0700" + "Sun, 31 Mar 2019 04:05:00 -0700" + "Sun, 7 Apr 2019 04:05:00 -0700" + "Sun, 14 Apr 2019 04:05:00 -0700" + "Sun, 21 Apr 2019 04:05:00 -0700" + } +} [ "5 4 * * sun" next-few-times ] unit-test + +! At minute 0 past hour 0 and 12 on day-of-month 1 in every 2nd month. +{ + { + "Wed, 1 May 2019 00:00:00 -0700" + "Wed, 1 May 2019 12:00:00 -0700" + "Mon, 1 Jul 2019 00:00:00 -0700" + "Mon, 1 Jul 2019 12:00:00 -0700" + "Sun, 1 Sep 2019 00:00:00 -0700" + } +} [ "0 0,12 1 */2 *" next-few-times ] unit-test + +! At 04:00 on every day-of-month from 8 through 14. +{ + { + "Mon, 8 Apr 2019 04:00:00 -0700" + "Tue, 9 Apr 2019 04:00:00 -0700" + "Wed, 10 Apr 2019 04:00:00 -0700" + "Thu, 11 Apr 2019 04:00:00 -0700" + "Fri, 12 Apr 2019 04:00:00 -0700" + } +} [ "0 4 8-14 * *" next-few-times ] unit-test + +! At 00:00 on day-of-month 1 and 15 and on Wednesday. +{ + { + "Wed, 27 Mar 2019 00:00:00 -0700" + "Mon, 1 Apr 2019 00:00:00 -0700" + "Wed, 3 Apr 2019 00:00:00 -0700" + "Wed, 10 Apr 2019 00:00:00 -0700" + "Mon, 15 Apr 2019 00:00:00 -0700" + } +} [ "0 0 1,15 * 3" next-few-times ] unit-test + +! At 00:00 on Sunday. +{ + { + "Sun, 24 Mar 2019 00:00:00 -0700" + "Sun, 31 Mar 2019 00:00:00 -0700" + "Sun, 7 Apr 2019 00:00:00 -0700" + "Sun, 14 Apr 2019 00:00:00 -0700" + "Sun, 21 Apr 2019 00:00:00 -0700" + } +} [ "@weekly" next-few-times ] unit-test diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 5745b97a78..2ea27a821e 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -66,18 +66,23 @@ CONSTANT: aliases H{ timestamp 1 >>day 0 >>hour 0 >>minute month<< drop t ] if - timestamp day>> :> day - cronentry days>> [ day >= ] find nip - [ day - ] [ - timestamp days-in-month cronentry days>> first - - ] if* - timestamp day-of-week :> weekday cronentry days-of-week>> [ weekday >= ] find nip [ cronentry days-of-week>> first 7 + - ] unless* weekday - + ] unless* weekday - :> days-to-weekday - min [ + timestamp day>> :> day + cronentry days>> [ day >= ] find nip [ + cronentry days>> first timestamp days-in-month + + ] unless* day - :> days-to-day + + cronentry days-of-week>> T{ range f 0 7 1 } = + cronentry days>> T{ range f 1 31 1 } = 2array + { + { { f t } [ days-to-weekday ] } + { { t f } [ days-to-day ] } + [ drop days-to-weekday days-to-day min ] + } case [ timestamp 0 >>hour 0 >>minute swap +day 2drop t ] unless-zero From 92bf1786de2a5a582dd6c22fa4ac32cfbc58db7a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 24 Mar 2019 08:34:03 -0700 Subject: [PATCH 48/69] crontab: adding some Feb 29th tests. --- extra/crontab/crontab-tests.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor index e329be35ac..e85b638e04 100644 --- a/extra/crontab/crontab-tests.factor +++ b/extra/crontab/crontab-tests.factor @@ -129,3 +129,14 @@ CONSTANT: start-timestamp T{ timestamp "Sun, 21 Apr 2019 00:00:00 -0700" } } [ "@weekly" next-few-times ] unit-test + +! At 00:00 on day-of-month 29 in February. +{ + { + "Sat, 29 Feb 2020 00:00:00 -0700" + "Thu, 29 Feb 2024 00:00:00 -0700" + "Tue, 29 Feb 2028 00:00:00 -0700" + "Sun, 29 Feb 2032 00:00:00 -0700" + "Fri, 29 Feb 2036 00:00:00 -0700" + } +} [ "0 0 29 2 *" next-few-times ] unit-test From 6e1d23a931684756d4d0e97d29925d6da496b38a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 24 Mar 2019 13:32:57 -0700 Subject: [PATCH 49/69] crontab: better input validation for stuff like Feb 30 or Apr 31. --- extra/crontab/crontab-tests.factor | 3 +++ extra/crontab/crontab.factor | 23 ++++++++++++++++++++--- 2 files changed, 23 insertions(+), 3 deletions(-) diff --git a/extra/crontab/crontab-tests.factor b/extra/crontab/crontab-tests.factor index e85b638e04..4f03eab421 100644 --- a/extra/crontab/crontab-tests.factor +++ b/extra/crontab/crontab-tests.factor @@ -7,6 +7,9 @@ IN: crontab.tests now "*/1 * * * *" parse-cronentry next-time <=> ] unit-test +[ "0 0 30 2 *" parse-cronentry ] [ invalid-cronentry? ] must-fail-with +[ "0 0 31 4 *" parse-cronentry ] [ invalid-cronentry? ] must-fail-with + CONSTANT: start-timestamp T{ timestamp { year 2019 } { month 3 } diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 2ea27a821e..329b2982a5 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -2,11 +2,14 @@ ! See http://factorcode.org/license.txt for BSD license USING: accessors arrays ascii assocs calendar calendar.english -calendar.private combinators io kernel literals locals math -math.order math.parser math.ranges sequences splitting ; +calendar.private combinators combinators.short-circuit io kernel +literals locals math math.order math.parser math.ranges +sequences splitting ; IN: crontab +ERROR: invalid-cronentry value ; + :: parse-value ( value quot: ( value -- value' ) seq -- value ) value { { [ CHAR: , over member? ] [ @@ -42,6 +45,20 @@ CONSTANT: aliases H{ { "@hourly" "0 * * * *" } } +: check-cronentry ( cronentry -- cronentry ) + dup { + [ days-of-week>> [ 0 6 between? ] all? ] + [ months>> [ 1 12 between? ] all? ] + [ + [ days>> 1 ] [ months>> ] bi + dup { 2 } sequence= [ drop 29 ] [ + [ day-counts nth ] map supremum + ] if [ between? ] 2curry all? + ] + [ minutes>> [ 0 59 between? ] all? ] + [ hours>> [ 0 23 between? ] all? ] + } 1&& [ invalid-cronentry ] unless ; + : parse-cronentry ( entry -- cronentry ) " " split1 [ aliases ?at drop ] dip " " glue " " split1 " " split1 " " split1 " " split1 " " split1 { @@ -51,7 +68,7 @@ CONSTANT: aliases H{ [ [ parse-month ] T{ range f 1 12 1 } parse-value ] [ [ parse-day ] T{ range f 0 7 1 } parse-value ] [ ] - } spread cronentry boa ; + } spread cronentry boa check-cronentry ; Date: Sun, 24 Mar 2019 15:41:19 -0700 Subject: [PATCH 50/69] crontab: simplify logic max days of month. --- extra/crontab/crontab.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor index 329b2982a5..03bb49983c 100644 --- a/extra/crontab/crontab.factor +++ b/extra/crontab/crontab.factor @@ -50,10 +50,9 @@ CONSTANT: aliases H{ [ days-of-week>> [ 0 6 between? ] all? ] [ months>> [ 1 12 between? ] all? ] [ - [ days>> 1 ] [ months>> ] bi - dup { 2 } sequence= [ drop 29 ] [ - [ day-counts nth ] map supremum - ] if [ between? ] 2curry all? + [ days>> 1 ] [ months>> ] bi [ + { 0 31 29 31 30 31 30 31 31 30 31 30 31 } nth + ] map supremum [ between? ] 2curry all? ] [ minutes>> [ 0 59 between? ] all? ] [ hours>> [ 0 23 between? ] all? ] From ea4f0614616287a40d303cebcc66c0c7d8d00081 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Mon, 25 Mar 2019 00:30:40 +0100 Subject: [PATCH 51/69] prettyprint-docs: fix the slot accessors in a code example --- basis/prettyprint/prettyprint-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 03f3f93b1e..d91203bca5 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -126,7 +126,7 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol" "However, we can define three methods easily enough:" { $code "M: rect pprint-delims drop \\ RECT[ \\ ] ;" - "M: rect >pprint-sequence dup rect-w \\ * rot rect-h 3array ;" + "M: rect >pprint-sequence dup w>> \\ * rot h>> 3array ;" "M: rect pprint* pprint-object ;" } "Now, it will be printed in a custom way:" From bbd7a112f10f713c4b557639de723e005ed8b3b3 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Mon, 25 Mar 2019 00:54:50 +0100 Subject: [PATCH 52/69] prettyprint-docs: fix the obsolete parser code in an example --- basis/prettyprint/prettyprint-docs.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index d91203bca5..b9235f569c 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -113,10 +113,10 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol" "TUPLE: rect w h ;" "" "SYNTAX: RECT[" - " scan-word" - " scan-word \\ * assert=" - " scan-word" - " scan-word \\ ] assert=" + " scan-number" + " scan-token \"*\" assert=" + " scan-number" + " scan-token \"]\" assert=" " suffix! ;" } "An example literal might be:" From 6f58118afb8f9be31efdd8e4002f933444f730ad Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 25 Mar 2019 00:27:27 -0500 Subject: [PATCH 53/69] Config.linux: Better check for gcc. To print in make: $(info IS_GCC is $(IS_GCC)) --- vm/Config.linux | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vm/Config.linux b/vm/Config.linux index fae2cd4f0e..63089e42c1 100644 --- a/vm/Config.linux +++ b/vm/Config.linux @@ -6,8 +6,8 @@ LIBS = -ldl -lm -lrt -lpthread -Wl,--export-dynamic # clang spams warnings if we use -Wl,--no-as-needed with -c # -Wl,--no-as-needed is a gcc optimization, not required # we want to work with g++ aliased as c++ here, too -IS_GCC = $(shell $(CXX) --version | grep '(GCC)') +IS_GCC = $(shell $(CXX) --version | grep -o '(GCC)') -ifdef ($(IS_GCC)) +ifeq ($(IS_GCC), (GCC)) SITE_CFLAGS += -Wl,--no-as-needed endif From 88abc4e4c24a309f0ab5e8122a9c5c5168f4d383 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 28 Mar 2019 13:49:58 -0700 Subject: [PATCH 54/69] gravatar: wrapper for Gravatar.com service. --- extra/gravatar/authors.txt | 1 + extra/gravatar/gravatar.factor | 18 ++++++++++++++++++ extra/gravatar/summary.txt | 1 + 3 files changed, 20 insertions(+) create mode 100644 extra/gravatar/authors.txt create mode 100644 extra/gravatar/gravatar.factor create mode 100644 extra/gravatar/summary.txt diff --git a/extra/gravatar/authors.txt b/extra/gravatar/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/gravatar/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/gravatar/gravatar.factor b/extra/gravatar/gravatar.factor new file mode 100644 index 0000000000..8a068f1fa3 --- /dev/null +++ b/extra/gravatar/gravatar.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors assocs classes.tuple formatting http.client +images.http json.reader kernel sequences strings ; + +IN: gravatar + +TUPLE: info aboutMe accounts currentLocation displayName emails +hash id ims name phoneNumbers photos preferredUsername +profileBackground profileUrl requestHash thumbnailUrl urls ; + +: gravatar-info ( gravatar-id -- info ) + "http://gravatar.com/%s.json" sprintf http-get nip + >string json> "entry" of first info from-slots ; + +: gravatar. ( gravatar-id -- ) + gravatar-info thumbnailUrl>> http-image. ; diff --git a/extra/gravatar/summary.txt b/extra/gravatar/summary.txt new file mode 100644 index 0000000000..a0a5656049 --- /dev/null +++ b/extra/gravatar/summary.txt @@ -0,0 +1 @@ +Wrapper for the Gravatar service. From e2b689a636a0080eb8885be4939451b9af2d47b3 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Sat, 30 Mar 2019 00:53:54 +0100 Subject: [PATCH 55/69] windows.ole32: add a couple of constants --- basis/windows/dragdrop-listener/dragdrop-listener.factor | 2 -- basis/windows/ole32/ole32.factor | 3 +++ 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 4250c37aab..c63ba98014 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -7,8 +7,6 @@ ui.gestures windows.com windows.com.wrapper windows.dropfiles windows.kernel32 windows.ole32 windows.user32 ; IN: windows.dragdrop-listener -CONSTANT: E_OUTOFMEMORY -2147024882 ! 0x8007000e - : handle-data-object ( handler: ( hdrop -- x ) data-object -- filenames ) FORMATETC CF_HDROP >>cfFormat diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 84e3935ea5..e05af8703f 100644 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -33,8 +33,11 @@ CONSTANT: DRAGDROP_S_DROP 0x00040100 CONSTANT: DRAGDROP_S_CANCEL 0x00040101 CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102 +CONSTANT: E_NOTIMPL 0x80004001 CONSTANT: E_NOINTERFACE 0x80004002 CONSTANT: E_FAIL 0x80004005 +CONSTANT: E_UNEXPECTED 0x8000FFFF +CONSTANT: E_OUTOFMEMORY 0x8007000E CONSTANT: E_INVALIDARG 0x80070057 CONSTANT: MK_ALT 0x20 From 338b739f30928a286456225119158a00d95a28a4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 2 Apr 2019 17:26:50 -0700 Subject: [PATCH 56/69] base32: faster inverse operation. --- extra/base32/base32.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/base32/base32.factor b/extra/base32/base32.factor index 700b58e58f..ae9bf3e43b 100644 --- a/extra/base32/base32.factor +++ b/extra/base32/base32.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2019 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: ascii assocs kernel literals math sequences ; +USING: ascii assocs byte-arrays kernel literals math sequences ; IN: base32 byte-array ] >> +CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ] CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ] : normalize-base32 ( seq -- seq' ) @@ -20,7 +21,7 @@ CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ] } substitute ; : parse-base32 ( seq -- base32 ) - 0 swap [ [ 32 * ] [ ALPHABET index + ] bi* ] each ; + 0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ; PRIVATE> From 66652c490389a6fcb59e22879df91991b19d2a4b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 2 Apr 2019 17:31:41 -0700 Subject: [PATCH 57/69] geohash: adding first version of Geohash geocoding vocab. --- extra/geohash/authors.txt | 1 + extra/geohash/geohash-tests.factor | 10 +++++ extra/geohash/geohash.factor | 60 ++++++++++++++++++++++++++++++ extra/geohash/summary.txt | 1 + 4 files changed, 72 insertions(+) create mode 100644 extra/geohash/authors.txt create mode 100644 extra/geohash/geohash-tests.factor create mode 100644 extra/geohash/geohash.factor create mode 100644 extra/geohash/summary.txt diff --git a/extra/geohash/authors.txt b/extra/geohash/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/geohash/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/geohash/geohash-tests.factor b/extra/geohash/geohash-tests.factor new file mode 100644 index 0000000000..ef177f9de4 --- /dev/null +++ b/extra/geohash/geohash-tests.factor @@ -0,0 +1,10 @@ + +USING: geohash tools.test ; + +{ "tuvz4p141zc1" } [ 27.988056 86.925278 >geohash ] unit-test + +{ 27.9880559630692 86.92527785897255 } [ "tuvz4p141zc1" geohash> ] unit-test + +{ "u4pruydqqvj8" } [ 57.64911 10.40744 >geohash ] unit-test + +{ 57.48046875 10.1953125 } [ "u4pr" geohash> ] unit-test diff --git a/extra/geohash/geohash.factor b/extra/geohash/geohash.factor new file mode 100644 index 0000000000..993e62e9c5 --- /dev/null +++ b/extra/geohash/geohash.factor @@ -0,0 +1,60 @@ +! Copyright (C) 2019 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: byte-arrays fry kernel literals math math.bitwise +sequences ; + +IN: geohash + +integer 32 bits ] bi@ ; + +: spread-bits ( m -- n ) + dup 16 shift bitor 0x0000ffff0000ffff bitand + dup 8 shift bitor 0x00ff00ff00ff00ff bitand + dup 4 shift bitor 0x0f0f0f0f0f0f0f0f bitand + dup 2 shift bitor 0x3333333333333333 bitand + dup 1 shift bitor 0x5555555555555555 bitand ; + +: interleave-bits ( x y -- z ) + [ spread-bits ] bi@ 1 shift bitor ; + +: dequantize ( lat lon -- lat' lon' ) + [ 32 2^ /f ] bi@ [ 180.0 * 90 - ] [ 360.0 * 180.0 - ] bi* ; + +: squash-bits ( m -- n ) + 0x5555555555555555 bitand + dup -1 shift bitor 0x3333333333333333 bitand + dup -2 shift bitor 0x0f0f0f0f0f0f0f0f bitand + dup -4 shift bitor 0x00ff00ff00ff00ff bitand + dup -8 shift bitor 0x0000ffff0000ffff bitand + dup -16 shift bitor 0x00000000ffffffff bitand ; + +: deinterleave-bits ( z -- x y ) + dup -1 shift [ squash-bits ] bi@ ; + +<< +CONSTANT: base32-alphabet $[ "0123456789bcdefghjkmnpqrstuvwxyz" >byte-array ] +>> +CONSTANT: base32-inverse $[ 256 [ base32-alphabet index 0xff or ] B{ } map-integers ] + +: base32-encode ( x -- str ) + -59 12 [ + dupd [ shift 5 bits base32-alphabet nth ] keep 5 + swap + ] "" replicate-as 2nip ; + +: base32-decode ( str -- x ) + [ 0 59 ] dip [ + base32-inverse nth swap [ shift bitor ] keep 5 - + ] each drop ; + +PRIVATE> + +: >geohash ( lat lon -- geohash ) + quantize interleave-bits base32-encode ; + +: geohash> ( geohash -- lat lon ) + base32-decode deinterleave-bits dequantize ; diff --git a/extra/geohash/summary.txt b/extra/geohash/summary.txt new file mode 100644 index 0000000000..e6fde5ca6b --- /dev/null +++ b/extra/geohash/summary.txt @@ -0,0 +1 @@ +Geohash geocoding system. From a8b6d7bd4f491c7b2cb29caef1d73707c58dfd23 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 11:34:34 -0700 Subject: [PATCH 58/69] io.crlf: adding read-ignoring-crlf and read1-ignoring-crlf. --- basis/io/crlf/crlf-tests.factor | 13 +++++++++ basis/io/crlf/crlf.factor | 51 +++++++++++++++++++++++++++++---- 2 files changed, 59 insertions(+), 5 deletions(-) diff --git a/basis/io/crlf/crlf-tests.factor b/basis/io/crlf/crlf-tests.factor index c366f35242..f23eb55b63 100644 --- a/basis/io/crlf/crlf-tests.factor +++ b/basis/io/crlf/crlf-tests.factor @@ -13,3 +13,16 @@ USING: io.crlf tools.test io.streams.string io ; { "foo\nbar" } [ "foo\n\rbar" crlf>lf ] unit-test { "foo\r\nbar" } [ "foo\nbar" lf>crlf ] unit-test + +{ f } [ "" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: a } [ "a" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: b } [ "\nb" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: c } [ "\r\nc" [ read1-ignoring-crlf ] with-string-reader ] unit-test + +{ f } [ "" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "a" } [ "a" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "ab" } [ "a\nb" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abc" } [ "a\nb\r\nc" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcd" } [ "a\nb\r\ncd" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcde" } [ "a\nb\r\ncd\r\ne" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcde" } [ "a\nb\r\ncd\r\ne\nfghi" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor index f68c763422..9ab6f7dff9 100644 --- a/basis/io/crlf/crlf.factor +++ b/basis/io/crlf/crlf.factor @@ -1,21 +1,62 @@ ! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: io kernel sequences splitting ; +USING: byte-vectors io io.private kernel locals math namespaces +sbufs sequences splitting ; IN: io.crlf : crlf ( -- ) "\r\n" write ; +:: stream-read-crlf ( stream -- seq ) + "\r" stream stream-read-until [ + CHAR: \r assert= stream stream-read1 CHAR: \n assert= + ] [ f like ] if* ; + : read-crlf ( -- seq ) - "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] [ f like ] if* ; + input-stream get stream-read-crlf ; + +:: stream-read-?crlf ( stream -- seq ) + "\r\n" stream stream-read-until [ + CHAR: \r = [ stream stream-read1 CHAR: \n assert= ] when + ] [ f like ] if* ; : read-?crlf ( -- seq ) - "\r\n" read-until - [ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ; + input-stream get stream-read-?crlf ; : crlf>lf ( str -- str' ) CHAR: \r swap remove ; : lf>crlf ( str -- str' ) "\n" split "\r\n" join ; + +:: stream-read1-ignoring-crlf ( stream -- ch ) + stream stream-read1 dup "\r\n" member? + [ drop stream stream-read1-ignoring-crlf ] when ; inline recursive + +: read1-ignoring-crlf ( -- ch ) + input-stream get stream-read1-ignoring-crlf ; + +: push-ignoring-crlf ( elt seq -- ) + [ "\r\n" member? not ] swap push-if ; + +: push-all-ignoring-crlf ( src dst -- ) + [ push-ignoring-crlf ] curry each ; + +:: stream-read-ignoring-crlf ( n stream -- seq/f ) + n stream stream-read dup [ + dup [ "\r\n" member? ] any? [ + stream stream-element-type +byte+ = + [ n ] [ n ] if :> accum + accum push-all-ignoring-crlf + + [ accum length n < and ] [ + n accum length - stream stream-read + [ accum push-all-ignoring-crlf ] keep + ] do while + + accum stream stream-exemplar like + ] when + ] when ; + +: read-ignoring-crlf ( n -- seq/f ) + input-stream get stream-read-ignoring-crlf ; From ab88710e743a68d5b5e302c6b5178c768dd073ad Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 12:03:00 -0700 Subject: [PATCH 59/69] base64: adding urlsafe base64 and specify RFC 3548. --- basis/base64/base64-tests.factor | 6 ++++++ basis/base64/base64.factor | 28 ++++++++++++++++++++++++---- basis/base64/summary.txt | 2 +- 3 files changed, 31 insertions(+), 5 deletions(-) diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor index a63f6b3bc6..e3ab35d250 100644 --- a/basis/base64/base64-tests.factor +++ b/basis/base64/base64-tests.factor @@ -39,3 +39,9 @@ sequences splitting strings tools.test ; "eyJhbGciOiJIUzI1NiJ9.eyJzdWIiOiJKb2UifQ.ipevRNuRP6HflG8cFKnmUPtypruRC4fb1DWtoLL62SY" "." split [ base64> ] map ] unit-test + +{ "01a+b/cd" } [ "\xd3V\xbeo\xf7\x1d" >base64 "" like ] unit-test +{ "\xd3V\xbeo\xf7\x1d" } [ "01a+b/cd" base64> "" like ] unit-test + +{ "01a-b_cd" } [ "\xd3V\xbeo\xf7\x1d" >urlsafe-base64 "" like ] unit-test +{ "\xd3V\xbeo\xf7\x1d" } [ "01a-b_cd" urlsafe-base64> "" like ] unit-test diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index 717a9e0d06..aff50fb230 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators fry io io.binary io.encodings.binary -io.streams.byte-array kernel literals math namespaces sbufs -sequences ; +USING: arrays assocs byte-arrays combinators fry io io.binary +io.encodings.binary io.streams.byte-array kernel literals math +namespaces sbufs sequences ; IN: base64 ERROR: malformed-base64 ; @@ -10,8 +10,10 @@ ERROR: malformed-base64 ; byte-array +] : alphabet-inverse ( alphabet -- seq ) dup supremum 1 + f [ @@ -100,3 +102,21 @@ PRIVATE> : >base64-lines ( seq -- base64 ) binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ; + +: >urlsafe-base64 ( seq -- base64 ) + >base64 H{ + { CHAR: + CHAR: - } + { CHAR: / CHAR: _ } + } substitute ; + +: urlsafe-base64> ( base64 -- seq ) + H{ + { CHAR: - CHAR: + } + { CHAR: _ CHAR: / } + } substitute base64> ; + +: >urlsafe-base64-lines ( seq -- base64 ) + >base64-lines H{ + { CHAR: + CHAR: - } + { CHAR: / CHAR: _ } + } substitute ; diff --git a/basis/base64/summary.txt b/basis/base64/summary.txt index 89950e2a7b..487909bb72 100644 --- a/basis/base64/summary.txt +++ b/basis/base64/summary.txt @@ -1 +1 @@ -Base64 encoding/decoding +Base64 encoding/decoding (RFC 3548) From d53ef800e2efc3f2d2c011891c931c6a7c94ff9c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 12:05:21 -0700 Subject: [PATCH 60/69] base32: change to RFC 3548 version. --- extra/base32/base32-tests.factor | 32 ++++++------ extra/base32/base32.factor | 85 ++++++++++++++++++++++---------- extra/base32/summary.txt | 2 +- 3 files changed, 78 insertions(+), 41 deletions(-) diff --git a/extra/base32/base32-tests.factor b/extra/base32/base32-tests.factor index c77d0f2147..b44dc7b751 100644 --- a/extra/base32/base32-tests.factor +++ b/extra/base32/base32-tests.factor @@ -1,20 +1,22 @@ ! Copyright (C) 2019 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: base32 tools.test ; +USING: base32 sequences tools.test ; -{ "16J" } [ 1234 base32> ] unit-test -{ "16JD" } [ 1234 base32-checksum> ] unit-test -{ "0" } [ 0 base32> ] unit-test -{ "00" } [ 0 base32-checksum> ] unit-test -[ -1 base32> ] must-fail -[ 1.0 base32> ] must-fail +{ B{ } } [ f >base32 ] unit-test +{ B{ } } [ B{ } >base32 ] unit-test +{ "AA======" } [ "\0" >base32 "" like ] unit-test +{ "ME======" } [ "a" >base32 "" like ] unit-test +{ "MFRA====" } [ "ab" >base32 "" like ] unit-test +{ "MFRGG===" } [ "abc" >base32 "" like ] unit-test +{ "MFRGGZA=" } [ "abcd" >base32 "" like ] unit-test +{ "MFRGGZDF" } [ "abcde" >base32 "" like ] unit-test -{ 1234 } [ "16J" >base32 ] unit-test -{ 1234 } [ "I6J" >base32 ] unit-test -{ 1234 } [ "i6J" >base32 ] unit-test -{ 1234 } [ "16JD" >base32-checksum ] unit-test -{ 1234 } [ "I6JD" >base32-checksum ] unit-test -{ 1234 } [ "i6JD" >base32-checksum ] unit-test -{ 0 } [ "0" >base32 ] unit-test -{ 0 } [ "00" >base32-checksum ] unit-test +{ B{ } } [ f base32> ] unit-test +{ B{ } } [ B{ } base32> ] unit-test +{ "\0" } [ "AA======" base32> "" like ] unit-test +{ "a" } [ "ME======" base32> "" like ] unit-test +{ "ab" } [ "MFRA====" base32> "" like ] unit-test +{ "abc" } [ "MFRGG===" base32> "" like ] unit-test +{ "abcd" } [ "MFRGGZA=" base32> "" like ] unit-test +{ "abcde" } [ "MFRGGZDF" base32> "" like ] unit-test diff --git a/extra/base32/base32.factor b/extra/base32/base32.factor index ae9bf3e43b..b0681488de 100644 --- a/extra/base32/base32.factor +++ b/extra/base32/base32.factor @@ -1,42 +1,77 @@ ! Copyright (C) 2019 John Benediktsson ! See http://factorcode.org/license.txt for BSD license - -USING: ascii assocs byte-arrays kernel literals math sequences ; - +USING: base64.private byte-arrays combinators fry io io.binary +io.encodings.binary io.streams.byte-array kernel literals math +namespaces sequences ; IN: base32 +ERROR: malformed-base32 ; + +! XXX: Optional map 0 as O +! XXX: Optional map 1 as L or I +! XXX: Optional handle lower-case input + byte-array ] +CONSTANT: alphabet $[ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567" >byte-array ] >> -CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ] -CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ] -: normalize-base32 ( seq -- seq' ) - CHAR: - swap remove >upper H{ - { CHAR: I CHAR: 1 } - { CHAR: L CHAR: 1 } - { CHAR: O CHAR: 0 } - } substitute ; +: ch>base32 ( ch -- ch ) + alphabet nth ; inline -: parse-base32 ( seq -- base32 ) - 0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ; +: base32>ch ( ch -- ch ) + $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth + [ malformed-base32 ] unless* ; inline + +: encode5 ( seq -- byte-array ) + be> { -35 -30 -25 -20 -15 -10 -5 0 } '[ + shift 0x1f bitand ch>base32 + ] with B{ } map-as ; inline + +: encode-pad ( seq n -- byte-array ) + [ 5 0 pad-tail encode5 ] [ B{ 0 2 4 5 7 } nth ] bi* head-slice + 8 CHAR: = pad-tail ; inline + +: (encode-base32) ( stream column -- ) + 5 pick stream-read dup length { + { 0 [ 3drop ] } + { 5 [ encode5 write-lines (encode-base32) ] } + [ encode-pad write-lines (encode-base32) ] + } case ; PRIVATE> +: encode-base32 ( -- ) + input-stream get f (encode-base32) ; + +: encode-base32-lines ( -- ) + input-stream get 0 (encode-base32) ; + +ch swap 5 shift bitor ] reduce 5 >be ] + [ [ CHAR: = = ] count ] bi + [ write ] [ B{ 0 4 0 3 2 0 1 } nth head-slice write ] if-zero ; inline + +: (decode-base32) ( stream -- ) + 8 "\n\r" pick read-ignoring dup length { + { 0 [ 2drop ] } + { 8 [ decode8 (decode-base32) ] } + [ drop 8 CHAR: = pad-tail decode8 (decode-base32) ] + } case ; + +PRIVATE> + +: decode-base32 ( -- ) + input-stream get (decode-base32) ; + : >base32 ( seq -- base32 ) - normalize-base32 parse-base32 ; + binary [ binary [ encode-base32 ] with-byte-reader ] with-byte-writer ; : base32> ( base32 -- seq ) - dup 0 < [ non-negative-integer-expected ] when - [ dup 0 > ] [ - 32 /mod ALPHABET nth - ] "" produce-as nip [ "0" ] when-empty reverse! ; + binary [ binary [ decode-base32 ] with-byte-reader ] with-byte-writer ; -: >base32-checksum ( seq -- base32 ) - normalize-base32 unclip-last [ parse-base32 ] dip - CHECKSUM index over 37 mod assert= ; - -: base32-checksum> ( base32 -- seq ) - [ base32> ] keep 37 mod CHECKSUM nth suffix ; +: >base32-lines ( seq -- base32 ) + binary [ binary [ encode-base32-lines ] with-byte-reader ] with-byte-writer ; diff --git a/extra/base32/summary.txt b/extra/base32/summary.txt index 97327ad820..509166d694 100644 --- a/extra/base32/summary.txt +++ b/extra/base32/summary.txt @@ -1 +1 @@ -Douglas Crockford's Base 32 encoding/decoding +Base 32 encoding/decoding (RFC 3548) From 77c5a4b7fff7cfcd086f5b130b56fe5b0739a2ef Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 12:10:33 -0700 Subject: [PATCH 61/69] base32: adding authors.txt --- extra/base32/authors.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 extra/base32/authors.txt diff --git a/extra/base32/authors.txt b/extra/base32/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/base32/authors.txt @@ -0,0 +1 @@ +John Benediktsson From 83d6c5b382f2e1d9202a3ef0299829b2ea78c105 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 12:10:52 -0700 Subject: [PATCH 62/69] base32-crockford: separate Douglas Crockford version of Base 32. --- extra/base32-crockford/authors.txt | 1 + .../base32-crockford-tests.factor | 20 +++++++++ .../base32-crockford/base32-crockford.factor | 43 +++++++++++++++++++ extra/base32-crockford/summary.txt | 1 + 4 files changed, 65 insertions(+) create mode 100644 extra/base32-crockford/authors.txt create mode 100644 extra/base32-crockford/base32-crockford-tests.factor create mode 100644 extra/base32-crockford/base32-crockford.factor create mode 100644 extra/base32-crockford/summary.txt diff --git a/extra/base32-crockford/authors.txt b/extra/base32-crockford/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/base32-crockford/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/base32-crockford/base32-crockford-tests.factor b/extra/base32-crockford/base32-crockford-tests.factor new file mode 100644 index 0000000000..b1e3b8c17f --- /dev/null +++ b/extra/base32-crockford/base32-crockford-tests.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2019 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: base32-crockford tools.test ; + +{ "16J" } [ 1234 base32-crockford> ] unit-test +{ "16JD" } [ 1234 base32-crockford-checksum> ] unit-test +{ "0" } [ 0 base32-crockford> ] unit-test +{ "00" } [ 0 base32-crockford-checksum> ] unit-test +[ -1 base32-crockford> ] must-fail +[ 1.0 base32-crockford> ] must-fail + +{ 1234 } [ "16J" >base32-crockford ] unit-test +{ 1234 } [ "I6J" >base32-crockford ] unit-test +{ 1234 } [ "i6J" >base32-crockford ] unit-test +{ 1234 } [ "16JD" >base32-crockford-checksum ] unit-test +{ 1234 } [ "I6JD" >base32-crockford-checksum ] unit-test +{ 1234 } [ "i6JD" >base32-crockford-checksum ] unit-test +{ 0 } [ "0" >base32-crockford ] unit-test +{ 0 } [ "00" >base32-crockford-checksum ] unit-test diff --git a/extra/base32-crockford/base32-crockford.factor b/extra/base32-crockford/base32-crockford.factor new file mode 100644 index 0000000000..994159388b --- /dev/null +++ b/extra/base32-crockford/base32-crockford.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2019 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: ascii assocs byte-arrays kernel literals math sequences ; + +IN: base32-crockford + +byte-array ] +>> + +CONSTANT: INVERSE $[ 256 [ ALPHABET index 0xff or ] B{ } map-integers ] + +CONSTANT: CHECKSUM $[ ALPHABET "*~$=U" append ] + +: normalize-base32 ( seq -- seq' ) + CHAR: - swap remove >upper H{ + { CHAR: I CHAR: 1 } + { CHAR: L CHAR: 1 } + { CHAR: O CHAR: 0 } + } substitute ; + +: parse-base32 ( seq -- base32 ) + 0 swap [ [ 32 * ] [ INVERSE nth + ] bi* ] each ; + +PRIVATE> + +: >base32-crockford ( seq -- base32 ) + normalize-base32 parse-base32 ; + +: base32-crockford> ( base32 -- seq ) + dup 0 < [ non-negative-integer-expected ] when + [ dup 0 > ] [ 32 /mod ALPHABET nth ] "" produce-as nip + [ "0" ] when-empty reverse! ; + +: >base32-crockford-checksum ( seq -- base32 ) + normalize-base32 unclip-last [ parse-base32 ] dip + CHECKSUM index over 37 mod assert= ; + +: base32-crockford-checksum> ( base32 -- seq ) + [ base32-crockford> ] keep 37 mod CHECKSUM nth suffix ; diff --git a/extra/base32-crockford/summary.txt b/extra/base32-crockford/summary.txt new file mode 100644 index 0000000000..97327ad820 --- /dev/null +++ b/extra/base32-crockford/summary.txt @@ -0,0 +1 @@ +Douglas Crockford's Base 32 encoding/decoding From 103b15df9750dcbf861a13093d63ce60129dde7b Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 13:03:19 -0700 Subject: [PATCH 63/69] base85: change alphabet to byte-array. --- extra/base85/base85.factor | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/extra/base85/base85.factor b/extra/base85/base85.factor index 40088ff40f..5e21d73222 100644 --- a/extra/base85/base85.factor +++ b/extra/base85/base85.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2013 John Benediktsson. ! See http://factorcode.org/license.txt for BSD license. -USING: base64.private combinators io io.binary +USING: base64.private byte-arrays combinators io io.binary io.encodings.binary io.streams.byte-array kernel literals math namespaces sequences ; IN: base85 @@ -10,9 +10,12 @@ ERROR: malformed-base85 ; ?@^_`{|}~" + >byte-array +] >> + : ch>base85 ( ch -- ch ) alphabet nth ; inline From d89d4590ab671c6c1e4ad6bb4ce33dc3183b3f3f Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 13:04:01 -0700 Subject: [PATCH 64/69] game-of-life: adding deploy file. --- extra/game-of-life/deploy.factor | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 extra/game-of-life/deploy.factor diff --git a/extra/game-of-life/deploy.factor b/extra/game-of-life/deploy.factor new file mode 100644 index 0000000000..a5b200b481 --- /dev/null +++ b/extra/game-of-life/deploy.factor @@ -0,0 +1,16 @@ +USING: tools.deploy.config ; +H{ + { deploy-console? f } + { deploy-io 3 } + { deploy-reflection 5 } + { deploy-ui? t } + { deploy-word-defs? f } + { deploy-threads? t } + { "stop-after-last-window?" t } + { deploy-math? t } + { deploy-word-props? f } + { deploy-c-types? f } + { deploy-help? f } + { deploy-name "Game of Life" } + { deploy-unicode? f } +} From fa1f9aa5a05445988779fae1d85931292b2fec9c Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 13:38:00 -0700 Subject: [PATCH 65/69] base64/32/85: adding tests for all byte values. --- basis/base64/base64-tests.factor | 6 ++++-- extra/base32/base32-tests.factor | 4 +++- extra/base85/base85-tests.factor | 5 ++--- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/basis/base64/base64-tests.factor b/basis/base64/base64-tests.factor index e3ab35d250..8821f9654c 100644 --- a/basis/base64/base64-tests.factor +++ b/basis/base64/base64-tests.factor @@ -1,5 +1,7 @@ -USING: base64 io.encodings.ascii io.encodings.string kernel -sequences splitting strings tools.test ; +USING: base64 byte-arrays io.encodings.ascii io.encodings.string +kernel sequences splitting strings tools.test ; + +{ t } [ 256 >byte-array dup >base64 base64> = ] unit-test { "abcdefghijklmnopqrstuvwxyz" } [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode ] unit-test diff --git a/extra/base32/base32-tests.factor b/extra/base32/base32-tests.factor index b44dc7b751..da311af0e3 100644 --- a/extra/base32/base32-tests.factor +++ b/extra/base32/base32-tests.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2019 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: base32 sequences tools.test ; +USING: base32 byte-arrays kernel sequences tools.test ; + +{ t } [ 256 >byte-array dup >base32 base32> = ] unit-test { B{ } } [ f >base32 ] unit-test { B{ } } [ B{ } >base32 ] unit-test diff --git a/extra/base85/base85-tests.factor b/extra/base85/base85-tests.factor index 4f1ebd6193..2469281995 100644 --- a/extra/base85/base85-tests.factor +++ b/extra/base85/base85-tests.factor @@ -1,7 +1,6 @@ -USING: base85 kernel strings tools.test ; +USING: base85 byte-arrays kernel sequences strings tools.test ; -{ t } [ "Hello, world" dup >base85 base85> >string = ] unit-test -{ t } [ "ready" dup >base85 base85> >string = ] unit-test +{ t } [ 256 >byte-array dup >base85 base85> = ] unit-test { "NM!" } [ "He" >base85 >string ] unit-test { t } [ "He" dup >base85 base85> >string = ] unit-test From 38e8c5aeb1eba47415ce05dea2512337f040e9f9 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 13:40:23 -0700 Subject: [PATCH 66/69] base16: adding RFC 3548 version of base 16 encoding/decoding. --- extra/base16/authors.txt | 1 + extra/base16/base16-tests.factor | 14 ++++++++ extra/base16/base16.factor | 57 ++++++++++++++++++++++++++++++++ extra/base16/summary.txt | 1 + 4 files changed, 73 insertions(+) create mode 100644 extra/base16/authors.txt create mode 100644 extra/base16/base16-tests.factor create mode 100644 extra/base16/base16.factor create mode 100644 extra/base16/summary.txt diff --git a/extra/base16/authors.txt b/extra/base16/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/base16/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/base16/base16-tests.factor b/extra/base16/base16-tests.factor new file mode 100644 index 0000000000..890fde8bf4 --- /dev/null +++ b/extra/base16/base16-tests.factor @@ -0,0 +1,14 @@ +USING: base16 byte-arrays kernel sequences tools.test ; + +{ t } [ 256 >byte-array dup >base16 base16> = ] unit-test + +{ "00" } [ B{ 0 } >base16 "" like ] unit-test +{ "01" } [ B{ 1 } >base16 "" like ] unit-test +{ "0102" } [ B{ 1 2 } >base16 "" like ] unit-test + +{ B{ 0 } } [ "00" base16> ] unit-test +{ B{ 1 } } [ "01" base16> ] unit-test +{ B{ 1 2 } } [ "0102" base16> ] unit-test + +[ "0" base16> ] [ malformed-base16? ] must-fail-with +[ "Z" base16> ] [ malformed-base16? ] must-fail-with diff --git a/extra/base16/base16.factor b/extra/base16/base16.factor new file mode 100644 index 0000000000..2889059503 --- /dev/null +++ b/extra/base16/base16.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2019 John Benediktsson. +! See http://factorcode.org/license.txt for BSD license. +USING: base64.private byte-arrays combinators io +io.encodings.binary io.streams.byte-array kernel literals locals +math namespaces sequences ; +IN: base16 + +ERROR: malformed-base16 ; + +! XXX: Optional handle lower-case input + +byte-array ] +>> + +: ch>base16 ( ch -- ch ) + alphabet nth ; inline + +: base16>ch ( ch -- ch ) + $[ alphabet alphabet-inverse ] nth + [ malformed-base16 ] unless* ; inline + +:: (encode-base16) ( stream -- ) + stream stream-read1 [ + 16 /mod [ ch>base16 write1 ] bi@ + stream (encode-base16) + ] when* ; + +PRIVATE> + +: encode-base16 ( -- ) + input-stream get (encode-base16) ; + +ch ] bi@ [ 16 * ] [ + ] bi* ; + +:: (decode-base16) ( stream -- ) + 2 stream stream-read dup length { + { 0 [ drop ] } + { 2 [ decode2 write1 stream (decode-base16) ] } + [ malformed-base16 ] + } case ; + +PRIVATE> + +: decode-base16 ( -- ) + input-stream get (decode-base16) ; + +: >base16 ( seq -- base16 ) + binary [ binary [ encode-base16 ] with-byte-reader ] with-byte-writer ; + +: base16> ( base16 -- seq ) + binary [ binary [ decode-base16 ] with-byte-reader ] with-byte-writer ; diff --git a/extra/base16/summary.txt b/extra/base16/summary.txt new file mode 100644 index 0000000000..bd04219984 --- /dev/null +++ b/extra/base16/summary.txt @@ -0,0 +1 @@ +Base 16 encoding/decoding (RFC 3548) From 824fc16a0f4ec3f29e5220b737b642670086d935 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 13:43:05 -0700 Subject: [PATCH 67/69] base91: adding version of base91 encoding/decoding. --- extra/base91/authors.txt | 1 + extra/base91/base91-tests.factor | 23 +++++++++ extra/base91/base91.factor | 83 ++++++++++++++++++++++++++++++++ extra/base91/summary.txt | 1 + 4 files changed, 108 insertions(+) create mode 100644 extra/base91/authors.txt create mode 100644 extra/base91/base91-tests.factor create mode 100644 extra/base91/base91.factor create mode 100644 extra/base91/summary.txt diff --git a/extra/base91/authors.txt b/extra/base91/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/base91/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/base91/base91-tests.factor b/extra/base91/base91-tests.factor new file mode 100644 index 0000000000..040599a04d --- /dev/null +++ b/extra/base91/base91-tests.factor @@ -0,0 +1,23 @@ +USING: base91 byte-arrays kernel sequences tools.test ; + +{ t } [ 256 >byte-array dup >base91 base91> = ] unit-test + +{ B{ } } [ f >base91 ] unit-test +{ "AA" } [ B{ 0 } >base91 "" like ] unit-test +{ "GB" } [ "a" >base91 "" like ] unit-test +{ "#GD" } [ "ab" >base91 "" like ] unit-test +{ "#G(I" } [ "abc" >base91 "" like ] unit-test +{ "#G(IZ" } [ "abcd" >base91 "" like ] unit-test +{ "#G(Ic,A" } [ "abcde" >base91 "" like ] unit-test +{ "#G(Ic,WC" } [ "abcdef" >base91 "" like ] unit-test +{ "#G(Ic,5pG" } [ "abcdefg" >base91 "" like ] unit-test + +{ B{ } } [ f base91> ] unit-test +{ "\0" } [ "AA" base91> "" like ] unit-test +{ "a" } [ "GB" base91> "" like ] unit-test +{ "ab" } [ "#GD" base91> "" like ] unit-test +{ "abc" } [ "#G(I" base91> "" like ] unit-test +{ "abcd" } [ "#G(IZ" base91> "" like ] unit-test +{ "abcde" } [ "#G(Ic,A" base91> "" like ] unit-test +{ "abcdef" } [ "#G(Ic,WC" base91> "" like ] unit-test +{ "abcdefg" } [ "#G(Ic,5pG" base91> "" like ] unit-test diff --git a/extra/base91/base91.factor b/extra/base91/base91.factor new file mode 100644 index 0000000000..05a07842fe --- /dev/null +++ b/extra/base91/base91.factor @@ -0,0 +1,83 @@ +! Copyright (C) 2019 John Benediktsson. +! See http://factorcode.org/license.txt for BSD license. +USING: base64.private byte-arrays kernel literals locals math +sequences ; +IN: base91 + +ERROR: malformed-base91 ; + +?@[]^_`{|}~\"" + >byte-array +] +>> + +: ch>base91 ( ch -- ch ) + alphabet nth ; inline + +: base91>ch ( ch -- ch ) + $[ alphabet alphabet-inverse ] nth + [ malformed-base91 ] unless* ; inline + +PRIVATE> + +:: >base91 ( seq -- base91 ) + 0 :> b! + 0 :> n! + BV{ } clone :> accum + + seq [ + n shift b bitor b! + n 8 + n! + n 13 > [ + b 0x1fff bitand dup 88 > [ + b -13 shift b! + n 13 - n! + ] [ + drop b 0x3fff bitand + b -14 shift b! + n 14 - n! + ] if 91 /mod swap [ ch>base91 accum push ] bi@ + ] when + ] each + + n 0 > [ + b 91 mod ch>base91 accum push + n 7 > b 90 > or [ + b 91 /i ch>base91 accum push + ] when + ] when + + accum B{ } like ; + +:: base91> ( base91 -- seq ) + f :> v! + 0 :> b! + 0 :> n! + BV{ } clone :> accum + + base91 [ + base91>ch + v [ + 91 * v + v! + v n shift b bitor b! + v 0x1fff bitand 88 > 13 14 ? n + n! + [ n 7 > ] [ + b 0xff bitand accum push + b -8 shift b! + n 8 - n! + ] do while + f v! + ] [ + v! + ] if + ] each + + v [ + b v n shift bitor 0xff bitand accum push + ] when + + accum B{ } like ; diff --git a/extra/base91/summary.txt b/extra/base91/summary.txt new file mode 100644 index 0000000000..cb9b5c7fcf --- /dev/null +++ b/extra/base91/summary.txt @@ -0,0 +1 @@ +Base91 encoding/decoding From d248f2452e56de3825b55cc4c50b50e8301198e4 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 5 Apr 2019 16:55:10 -0700 Subject: [PATCH 68/69] combinators: faster hashcode for byte-arrays. --- core/combinators/combinators.factor | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index c1fef4287a..4e44dfe5ae 100644 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006, 2010 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs hashtables kernel kernel.private -make math math.order math.private quotations sequences -sequences.private sets sorting words ; +USING: accessors arrays assocs byte-arrays hashtables kernel +kernel.private make math math.order math.private quotations +sequences sequences.private sets sorting words ; IN: combinators ! Most of these combinators have compile-time expansions in @@ -198,6 +198,8 @@ M: sequence hashcode* [ sequence-hashcode ] recursive-hashcode ; M: array hashcode* [ sequence-hashcode ] recursive-hashcode ; +M: byte-array hashcode* [ sequence-hashcode ] recursive-hashcode ; + M: reversed hashcode* [ sequence-hashcode ] recursive-hashcode ; M: slice hashcode* [ sequence-hashcode ] recursive-hashcode ; From 3f777a6fdd85594bde6d832a34a49bdde65b78c0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Apr 2019 11:39:07 -0500 Subject: [PATCH 69/69] tools: use base91 instead of base85 --- basis/tools/directory-to-file/directory-to-file.factor | 6 +++--- basis/tools/file-to-directory/file-to-directory.factor | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/tools/directory-to-file/directory-to-file.factor b/basis/tools/directory-to-file/directory-to-file.factor index aaab9e17e8..e8bc9c061e 100644 --- a/basis/tools/directory-to-file/directory-to-file.factor +++ b/basis/tools/directory-to-file/directory-to-file.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2018 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: base85 combinators command-line escape-strings fry +USING: base91 combinators command-line escape-strings fry io.backend io.directories io.directories.search io.encodings.binary io.encodings.utf8 io.files io.files.info io.pathnames kernel locals math namespaces sequences @@ -28,9 +28,9 @@ IN: tools.directory-to-file { [ dup file-info directory? ] [ directory-repr ] } { [ dup file-is-text? ] [ dup utf8 file-contents escape-string file-repr ] } [ - dup binary file-contents >base85 + dup binary file-contents >base91 "" like escape-string - "base85" prepend file-repr + "base91" prepend file-repr ] } cond ] map diff --git a/basis/tools/file-to-directory/file-to-directory.factor b/basis/tools/file-to-directory/file-to-directory.factor index c19ced5e0b..fed7027353 100644 --- a/basis/tools/file-to-directory/file-to-directory.factor +++ b/basis/tools/file-to-directory/file-to-directory.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2018 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: base85 combinators command-line fry io.directories +USING: base91 combinators command-line fry io.directories io.encodings.binary io.encodings.utf8 io.files io.pathnames kernel modern modern.out namespaces sequences splitting strings ; IN: tools.file-to-directory @@ -18,8 +18,8 @@ ERROR: expected-modern-path got ; [ second first2 [ second >string ] [ - first3 nip swap "base85" head? [ - base85> binary + first3 nip swap "base91" head? [ + base91> binary ] [ utf8 ] if