factor: system:image -> image-path, like vm-path. image is all over the place png, jpg etc

db4
Doug Coleman 2015-07-20 00:17:09 -07:00
parent 4561bd88a3
commit fbbd09f3c5
15 changed files with 25 additions and 25 deletions

View File

@ -129,14 +129,14 @@ DEFER: ?make-staging-image
config [
bootstrap-profile :> profile
vocab "vocab-manifest-" prepend temp-file :> manifest-file
image vocab manifest-file profile deploy-command-line :> flags
image-path vocab manifest-file profile deploy-command-line :> flags
profile ?make-staging-image
vm-path flags run-factor
manifest-file parse-vocab-manifest-file
] with-variables ;
:: make-deploy-image-executable ( vm-path image vocab config -- manifest )
vm-path image vocab config make-deploy-image
image vm-path embed-image ;
:: make-deploy-image-executable ( vm image vocab config -- manifest )
vm image vocab config make-deploy-image
image vm embed-image ;
HOOK: deploy* os ( vocab -- )

View File

@ -7,7 +7,7 @@ IN: tools.deploy.embed
:: embed-image ( image executable -- )
executable binary <file-appender> [| out |
out stream-tell :> offset
image binary <file-reader> [| in |
image-path binary <file-reader> [| in |
in out stream-copy*
] with-disposal
image-magic uintptr_t <ref> out stream-write

View File

@ -399,7 +399,7 @@ IN: tools.deploy.shaker
output-stream
error-stream
vm-path
image
image-path
current-directory
} %

View File

@ -3,6 +3,6 @@
USING: accessors io.streams.c math.parser system ;
IN: tools.deploy.test.18
: main ( -- ) image show ;
: main ( -- ) image-path show ;
MAIN: main

View File

@ -18,7 +18,7 @@ IN: ui.backend.cocoa.tools
open-panel [ listener-run-files ] when* ;
: menu-save-image ( -- )
image save-panel [ save-image ] when* ;
image-path save-panel [ save-image ] when* ;
! Handle Open events from the Finder
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate

View File

@ -48,7 +48,7 @@ load-help? off
run-file
] [
"Cannot find " write write "." print
"Please move " write image write " into the same directory as the Factor sources," print
"Please move " write image-path write " into the same directory as the Factor sources," print
"and try again." print
1 (exit)
] if

View File

@ -63,7 +63,7 @@ IN: io.files.tests
] unit-test
{ } [
image binary [
image-path binary [
10 [ 65536 read drop ] times
] with-file-reader
] unit-test
@ -135,7 +135,7 @@ CONSTANT: pt-array-1
! Test EOF behavior
{ 10 } [
image binary [
image-path binary [
0 read drop
10 read length
] with-file-reader

View File

@ -79,11 +79,11 @@ PRIVATE>
: init-resource-path ( -- )
OBJ-ARGS special-object
[ utf8 alien>string "-resource-path=" ?head [ drop f ] unless ] map-find drop
[ image parent-directory ] unless* "resource-path" set-global ;
[ image-path parent-directory ] unless* "resource-path" set-global ;
[
cwd current-directory set-global
OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image set-global
OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image-path set-global
OBJ-EXECUTABLE special-object alien>native-string cwd prepend-path \ vm-path set-global
init-resource-path
] "io.files" add-startup-hook

View File

@ -129,7 +129,7 @@ HELP: home
} ;
ARTICLE: "io.pathnames.special" "Special pathnames"
"If a pathname begins with " { $snippet "resource:" } ", it is resolved relative to the directory containing the current image (see " { $link image } ")."
"If a pathname begins with " { $snippet "resource:" } ", it is resolved relative to the directory containing the current image (see " { $link image-path } ")."
$nl
"If a pathname begins with " { $snippet "vocab:" } ", then it will be searched for in all current vocabulary roots (see " { $link "add-vocab-roots" } ")."
$nl

View File

@ -27,4 +27,4 @@ PRIVATE>
: save-image-and-exit ( path -- )
normalize-path saving-path t (save-image) ;
: save ( -- ) image save-image ;
: save ( -- ) image-path save-image ;

View File

@ -11,7 +11,7 @@ ARTICLE: "system" "System interface"
"Getting the path to the Factor VM and image:"
{ $subsections
vm-path
image
image-path
}
"Getting a monotonically increasing nanosecond count:"
{ $subsections nano-count }
@ -72,7 +72,7 @@ HELP: nano-count
{ $description "Outputs a monotonically increasing count of nanoseconds elapsed since an arbitrary starting time. The difference of two calls to this word allows timing. This word is unaffected by system clock changes." }
{ $notes "This is a low-level word. The " { $vocab-link "tools.time" } " vocabulary defines words to time code execution time." } ;
HELP: image
HELP: image-path
{ $values { "path" "a pathname string" } }
{ $description "Outputs the pathname of the currently running Factor image." } ;

View File

@ -61,7 +61,7 @@ CONSTANT: string>os-hash H{
PRIVATE>
: image ( -- path ) \ image get-global ;
: image-path ( -- path ) \ image-path get-global ;
: vm-path ( -- path ) \ vm-path get-global ;

View File

@ -6,7 +6,7 @@ system ;
IN: contributors
: changelog ( -- authors )
image parent-directory [
image-path parent-directory [
"git log --no-merges --pretty=format:%an"
ascii [ lines ] with-process-reader
] with-directory ;

View File

@ -5,7 +5,7 @@ IN: update.latest
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: git-pull-master ( -- )
image parent-directory
image-path parent-directory
[
{ "git" "pull" "git://factorcode.org/git/factor.git" "master" }
run-command
@ -22,7 +22,7 @@ IN: update.latest
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rebuild-latest ( -- )
image parent-directory
image-path parent-directory
[
backup
download-latest-image
@ -35,7 +35,7 @@ IN: update.latest
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: update-latest ( -- )
image parent-directory
image-path parent-directory
[
git-id
git-pull-master

View File

@ -9,7 +9,7 @@ IN: update
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: git-pull-clean ( -- )
image parent-directory [
image-path parent-directory [
{ "git" "pull" "git://factorcode.org/git/factor.git" branch-name }
run-command
] with-directory ;
@ -31,7 +31,7 @@ IN: update
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rebuild ( -- )
image parent-directory [
image-path parent-directory [
download-clean-image
make-clean
make
@ -41,7 +41,7 @@ IN: update
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: update ( -- )
image parent-directory [
image-path parent-directory [
git-id
git-pull-clean
git-id