Merge git://factorcode.org/git/factor
commit
ac5471c216
|
@ -97,7 +97,9 @@ TUPLE: no-parent-directory path ;
|
|||
] }
|
||||
} cond drop ;
|
||||
|
||||
: copy-file ( from to -- )
|
||||
HOOK: copy-file io-backend ( from to -- )
|
||||
|
||||
M: object copy-file
|
||||
dup parent-directory make-directories
|
||||
<file-writer> [
|
||||
stdio get swap
|
||||
|
|
|
@ -58,8 +58,9 @@ SYMBOL: super-sent-messages
|
|||
"NSSavePanel"
|
||||
"NSView"
|
||||
"NSWindow"
|
||||
"NSWorkspace"
|
||||
} [
|
||||
f import-objc-class
|
||||
[ ] import-objc-class
|
||||
] each
|
||||
|
||||
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
|
||||
|
|
|
@ -4,7 +4,7 @@ USING: alien alien.c-types alien.compiler
|
|||
arrays assocs combinators compiler inference.transforms kernel
|
||||
math namespaces parser prettyprint prettyprint.sections
|
||||
quotations sequences strings words cocoa.runtime io macros
|
||||
memoize ;
|
||||
memoize debugger ;
|
||||
IN: cocoa.messages
|
||||
|
||||
: make-sender ( method function -- quot )
|
||||
|
@ -201,8 +201,11 @@ H{
|
|||
: import-objc-class ( name quot -- )
|
||||
2dup unless-defined
|
||||
dupd define-objc-class-word
|
||||
dup objc-class register-objc-methods
|
||||
objc-meta-class register-objc-methods ;
|
||||
[
|
||||
dup
|
||||
objc-class register-objc-methods
|
||||
objc-meta-class register-objc-methods
|
||||
] curry try ;
|
||||
|
||||
: root-class ( class -- root )
|
||||
dup objc-class-super-class [ root-class ] [ ] ?if ;
|
||||
|
|
|
@ -4,31 +4,31 @@ USING: kernel tools.test parser-combinators lazy-lists fjsc ;
|
|||
IN: temporary
|
||||
|
||||
{ T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||
"55 2abc1 100" 'expression' parse car parse-result-parsed
|
||||
"55 2abc1 100" 'expression' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-quotation f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||
"[ 55 2abc1 100 ]" 'quotation' parse car parse-result-parsed
|
||||
"[ 55 2abc1 100 ]" 'quotation' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-array f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
|
||||
"{ 55 2abc1 100 }" 'array' parse car parse-result-parsed
|
||||
"{ 55 2abc1 100 }" 'array' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-stack-effect f { } { "d" "e" "f" } } } [
|
||||
"( -- d e f )" 'stack-effect' parse car parse-result-parsed
|
||||
"( -- d e f )" 'stack-effect' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-stack-effect f { "a" "b" "c" } { "d" "e" "f" } } } [
|
||||
"( a b c -- d e f )" 'stack-effect' parse car parse-result-parsed
|
||||
"( a b c -- d e f )" 'stack-effect' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-stack-effect f { "a" "b" "c" } { } } } [
|
||||
"( a b c -- )" 'stack-effect' parse car parse-result-parsed
|
||||
"( a b c -- )" 'stack-effect' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-stack-effect f { } { } } } [
|
||||
"( -- )" 'stack-effect' parse car parse-result-parsed
|
||||
"( -- )" 'stack-effect' parse-1
|
||||
] unit-test
|
||||
|
||||
{ } [
|
||||
|
@ -37,18 +37,18 @@ IN: temporary
|
|||
|
||||
|
||||
{ T{ ast-expression f { T{ ast-string f "abcd" } } } } [
|
||||
"\"abcd\"" 'statement' parse car parse-result-parsed
|
||||
"\"abcd\"" 'statement' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-expression f { T{ ast-use f "foo" } } } } [
|
||||
"USE: foo" 'statement' parse car parse-result-parsed
|
||||
"USE: foo" 'statement' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-expression f { T{ ast-in f "foo" } } } } [
|
||||
"IN: foo" 'statement' parse car parse-result-parsed
|
||||
"IN: foo" 'statement' parse-1
|
||||
] unit-test
|
||||
|
||||
{ T{ ast-expression f { T{ ast-using f { "foo" "bar" } } } } } [
|
||||
"USING: foo bar ;" 'statement' parse car parse-result-parsed
|
||||
"USING: foo bar ;" 'statement' parse-1
|
||||
] unit-test
|
||||
|
||||
|
|
|
@ -328,7 +328,7 @@ M: wrapper (parse-factor-quotation) ( object -- ast )
|
|||
GENERIC: fjsc-parse ( object -- ast )
|
||||
|
||||
M: string fjsc-parse ( object -- ast )
|
||||
'expression' parse car parse-result-parsed ;
|
||||
'expression' parse-1 ;
|
||||
|
||||
M: quotation fjsc-parse ( object -- ast )
|
||||
[
|
||||
|
@ -345,11 +345,11 @@ M: quotation fjsc-parse ( object -- ast )
|
|||
] string-out ;
|
||||
|
||||
: fjsc-compile* ( string -- string )
|
||||
'statement' parse car parse-result-parsed fjsc-compile ;
|
||||
'statement' parse-1 fjsc-compile ;
|
||||
|
||||
: fc* ( string -- string )
|
||||
[
|
||||
'statement' parse car parse-result-parsed ast-expression-values do-expressions
|
||||
'statement' parse-1 ast-expression-values do-expressions
|
||||
] { } make [ write ] each ;
|
||||
|
||||
|
||||
|
|
|
@ -0,0 +1,19 @@
|
|||
IN: temporary
|
||||
USING: io.unix.launcher tools.test ;
|
||||
|
||||
[ { } ] [ "" tokenize-command ] unit-test
|
||||
[ { } ] [ " " tokenize-command ] unit-test
|
||||
[ { "a" } ] [ "a" tokenize-command ] unit-test
|
||||
[ { "abc" } ] [ "abc" tokenize-command ] unit-test
|
||||
[ { "abc" } ] [ "abc " tokenize-command ] unit-test
|
||||
[ { "abc" } ] [ " abc" tokenize-command ] unit-test
|
||||
[ { "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
|
||||
[ { "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
|
||||
[ { "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
|
||||
[ { "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
|
||||
[ { "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test
|
||||
[ { "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
|
||||
[ { "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
|
||||
[ "'abc def' \"hey" tokenize-command ] unit-test-fails
|
||||
[ "'abc def" tokenize-command ] unit-test-fails
|
||||
[ { "abc def" "h\"ey" } ] [ "'abc def' \"h\"ey\" " tokenize-command ] unit-test
|
|
@ -2,17 +2,46 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.launcher io.unix.backend io.nonblocking
|
||||
sequences kernel namespaces math system alien.c-types
|
||||
debugger continuations arrays assocs combinators unix.process ;
|
||||
debugger continuations arrays assocs combinators unix.process
|
||||
parser-combinators memoize promises strings ;
|
||||
IN: io.unix.launcher
|
||||
|
||||
! Search unix first
|
||||
USE: unix
|
||||
|
||||
: get-arguments ( -- seq )
|
||||
+command+ get
|
||||
[ "/bin/sh" "-c" rot 3array ] [ +arguments+ get ] if* ;
|
||||
! Our command line parser. Supported syntax:
|
||||
! foo bar baz -- simple tokens
|
||||
! foo\ bar -- escaping the space
|
||||
! 'foo bar' -- quotation
|
||||
! "foo bar" -- quotation
|
||||
LAZY: 'escaped-char' "\\" token any-char-parser &> ;
|
||||
|
||||
: assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ;
|
||||
LAZY: 'chars' 'escaped-char' any-char-parser <|> <*> ;
|
||||
|
||||
LAZY: 'quoted-1' 'chars' "\"" "\"" surrounded-by ;
|
||||
|
||||
LAZY: 'quoted-2' 'chars' "'" "'" surrounded-by ;
|
||||
|
||||
LAZY: 'non-space-char'
|
||||
'escaped-char' [ CHAR: \s = not ] satisfy <|> ;
|
||||
|
||||
LAZY: 'unquoted' 'non-space-char' <+> ;
|
||||
|
||||
LAZY: 'argument'
|
||||
'quoted-1' 'quoted-2' 'unquoted' <|> <|>
|
||||
[ >string ] <@ ;
|
||||
|
||||
MEMO: 'arguments' ( -- parser )
|
||||
'argument' " " token <+> list-of ;
|
||||
|
||||
: tokenize-command ( command -- arguments )
|
||||
'arguments' parse-1 ;
|
||||
|
||||
: get-arguments ( -- seq )
|
||||
+command+ get [ tokenize-command ] [ +arguments+ get ] if* ;
|
||||
|
||||
: assoc>env ( assoc -- env )
|
||||
[ "=" swap 3append ] { } assoc>map ;
|
||||
|
||||
: (spawn-process) ( -- )
|
||||
[
|
||||
|
|
|
@ -13,7 +13,7 @@ IN: io.unix.mmap
|
|||
M: unix-io <mapped-file> ( path length -- obj )
|
||||
swap >r
|
||||
dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor
|
||||
r> mmap-open \ mapped-file construct-boa ;
|
||||
r> mmap-open f mapped-file construct-boa ;
|
||||
|
||||
M: unix-io (close-mapped-file) ( mmap -- )
|
||||
[ mapped-file-address ] keep
|
||||
|
|
|
@ -53,8 +53,11 @@ TUPLE: CreateProcess-args
|
|||
CreateProcess-args-lpProcessInformation
|
||||
} get-slots CreateProcess win32-error=0/f ;
|
||||
|
||||
: escape-argument ( str -- newstr )
|
||||
[ [ dup CHAR: " = [ CHAR: \\ , ] when , ] each ] "" make ;
|
||||
|
||||
: join-arguments ( args -- cmd-line )
|
||||
[ "\"" swap "\"" 3append ] map " " join ;
|
||||
[ "\"" swap escape-argument "\"" 3append ] map " " join ;
|
||||
|
||||
: app-name/cmd-line ( -- app-name cmd-line )
|
||||
+command+ get [
|
||||
|
|
|
@ -109,12 +109,14 @@ M: windows-io <file-appender> ( path -- stream )
|
|||
open-append <win32-file> <writer> ;
|
||||
|
||||
M: windows-io rename-file ( from to -- )
|
||||
[ normalize-pathname ] 2apply
|
||||
MoveFile win32-error=0/f ;
|
||||
[ normalize-pathname ] 2apply MoveFile win32-error=0/f ;
|
||||
|
||||
M: windows-io delete-file ( path -- )
|
||||
normalize-pathname
|
||||
DeleteFile win32-error=0/f ;
|
||||
normalize-pathname DeleteFile win32-error=0/f ;
|
||||
|
||||
M: windows-io copy-file ( from to -- )
|
||||
dup parent-directory make-directories
|
||||
[ normalize-pathname ] 2apply 0 CopyFile win32-error=0/f ;
|
||||
|
||||
M: windows-io make-directory ( path -- )
|
||||
normalize-pathname
|
||||
|
|
|
@ -11,6 +11,15 @@ HELP: list-of
|
|||
"'items' is a parser that can parse the individual elements. 'separator' "
|
||||
"is a parser for the symbol that separatest them. The result tree of "
|
||||
"the resulting parser is an array of the parsed elements." }
|
||||
{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse car parse-result-parsed ." "{ 1 2 3 4 }" }
|
||||
{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse-1 ." "{ 1 2 3 4 }" }
|
||||
{ $see-also list-of } ;
|
||||
|
||||
HELP: any-char-parser
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
{ $description
|
||||
"Return a parser that consumes a single value "
|
||||
"from the input string. The value consumed is the "
|
||||
"result of the parse." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" any-char-parser parse-1 ." "102" } } ;
|
||||
|
|
|
@ -15,6 +15,9 @@ M: promise (parse) ( input parser -- list )
|
|||
|
||||
TUPLE: parse-result parsed unparsed ;
|
||||
|
||||
: parse-1 ( input parser -- result )
|
||||
parse car parse-result-parsed ;
|
||||
|
||||
C: <parse-result> parse-result
|
||||
|
||||
TUPLE: token-parser string ;
|
||||
|
@ -46,6 +49,9 @@ M: satisfy-parser (parse) ( input parser -- list )
|
|||
] if
|
||||
] if ;
|
||||
|
||||
LAZY: any-char-parser ( -- parser )
|
||||
[ drop t ] satisfy ;
|
||||
|
||||
TUPLE: epsilon-parser ;
|
||||
|
||||
C: epsilon epsilon-parser ( -- parser )
|
||||
|
@ -165,7 +171,7 @@ M: some-parser (parse) ( input parser -- result )
|
|||
#! the parse is complete (the remaining input is empty),
|
||||
#! picks the first solution and only returns the parse
|
||||
#! tree since the remaining input is empty.
|
||||
some-parser-p1 just parse car parse-result-parsed ;
|
||||
some-parser-p1 just parse-1 ;
|
||||
|
||||
|
||||
: <& ( parser1 parser2 -- parser )
|
||||
|
@ -251,4 +257,7 @@ LAZY: list-of ( items separator -- parser )
|
|||
#! items themselves, return a parser that parses
|
||||
#! lists of those items. The parse tree is an
|
||||
#! array of the parsed items.
|
||||
over &> <*> <&:> { } succeed <|> ;
|
||||
dup <?> -rot over &> <*> <&:> &> { } succeed <|> ;
|
||||
|
||||
LAZY: surrounded-by ( parser start end -- parser' )
|
||||
[ token ] 2apply swapd pack ;
|
|
@ -13,21 +13,21 @@ IN: parser-combinators
|
|||
} cond ;
|
||||
|
||||
: search ( string parser -- seq )
|
||||
'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
|
||||
any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
|
||||
drop { }
|
||||
] [
|
||||
car parse-result-parsed [ ] subset
|
||||
] if ;
|
||||
|
||||
: search* ( string parsers -- seq )
|
||||
unclip [ <|> ] reduce 'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
|
||||
unclip [ <|> ] reduce any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
|
||||
drop { }
|
||||
] [
|
||||
car parse-result-parsed [ ] subset
|
||||
] if ;
|
||||
|
||||
: (replace) ( string parser -- seq )
|
||||
'any-char' <|> <*> parse car parse-result-parsed ;
|
||||
any-char-parser <|> <*> parse-1 ;
|
||||
|
||||
: replace ( string parser -- result )
|
||||
[ (replace) [ tree-write ] each ] string-out ;
|
||||
|
|
|
@ -3,17 +3,6 @@
|
|||
USING: help.syntax help.markup parser-combinators
|
||||
parser-combinators.simple ;
|
||||
|
||||
HELP: 'any-char'
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
{ $description
|
||||
"Return a parser that consumes a single value "
|
||||
"from the input string. The value consumed is the "
|
||||
"result of the parse." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" 'any-char' parse car parse-result-parsed ." "102" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
|
||||
HELP: 'digit'
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
|
@ -22,8 +11,7 @@ HELP: 'digit'
|
|||
"the input string. The numeric value of the digit "
|
||||
" consumed is the result of the parse." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse car parse-result-parsed ." "1" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse-1 ." "1" } } ;
|
||||
|
||||
HELP: 'integer'
|
||||
{ $values
|
||||
|
@ -33,9 +21,7 @@ HELP: 'integer'
|
|||
"the input string. The numeric value of the integer "
|
||||
" consumed is the result of the parse." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse car parse-result-parsed ." "123" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse-1 ." "123" } } ;
|
||||
HELP: 'string'
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
|
@ -44,9 +30,7 @@ HELP: 'string'
|
|||
"quotations from the input string. The string value "
|
||||
" consumed is the result of the parse." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse car parse-result-parsed ." "\"foo\"" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse-1 ." "\"foo\"" } } ;
|
||||
HELP: 'bold'
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
|
@ -55,10 +39,8 @@ HELP: 'bold'
|
|||
"the '*' character from the input string. This is "
|
||||
"commonly used in markup languages to indicate bold "
|
||||
"faced text." }
|
||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse car parse-result-parsed ." "\"foo\"" }
|
||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse car parse-result-parsed ." "\"<strong>foo</strong>\"" }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
|
||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse-1 ." "\"foo\"" }
|
||||
{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse-1 ." "\"<strong>foo</strong>\"" } ;
|
||||
HELP: 'italic'
|
||||
{ $values
|
||||
{ "parser" "a parser object" } }
|
||||
|
@ -68,10 +50,8 @@ HELP: 'italic'
|
|||
"commonly used in markup languages to indicate italic "
|
||||
"faced text." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse car parse-result-parsed ." "\"foo\"" }
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse car parse-result-parsed ." "\"<emphasis>foo</emphasis>\"" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse-1 ." "\"foo\"" }
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse-1 ." "\"<emphasis>foo</emphasis>\"" } } ;
|
||||
HELP: comma-list
|
||||
{ $values
|
||||
{ "element" "a parser object" } { "parser" "a parser object" } }
|
||||
|
@ -80,5 +60,6 @@ HELP: comma-list
|
|||
"'element' should be a parser that can parse the elements. The "
|
||||
"result of the parser is a sequence of the parsed elements." }
|
||||
{ $examples
|
||||
{ $example "USING: lazy-lists parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse car parse-result-parsed ." "{ 1 2 3 4 }" } }
|
||||
{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
|
||||
{ $example "USING: lazy-lits parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
|
||||
|
||||
{ $see-also 'digit' 'integer' 'string' 'bold' 'italic' comma-list } related-words
|
||||
|
|
|
@ -4,9 +4,6 @@ USING: kernel strings math sequences lazy-lists words
|
|||
math.parser promises ;
|
||||
IN: parser-combinators
|
||||
|
||||
LAZY: 'any-char' ( -- parser )
|
||||
[ drop t ] satisfy ;
|
||||
|
||||
: 'digit' ( -- parser )
|
||||
[ digit? ] satisfy [ digit> ] <@ ;
|
||||
|
||||
|
|
|
@ -1,18 +1,16 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.files io.launcher kernel namespaces sequences
|
||||
system cocoa.plists cocoa.application tools.deploy
|
||||
tools.deploy.config assocs hashtables prettyprint ;
|
||||
system tools.deploy tools.deploy.config assocs hashtables
|
||||
prettyprint unix io.unix.backend cocoa cocoa.plists
|
||||
cocoa.application cocoa.classes ;
|
||||
IN: tools.deploy.macosx
|
||||
|
||||
: touch ( path -- )
|
||||
"touch \"" swap "\"" 3append run-process ;
|
||||
{ "touch" } swap add run-process ;
|
||||
|
||||
: rm ( path -- )
|
||||
"rm -rf \"" swap "\"" 3append run-process ;
|
||||
|
||||
: chmod ( path perms -- )
|
||||
[ "chmod " % % " \"" % % "\"" % ] "" make run-process ;
|
||||
{ "rm" "-rf" } swap add run-process ;
|
||||
|
||||
: bundle-dir ( -- dir )
|
||||
vm parent-directory parent-directory ;
|
||||
|
@ -24,7 +22,7 @@ IN: tools.deploy.macosx
|
|||
: copy-vm ( executable bundle-name -- vm )
|
||||
"Contents/MacOS/" path+ swap path+ vm swap
|
||||
[ copy-file ] keep
|
||||
[ "755" chmod ] keep ;
|
||||
[ 755 chmod io-error ] keep ;
|
||||
|
||||
: copy-fonts ( name -- )
|
||||
"fonts/" resource-path
|
||||
|
@ -63,6 +61,12 @@ TUPLE: macosx-deploy-implementation ;
|
|||
|
||||
T{ macosx-deploy-implementation } deploy-implementation set-global
|
||||
|
||||
: show-in-finder ( path -- )
|
||||
NSWorkspace
|
||||
-> sharedWorkspace
|
||||
over <NSString> rot parent-directory <NSString>
|
||||
-> selectFile:inFileViewerRootedAtPath: drop ;
|
||||
|
||||
M: macosx-deploy-implementation deploy ( vocab -- )
|
||||
".app deploy tool" assert.app
|
||||
"." resource-path cd
|
||||
|
@ -70,5 +74,6 @@ M: macosx-deploy-implementation deploy ( vocab -- )
|
|||
bundle-name rm
|
||||
[ bundle-name create-app-dir ] keep
|
||||
[ bundle-name deploy.app-image ] keep
|
||||
namespace
|
||||
] bind deploy* ;
|
||||
namespace deploy*
|
||||
bundle-name show-in-finder
|
||||
] bind ;
|
||||
|
|
|
@ -60,11 +60,19 @@ M: cocoa-ui-backend set-title ( string world -- )
|
|||
drop
|
||||
] if ;
|
||||
|
||||
M: cocoa-ui-backend (open-world-window) ( world -- )
|
||||
M: cocoa-ui-backend (open-window) ( world -- )
|
||||
dup gadget-window
|
||||
dup auto-position
|
||||
world-handle second f -> makeKeyAndOrderFront: ;
|
||||
|
||||
M: cocoa-ui-backend (close-window) ( handle -- )
|
||||
first unregister-window ;
|
||||
|
||||
M: cocoa-ui-backend close-window ( gadget -- )
|
||||
find-world [
|
||||
world-handle second f -> performClose:
|
||||
] when* ;
|
||||
|
||||
M: cocoa-ui-backend raise-window ( world -- )
|
||||
world-handle [
|
||||
second dup f -> orderFront: -> makeKeyWindow
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
USING: alien arrays assocs cocoa kernel math cocoa.messages
|
||||
cocoa.subclassing cocoa.classes cocoa.views cocoa.application
|
||||
cocoa.pasteboard cocoa.types cocoa.windows sequences ui
|
||||
ui.gadgets ui.gadgets.worlds ui.gestures core-foundation ;
|
||||
ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
|
||||
threads ;
|
||||
IN: ui.cocoa.views
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
|
@ -313,8 +314,6 @@ CLASS: {
|
|||
{ "dealloc" "void" { "id" "SEL" }
|
||||
[
|
||||
drop
|
||||
dup window stop-world
|
||||
dup unregister-window
|
||||
dup remove-observer
|
||||
SUPER-> dealloc
|
||||
]
|
||||
|
@ -347,6 +346,12 @@ CLASS: {
|
|||
forget-rollover
|
||||
2nip -> object -> contentView window unfocus-world
|
||||
]
|
||||
}
|
||||
|
||||
{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
|
||||
[
|
||||
2nip -> contentView window ungraft t
|
||||
]
|
||||
} ;
|
||||
|
||||
: install-window-delegate ( window -- )
|
||||
|
|
|
@ -77,7 +77,8 @@ TUPLE: deploy-gadget vocab settings ;
|
|||
|
||||
: com-deploy ( gadget -- )
|
||||
dup com-save
|
||||
find-deploy-vocab [ deploy ] curry call-listener ;
|
||||
dup find-deploy-vocab [ deploy ] curry call-listener
|
||||
close-window ;
|
||||
|
||||
: com-help ( -- )
|
||||
"ui-deploy" help-window ;
|
||||
|
@ -86,7 +87,11 @@ TUPLE: deploy-gadget vocab settings ;
|
|||
{ +nullary+ t }
|
||||
} define-command
|
||||
|
||||
: com-close ( gadget -- )
|
||||
close-window ;
|
||||
|
||||
deploy-gadget "toolbar" f {
|
||||
{ f com-close }
|
||||
{ f com-help }
|
||||
{ f com-revert }
|
||||
{ f com-save }
|
||||
|
|
|
@ -67,11 +67,11 @@ M: workspace model-changed
|
|||
: com-profiler profiler-gadget select-tool ;
|
||||
|
||||
workspace "tool-switching" f {
|
||||
{ T{ key-down f f "F2" } com-listener }
|
||||
{ T{ key-down f f "F3" } com-browser }
|
||||
{ T{ key-down f f "F4" } com-inspector }
|
||||
{ T{ key-down f f "F5" } com-walker }
|
||||
{ T{ key-down f f "F6" } com-profiler }
|
||||
{ T{ key-down f { C+ } "1" } com-listener }
|
||||
{ T{ key-down f { C+ } "2" } com-browser }
|
||||
{ T{ key-down f { C+ } "3" } com-inspector }
|
||||
{ T{ key-down f { C+ } "4" } com-walker }
|
||||
{ T{ key-down f { C+ } "5" } com-profiler }
|
||||
} define-command-map
|
||||
|
||||
\ workspace-window
|
||||
|
@ -86,8 +86,8 @@ H{ { +nullary+ t } { +listener+ t } } define-command
|
|||
workspace "workflow" f {
|
||||
{ T{ key-down f { C+ } "n" } workspace-window }
|
||||
{ T{ key-down f f "ESC" } hide-popup }
|
||||
{ T{ key-down f f "F8" } refresh-all }
|
||||
{ T{ key-down f { A+ } "F8" } test-changes }
|
||||
{ T{ key-down f f "F2" } refresh-all }
|
||||
{ T{ key-down f { A+ } "F2" } test-changes }
|
||||
} define-command-map
|
||||
|
||||
[
|
||||
|
|
|
@ -72,7 +72,9 @@ M: world ungraft*
|
|||
>r [ 1 track, ] { 0 1 } make-track r>
|
||||
f <world> open-world-window ;
|
||||
|
||||
: close-window ( gadget -- )
|
||||
HOOK: close-window ui-backend ( gadget -- )
|
||||
|
||||
M: object close-window
|
||||
find-world [ ungraft ] when* ;
|
||||
|
||||
: find-window ( quot -- world )
|
||||
|
@ -127,7 +129,7 @@ SYMBOL: ui-hook
|
|||
] { } make ;
|
||||
|
||||
: redraw-worlds ( seq -- )
|
||||
[ dup update-hand [ draw-world ] time ] each ;
|
||||
[ dup update-hand draw-world ] each ;
|
||||
|
||||
: notify ( gadget -- )
|
||||
dup gadget-graft-state {
|
||||
|
|
|
@ -158,18 +158,14 @@ M: world selection-request-event
|
|||
{ [ t ] [ drop send-notify-failure ] }
|
||||
} cond ;
|
||||
|
||||
: close-window ( handle -- )
|
||||
M: x11-ui-backend (close-window) ( handle -- )
|
||||
dup x11-handle-xic XDestroyIC
|
||||
dup x11-handle-glx destroy-glx
|
||||
x11-handle-window dup unregister-window
|
||||
destroy-window ;
|
||||
|
||||
M: world client-event
|
||||
swap close-box? [
|
||||
dup world-handle >r stop-world r> close-window
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
swap close-box? [ ungraft ] [ drop ] if ;
|
||||
|
||||
: gadget-window ( world -- )
|
||||
dup world-loc over rect-dim glx-window
|
||||
|
@ -222,7 +218,7 @@ M: x11-ui-backend set-title ( string world -- )
|
|||
world-handle x11-handle-window swap dpy get -rot
|
||||
3dup set-title-old set-title-new ;
|
||||
|
||||
M: x11-ui-backend (open-world-window) ( world -- )
|
||||
M: x11-ui-backend (open-window) ( world -- )
|
||||
dup gadget-window
|
||||
world-handle x11-handle-window dup set-closable map-window ;
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@ IN: webapps.fjsc
|
|||
#! Compile the factor code as a string, outputting the http
|
||||
#! response containing the javascript.
|
||||
serving-text
|
||||
'expression' parse car parse-result-parsed fjsc-compile
|
||||
'expression' parse-1 fjsc-compile
|
||||
write flush ;
|
||||
|
||||
! The 'compile' action results in an URL that looks like
|
||||
|
|
|
@ -18,7 +18,7 @@ TUPLE: posting author title date link body ;
|
|||
#! entries is an array of { author entries } pairs.
|
||||
dup [
|
||||
[ fetch-feed ] [ error. drop f ] recover
|
||||
] parallel-map [ ] subset
|
||||
] parallel-map
|
||||
[ [ >r first r> 2array ] curry* map ] 2map concat ;
|
||||
|
||||
: sort-entries ( entries -- entries' )
|
||||
|
@ -108,6 +108,7 @@ SYMBOL: cached-postings
|
|||
{ "Kio M. Smallwood"
|
||||
"http://sekenre.wordpress.com/feed/atom/"
|
||||
"http://sekenre.wordpress.com/" }
|
||||
{ "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
|
||||
{ "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
|
||||
{ "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
|
||||
} default-blogroll set-global
|
||||
|
|
|
@ -566,7 +566,8 @@ FUNCTION: BOOL ConnectNamedPipe ( HANDLE hNamedPipe, LPOVERLAPPED lpOverlapped )
|
|||
! FUNCTION: CopyFileA
|
||||
! FUNCTION: CopyFileExA
|
||||
! FUNCTION: CopyFileExW
|
||||
! FUNCTION: CopyFileW
|
||||
FUNCTION: BOOL CopyFileW ( LPCTSTR lpExistingFileName, LPCTSTR lpNewFileName, BOOL bFailIfExists ) ;
|
||||
: CopyFile CopyFileW ; inline
|
||||
! FUNCTION: CopyLZFile
|
||||
! FUNCTION: CreateActCtxA
|
||||
! FUNCTION: CreateActCtxW
|
||||
|
@ -575,7 +576,7 @@ FUNCTION: BOOL ConnectNamedPipe ( HANDLE hNamedPipe, LPOVERLAPPED lpOverlapped )
|
|||
! FUNCTION: CreateDirectoryExA
|
||||
! FUNCTION: CreateDirectoryExW
|
||||
FUNCTION: BOOL CreateDirectoryW ( LPCTSTR lpPathName, LPSECURITY_ATTRIBUTES lpSecurityAttribytes ) ;
|
||||
: CreateDirectory CreateDirectoryW ;
|
||||
: CreateDirectory CreateDirectoryW ; inline
|
||||
|
||||
! FUNCTION: CreateEventA
|
||||
! FUNCTION: CreateEventW
|
||||
|
|
Loading…
Reference in New Issue