From f09547ece13321bcc61dd1fa733daf02909472b5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 17:47:04 -0500 Subject: [PATCH 1/6] Fix mirrors docs --- core/mirrors/mirrors-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/mirrors/mirrors-docs.factor b/core/mirrors/mirrors-docs.factor index 29ed153a2e..725a757e61 100755 --- a/core/mirrors/mirrors-docs.factor +++ b/core/mirrors/mirrors-docs.factor @@ -36,7 +36,7 @@ HELP: "TUPLE: circle center radius ;" "C: circle" "{ 100 50 } 15 >alist ." - "{ { \"center\" { 100 50 } } { \"radius\" 15 } }" + "{ { \"delegate\" f } { \"center\" { 100 50 } } { \"radius\" 15 } }" } } ; From 7616eefbfcadc3c4ef551702788267372b4b2782 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Mar 2008 18:00:55 -0500 Subject: [PATCH 2/6] Fix editor integration --- extra/editors/editors.factor | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 89aef4d819..67e515ebc1 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -25,11 +25,8 @@ SYMBOL: edit-hook require ; : edit-location ( file line -- ) - edit-hook get [ - call - ] [ - no-edit-hook edit-location - ] if* ; + >r current-directory get prepend-path r> + edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; : edit ( defspec -- ) where [ first2 edit-location ] when* ; From d8fc44662286db830264df286be0bb84e91151c0 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 18:13:55 -0500 Subject: [PATCH 3/6] add unit tests and fix lots of words for normalize-pathname --- core/io/files/files-tests.factor | 50 ++++++++++++++++++++++++++++++++ extra/io/unix/files/files.factor | 18 +++++++----- 2 files changed, 60 insertions(+), 8 deletions(-) diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index b732495541..b78f7667a6 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -7,6 +7,56 @@ io.encodings.utf8 ; [ ] [ "blahblah" temp-file make-directory ] unit-test [ t ] [ "blahblah" temp-file directory? ] unit-test +[ t ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + ] with-directory + temp-directory "loldir" append-path exists? +] unit-test + +[ ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "loldir" make-directory + "loldir" delete-directory + ] with-directory +] unit-test + +[ "file1 contents" ] [ + [ temp-directory "loldir" append-path delete-directory ] ignore-errors + temp-directory [ + "file1 contents" "file1" utf8 set-file-contents + "file1" "file2" copy-file + "file2" utf8 file-contents + ] with-directory + "file1" temp-file delete-file + "file2" temp-file delete-file +] unit-test + +[ "file3 contents" ] [ + temp-directory [ + "file3 contents" "file3" utf8 set-file-contents + "file3" "file4" move-file + "file4" utf8 file-contents + ] with-directory + "file4" temp-file delete-file +] unit-test + +[ ] [ + temp-directory [ + "file5" touch-file + "file5" delete-file + ] with-directory +] unit-test + +[ ] [ + temp-directory [ + "file6" touch-file + "file6" link-info drop + ] with-directory +] unit-test + [ "passwd" ] [ "/etc/passwd" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test [ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 2888231e20..ca5d7a7bf1 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -7,11 +7,11 @@ calendar io.encodings.binary ; IN: io.unix.files -M: unix-io cwd +M: unix-io cwd ( -- path ) MAXPATHLEN [ ] [ ] bi getcwd [ (io-error) ] unless* ; -M: unix-io cd +M: unix-io cd ( path -- ) chdir io-error ; : read-flags O_RDONLY ; inline @@ -39,25 +39,26 @@ M: unix-io (file-writer) ( path -- stream ) M: unix-io (file-appender) ( path -- stream ) open-append ; -: touch-mode +: touch-mode ( -- n ) { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable M: unix-io touch-file ( path -- ) + normalize-pathname touch-mode file-mode open dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when close ; M: unix-io move-file ( from to -- ) - rename io-error ; + [ normalize-pathname ] 2apply rename io-error ; M: unix-io delete-file ( path -- ) - unlink io-error ; + normalize-pathname unlink io-error ; M: unix-io make-directory ( path -- ) - OCT: 777 mkdir io-error ; + normalize-pathname OCT: 777 mkdir io-error ; M: unix-io delete-directory ( path -- ) - rmdir io-error ; + normalize-pathname rmdir io-error ; : (copy-file) ( from to -- ) dup parent-directory make-directories @@ -68,8 +69,9 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) + [ normalize-pathname ] 2apply [ (copy-file) ] - [ swap file-info file-info-permissions chmod io-error ] + [ swap file-info file-info-permissions chmod io-error ] 2bi ; : stat>type ( stat -- type ) From b2a430629b2121fd764031d36f7a8b92001fb51d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 14:55:04 -0500 Subject: [PATCH 4/6] fix wordpad --- extra/editors/editors.factor | 7 ++++--- extra/editors/wordpad/wordpad.factor | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/extra/editors/editors.factor b/extra/editors/editors.factor index 67e515ebc1..bfbfe1b6ca 100755 --- a/extra/editors/editors.factor +++ b/extra/editors/editors.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel namespaces sequences definitions io.files inspector continuations tuples tools.crossref tools.vocabs -io prettyprint source-files assocs vocabs vocabs.loader ; +io prettyprint source-files assocs vocabs vocabs.loader +io.backend splitting ; IN: editors TUPLE: no-edit-hook ; @@ -25,7 +26,7 @@ SYMBOL: edit-hook require ; : edit-location ( file line -- ) - >r current-directory get prepend-path r> + >r normalize-pathname "\\\\?\\" ?head drop r> edit-hook get [ call ] [ no-edit-hook edit-location ] if* ; : edit ( defspec -- ) diff --git a/extra/editors/wordpad/wordpad.factor b/extra/editors/wordpad/wordpad.factor index d1f979e0f3..3f3dd6cab1 100755 --- a/extra/editors/wordpad/wordpad.factor +++ b/extra/editors/wordpad/wordpad.factor @@ -5,10 +5,10 @@ IN: editors.wordpad : wordpad-path ( -- path ) \ wordpad-path get [ - program-files "\\Windows NT\\Accessories\\wordpad.exe" append-path + program-files "Windows NT\\Accessories\\wordpad.exe" append-path ] unless* ; : wordpad ( file line -- ) - drop wordpad-path swap 2array run-detached drop ; + drop wordpad-path swap 2array dup . run-detached drop ; [ wordpad ] edit-hook set-global From 8939dd49718c6573e674fb5d7e1914f05ec8b137 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 26 Mar 2008 14:57:35 -0500 Subject: [PATCH 5/6] add path-separator --- core/io/files/files.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 60943be48c..48098e612d 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -45,6 +45,8 @@ HOOK: (file-appender) io-backend ( path -- stream ) ! Pathnames : path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; +: path-separator ( -- string ) windows? "\\" "/" ? ; + : right-trim-separators ( str -- newstr ) [ path-separator? ] right-trim ; From 36f51b46f252ba639264f3c3fc40e7374f5459a0 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 27 Mar 2008 19:06:24 -0500 Subject: [PATCH 6/6] fix ultraedit --- extra/editors/ultraedit/ultraedit.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/editors/ultraedit/ultraedit.factor b/extra/editors/ultraedit/ultraedit.factor index 1fef9f3350..d0bb789c1b 100755 --- a/extra/editors/ultraedit/ultraedit.factor +++ b/extra/editors/ultraedit/ultraedit.factor @@ -5,7 +5,7 @@ IN: editors.ultraedit : ultraedit-path ( -- path ) \ ultraedit-path get-global [ program-files - "\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path + "IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path ] unless* ; : ultraedit ( file line -- )