Merge branch 'master' of git://github.com/erikcharlebois/factor
						commit
						1986dc49e4
					
				| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! (c)2009 Joe Groff bsd license
 | 
			
		||||
USING: accessors alien.c-types alien.parser alien.syntax
 | 
			
		||||
tools.test vocabs.parser parser eval vocabs.parser debugger
 | 
			
		||||
continuations ;
 | 
			
		||||
tools.test vocabs.parser parser eval debugger kernel
 | 
			
		||||
continuations words ;
 | 
			
		||||
IN: alien.parser.tests
 | 
			
		||||
 | 
			
		||||
TYPEDEF: char char2
 | 
			
		||||
| 
						 | 
				
			
			@ -34,6 +34,11 @@ CONSTANT: eleven 11
 | 
			
		|||
 | 
			
		||||
] with-file-vocabs
 | 
			
		||||
 | 
			
		||||
FUNCTION: void* alien-parser-effect-test ( int *arg1 float arg2 ) ;
 | 
			
		||||
[ (( arg1 arg2 -- void* )) ] [
 | 
			
		||||
    \ alien-parser-effect-test "declared-effect" word-prop
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Reported by mnestic
 | 
			
		||||
TYPEDEF: int alien-parser-test-int ! reasonably unique name...
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -72,10 +72,10 @@ IN: alien.parser
 | 
			
		|||
: function-quot ( return library function types -- quot )
 | 
			
		||||
    '[ _ _ _ _ alien-invoke ] ;
 | 
			
		||||
 | 
			
		||||
:: make-function ( return! library function! parameters -- word quot effect )
 | 
			
		||||
    return function normalize-c-arg function! return!
 | 
			
		||||
:: make-function ( return library function parameters -- word quot effect )
 | 
			
		||||
    return function normalize-c-arg :> ( return-c-type function )
 | 
			
		||||
    function create-in dup reset-generic
 | 
			
		||||
    return library function
 | 
			
		||||
    return-c-type library function
 | 
			
		||||
    parameters return parse-arglist [ function-quot ] dip ;
 | 
			
		||||
 | 
			
		||||
: parse-arg-tokens ( -- tokens )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,54 +1,54 @@
 | 
			
		|||
USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
 | 
			
		||||
vectors sequences threads tools.test math kernel strings namespaces
 | 
			
		||||
continuations calendar destructors ;
 | 
			
		||||
IN: concurrency.mailboxes.tests
 | 
			
		||||
 | 
			
		||||
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
 | 
			
		||||
 | 
			
		||||
[ V{ 1 2 3 } ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    2 over mailbox-put
 | 
			
		||||
    3 swap mailbox-put
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ V{ 1 2 3 } ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    2 over mailbox-put
 | 
			
		||||
    3 swap mailbox-put
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ string? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ string? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    "junk" over mailbox-put
 | 
			
		||||
    [ 456 ] over mailbox-put
 | 
			
		||||
    3 over mailbox-put
 | 
			
		||||
    "junk2" over mailbox-put
 | 
			
		||||
    mailbox-get
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ { "foo" "bar" } ] [
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    "foo" over mailbox-put
 | 
			
		||||
    "bar" over mailbox-put
 | 
			
		||||
    mailbox-get-all
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
    <mailbox> 1 seconds mailbox-get-timeout
 | 
			
		||||
] [ wait-timeout? ] must-fail-with
 | 
			
		||||
USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
 | 
			
		||||
vectors sequences threads tools.test math kernel strings namespaces
 | 
			
		||||
continuations calendar destructors ;
 | 
			
		||||
IN: concurrency.mailboxes.tests
 | 
			
		||||
 | 
			
		||||
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
 | 
			
		||||
 | 
			
		||||
[ V{ 1 2 3 } ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    [ mailbox-get swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    2 over mailbox-put
 | 
			
		||||
    3 swap mailbox-put
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ V{ 1 2 3 } ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    2 over mailbox-put
 | 
			
		||||
    3 swap mailbox-put
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
 | 
			
		||||
    0 <vector>
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ integer? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ string? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    [ [ string? ] mailbox-get? swap push ] in-thread
 | 
			
		||||
    1 over mailbox-put
 | 
			
		||||
    "junk" over mailbox-put
 | 
			
		||||
    [ 456 ] over mailbox-put
 | 
			
		||||
    3 over mailbox-put
 | 
			
		||||
    "junk2" over mailbox-put
 | 
			
		||||
    mailbox-get
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ { "foo" "bar" } ] [
 | 
			
		||||
    <mailbox>
 | 
			
		||||
    "foo" over mailbox-put
 | 
			
		||||
    "bar" over mailbox-put
 | 
			
		||||
    mailbox-get-all
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[
 | 
			
		||||
    <mailbox> 1 seconds mailbox-get-timeout
 | 
			
		||||
] [ wait-timeout? ] must-fail-with
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,94 +1,94 @@
 | 
			
		|||
! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: dlists deques threads sequences continuations namespaces
 | 
			
		||||
math quotations words kernel arrays assocs init system
 | 
			
		||||
concurrency.conditions accessors debugger debugger.threads
 | 
			
		||||
locals fry ;
 | 
			
		||||
IN: concurrency.mailboxes
 | 
			
		||||
 | 
			
		||||
TUPLE: mailbox threads data ;
 | 
			
		||||
 | 
			
		||||
: <mailbox> ( -- mailbox )
 | 
			
		||||
    mailbox new
 | 
			
		||||
        <dlist> >>threads
 | 
			
		||||
        <dlist> >>data ;
 | 
			
		||||
 | 
			
		||||
: mailbox-empty? ( mailbox -- bool )
 | 
			
		||||
    data>> deque-empty? ;
 | 
			
		||||
 | 
			
		||||
: mailbox-put ( obj mailbox -- )
 | 
			
		||||
    [ data>> push-front ]
 | 
			
		||||
    [ threads>> notify-all ] bi yield ;
 | 
			
		||||
 | 
			
		||||
: wait-for-mailbox ( mailbox timeout -- )
 | 
			
		||||
    [ threads>> ] dip "mailbox" wait ;
 | 
			
		||||
 | 
			
		||||
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
 | 
			
		||||
    mailbox data>> pred dlist-any? [
 | 
			
		||||
        mailbox timeout wait-for-mailbox
 | 
			
		||||
        mailbox timeout pred block-unless-pred
 | 
			
		||||
    ] unless ; inline recursive
 | 
			
		||||
 | 
			
		||||
: block-if-empty ( mailbox timeout -- mailbox )
 | 
			
		||||
    over mailbox-empty? [
 | 
			
		||||
        2dup wait-for-mailbox block-if-empty
 | 
			
		||||
    ] [
 | 
			
		||||
        drop
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: mailbox-peek ( mailbox -- obj )
 | 
			
		||||
    data>> peek-back ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-timeout ( mailbox timeout -- obj )
 | 
			
		||||
    block-if-empty data>> pop-back ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get ( mailbox -- obj )
 | 
			
		||||
    f mailbox-get-timeout ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-all-timeout ( mailbox timeout -- array )
 | 
			
		||||
    block-if-empty
 | 
			
		||||
    [ dup mailbox-empty? not ]
 | 
			
		||||
    [ dup data>> pop-back ]
 | 
			
		||||
    produce nip ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-all ( mailbox -- array )
 | 
			
		||||
    f mailbox-get-all-timeout ;
 | 
			
		||||
 | 
			
		||||
: while-mailbox-empty ( mailbox quot -- )
 | 
			
		||||
    [ '[ _ mailbox-empty? ] ] dip while ; inline
 | 
			
		||||
 | 
			
		||||
: mailbox-get-timeout? ( mailbox timeout pred -- obj )
 | 
			
		||||
    [ block-unless-pred ]
 | 
			
		||||
    [ [ drop data>> ] dip delete-node-if ]
 | 
			
		||||
    3bi ; inline
 | 
			
		||||
 | 
			
		||||
: mailbox-get? ( mailbox pred -- obj )
 | 
			
		||||
    f swap mailbox-get-timeout? ; inline
 | 
			
		||||
 | 
			
		||||
: wait-for-close-timeout ( mailbox timeout -- )
 | 
			
		||||
    over disposed>>
 | 
			
		||||
    [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
 | 
			
		||||
 | 
			
		||||
: wait-for-close ( mailbox -- )
 | 
			
		||||
    f wait-for-close-timeout ;
 | 
			
		||||
 | 
			
		||||
TUPLE: linked-error error thread ;
 | 
			
		||||
 | 
			
		||||
M: linked-error error.
 | 
			
		||||
    [ thread>> error-in-thread. ] [ error>> error. ] bi ;
 | 
			
		||||
 | 
			
		||||
C: <linked-error> linked-error
 | 
			
		||||
 | 
			
		||||
: ?linked ( message -- message )
 | 
			
		||||
    dup linked-error? [ rethrow ] when ;
 | 
			
		||||
 | 
			
		||||
TUPLE: linked-thread < thread supervisor ;
 | 
			
		||||
 | 
			
		||||
M: linked-thread error-in-thread
 | 
			
		||||
    [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
 | 
			
		||||
 | 
			
		||||
: <linked-thread> ( quot name mailbox -- thread' )
 | 
			
		||||
    [ linked-thread new-thread ] dip >>supervisor ;
 | 
			
		||||
 | 
			
		||||
: spawn-linked-to ( quot name mailbox -- thread )
 | 
			
		||||
    <linked-thread> [ (spawn) ] keep ;
 | 
			
		||||
! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: dlists deques threads sequences continuations namespaces
 | 
			
		||||
math quotations words kernel arrays assocs init system
 | 
			
		||||
concurrency.conditions accessors debugger debugger.threads
 | 
			
		||||
locals fry ;
 | 
			
		||||
IN: concurrency.mailboxes
 | 
			
		||||
 | 
			
		||||
TUPLE: mailbox threads data ;
 | 
			
		||||
 | 
			
		||||
: <mailbox> ( -- mailbox )
 | 
			
		||||
    mailbox new
 | 
			
		||||
        <dlist> >>threads
 | 
			
		||||
        <dlist> >>data ;
 | 
			
		||||
 | 
			
		||||
: mailbox-empty? ( mailbox -- bool )
 | 
			
		||||
    data>> deque-empty? ;
 | 
			
		||||
 | 
			
		||||
: mailbox-put ( obj mailbox -- )
 | 
			
		||||
    [ data>> push-front ]
 | 
			
		||||
    [ threads>> notify-all ] bi yield ;
 | 
			
		||||
 | 
			
		||||
: wait-for-mailbox ( mailbox timeout -- )
 | 
			
		||||
    [ threads>> ] dip "mailbox" wait ;
 | 
			
		||||
 | 
			
		||||
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
 | 
			
		||||
    mailbox data>> pred dlist-any? [
 | 
			
		||||
        mailbox timeout wait-for-mailbox
 | 
			
		||||
        mailbox timeout pred block-unless-pred
 | 
			
		||||
    ] unless ; inline recursive
 | 
			
		||||
 | 
			
		||||
: block-if-empty ( mailbox timeout -- mailbox )
 | 
			
		||||
    over mailbox-empty? [
 | 
			
		||||
        2dup wait-for-mailbox block-if-empty
 | 
			
		||||
    ] [
 | 
			
		||||
        drop
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: mailbox-peek ( mailbox -- obj )
 | 
			
		||||
    data>> peek-back ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-timeout ( mailbox timeout -- obj )
 | 
			
		||||
    block-if-empty data>> pop-back ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get ( mailbox -- obj )
 | 
			
		||||
    f mailbox-get-timeout ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-all-timeout ( mailbox timeout -- array )
 | 
			
		||||
    block-if-empty
 | 
			
		||||
    [ dup mailbox-empty? not ]
 | 
			
		||||
    [ dup data>> pop-back ]
 | 
			
		||||
    produce nip ;
 | 
			
		||||
 | 
			
		||||
: mailbox-get-all ( mailbox -- array )
 | 
			
		||||
    f mailbox-get-all-timeout ;
 | 
			
		||||
 | 
			
		||||
: while-mailbox-empty ( mailbox quot -- )
 | 
			
		||||
    [ '[ _ mailbox-empty? ] ] dip while ; inline
 | 
			
		||||
 | 
			
		||||
: mailbox-get-timeout? ( mailbox timeout pred -- obj )
 | 
			
		||||
    [ block-unless-pred ]
 | 
			
		||||
    [ [ drop data>> ] dip delete-node-if ]
 | 
			
		||||
    3bi ; inline
 | 
			
		||||
 | 
			
		||||
: mailbox-get? ( mailbox pred -- obj )
 | 
			
		||||
    f swap mailbox-get-timeout? ; inline
 | 
			
		||||
 | 
			
		||||
: wait-for-close-timeout ( mailbox timeout -- )
 | 
			
		||||
    over disposed>>
 | 
			
		||||
    [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
 | 
			
		||||
 | 
			
		||||
: wait-for-close ( mailbox -- )
 | 
			
		||||
    f wait-for-close-timeout ;
 | 
			
		||||
 | 
			
		||||
TUPLE: linked-error error thread ;
 | 
			
		||||
 | 
			
		||||
M: linked-error error.
 | 
			
		||||
    [ thread>> error-in-thread. ] [ error>> error. ] bi ;
 | 
			
		||||
 | 
			
		||||
C: <linked-error> linked-error
 | 
			
		||||
 | 
			
		||||
: ?linked ( message -- message )
 | 
			
		||||
    dup linked-error? [ rethrow ] when ;
 | 
			
		||||
 | 
			
		||||
TUPLE: linked-thread < thread supervisor ;
 | 
			
		||||
 | 
			
		||||
M: linked-thread error-in-thread
 | 
			
		||||
    [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
 | 
			
		||||
 | 
			
		||||
: <linked-thread> ( quot name mailbox -- thread' )
 | 
			
		||||
    [ linked-thread new-thread ] dip >>supervisor ;
 | 
			
		||||
 | 
			
		||||
: spawn-linked-to ( quot name mailbox -- thread )
 | 
			
		||||
    <linked-thread> [ (spawn) ] keep ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,27 +1,27 @@
 | 
			
		|||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors concurrency.mailboxes kernel continuations ;
 | 
			
		||||
IN: concurrency.promises
 | 
			
		||||
 | 
			
		||||
TUPLE: promise mailbox ;
 | 
			
		||||
 | 
			
		||||
: <promise> ( -- promise )
 | 
			
		||||
    <mailbox> promise boa ;
 | 
			
		||||
 | 
			
		||||
: promise-fulfilled? ( promise -- ? )
 | 
			
		||||
    mailbox>> mailbox-empty? not ;
 | 
			
		||||
 | 
			
		||||
ERROR: promise-already-fulfilled promise ;
 | 
			
		||||
 | 
			
		||||
: fulfill ( value promise -- )
 | 
			
		||||
    dup promise-fulfilled? [ 
 | 
			
		||||
        promise-already-fulfilled
 | 
			
		||||
    ] [
 | 
			
		||||
        mailbox>> mailbox-put
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: ?promise-timeout ( promise timeout -- result )
 | 
			
		||||
    [ mailbox>> ] dip block-if-empty mailbox-peek ;
 | 
			
		||||
 | 
			
		||||
: ?promise ( promise -- result )
 | 
			
		||||
    f ?promise-timeout ;
 | 
			
		||||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: accessors concurrency.mailboxes kernel continuations ;
 | 
			
		||||
IN: concurrency.promises
 | 
			
		||||
 | 
			
		||||
TUPLE: promise mailbox ;
 | 
			
		||||
 | 
			
		||||
: <promise> ( -- promise )
 | 
			
		||||
    <mailbox> promise boa ;
 | 
			
		||||
 | 
			
		||||
: promise-fulfilled? ( promise -- ? )
 | 
			
		||||
    mailbox>> mailbox-empty? not ;
 | 
			
		||||
 | 
			
		||||
ERROR: promise-already-fulfilled promise ;
 | 
			
		||||
 | 
			
		||||
: fulfill ( value promise -- )
 | 
			
		||||
    dup promise-fulfilled? [ 
 | 
			
		||||
        promise-already-fulfilled
 | 
			
		||||
    ] [
 | 
			
		||||
        mailbox>> mailbox-put
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: ?promise-timeout ( promise timeout -- result )
 | 
			
		||||
    [ mailbox>> ] dip block-if-empty mailbox-peek ;
 | 
			
		||||
 | 
			
		||||
: ?promise ( promise -- result )
 | 
			
		||||
    f ?promise-timeout ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
! Copyright (C) 2008 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: help.markup help.syntax kernel strings words vocabs ;
 | 
			
		||||
USING: help.markup help.syntax kernel strings words vocabs sequences ;
 | 
			
		||||
IN: tools.scaffold
 | 
			
		||||
 | 
			
		||||
HELP: developer-name
 | 
			
		||||
| 
						 | 
				
			
			@ -23,6 +23,30 @@ HELP: scaffold-undocumented
 | 
			
		|||
 | 
			
		||||
{ scaffold-help scaffold-undocumented } related-words
 | 
			
		||||
 | 
			
		||||
HELP: scaffold-authors
 | 
			
		||||
{ $values
 | 
			
		||||
    { "vocab" "a vocabulary specifier" }
 | 
			
		||||
}
 | 
			
		||||
{ $description "Creates an authors.txt file using the value in " { $link developer-name } ". This word only works if no authors.txt file yet exists." } ;
 | 
			
		||||
 | 
			
		||||
HELP: scaffold-summary
 | 
			
		||||
{ $values
 | 
			
		||||
    { "vocab" "a vocabulary specifier" } { "summary" string }
 | 
			
		||||
}
 | 
			
		||||
{ $description "Creates a summary.txt file with the given summary. This word only works if no summary.txt file yet exists." } ;
 | 
			
		||||
 | 
			
		||||
HELP: scaffold-tags
 | 
			
		||||
{ $values
 | 
			
		||||
    { "vocab" "a vocabulary specifier" } { "tags" string }
 | 
			
		||||
}
 | 
			
		||||
{ $description "Creates a tags.txt file with the given tags. This word only works if no tags.txt file yet exists." } ;
 | 
			
		||||
 | 
			
		||||
HELP: scaffold-tests
 | 
			
		||||
{ $values
 | 
			
		||||
    { "vocab" "a vocabulary specifier" }
 | 
			
		||||
}
 | 
			
		||||
{ $description "Takes an existing vocabulary and creates an empty tests file help for each word. This word only works if no tests file yet exists." } ;
 | 
			
		||||
 | 
			
		||||
HELP: scaffold-vocab
 | 
			
		||||
{ $values
 | 
			
		||||
     { "vocab-root" "a vocabulary root string" } { "string" string } }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -59,6 +59,9 @@ M: bad-developer-name summary
 | 
			
		|||
: vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path )
 | 
			
		||||
    [ vocab-root/vocab>path dup file-name append-path ] dip append ;
 | 
			
		||||
 | 
			
		||||
: vocab/file>path ( vocab file -- path )
 | 
			
		||||
    [ vocab>path ] dip append-path ;
 | 
			
		||||
 | 
			
		||||
: vocab/suffix>path ( vocab suffix -- path )
 | 
			
		||||
    [ vocab>path dup file-name append-path ] dip append ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -100,16 +103,17 @@ M: bad-developer-name summary
 | 
			
		|||
        2drop
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: scaffold-authors ( vocab-root vocab -- )
 | 
			
		||||
    developer-name get [
 | 
			
		||||
        "authors.txt" vocab-root/vocab/file>path scaffolding? [
 | 
			
		||||
            developer-name get swap utf8 set-file-contents
 | 
			
		||||
: scaffold-metadata ( vocab file contents -- )
 | 
			
		||||
    [ ensure-vocab-exists ] 2dip
 | 
			
		||||
    [
 | 
			
		||||
        [ vocab/file>path ] dip swap scaffolding? [
 | 
			
		||||
            utf8 set-file-contents
 | 
			
		||||
        ] [
 | 
			
		||||
            drop
 | 
			
		||||
            2drop
 | 
			
		||||
        ] if
 | 
			
		||||
    ] [
 | 
			
		||||
        2drop
 | 
			
		||||
    ] if ;
 | 
			
		||||
    ] if* ;
 | 
			
		||||
 | 
			
		||||
: lookup-type ( string -- object/string ? )
 | 
			
		||||
    "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
 | 
			
		||||
| 
						 | 
				
			
			@ -254,12 +258,21 @@ PRIVATE>
 | 
			
		|||
: scaffold-undocumented ( string -- )
 | 
			
		||||
    [ interesting-words. ] [ link-vocab ] bi ;
 | 
			
		||||
 | 
			
		||||
: scaffold-authors ( vocab -- )
 | 
			
		||||
    "authors.txt" developer-name get scaffold-metadata ;
 | 
			
		||||
 | 
			
		||||
: scaffold-tags ( vocab tags -- )
 | 
			
		||||
    [ "tags.txt" ] dip scaffold-metadata ;
 | 
			
		||||
 | 
			
		||||
: scaffold-summary ( vocab summary -- )
 | 
			
		||||
    [ "summary.txt" ] dip scaffold-metadata ;
 | 
			
		||||
 | 
			
		||||
: scaffold-vocab ( vocab-root string -- )
 | 
			
		||||
    {
 | 
			
		||||
        [ scaffold-directory ]
 | 
			
		||||
        [ scaffold-main ]
 | 
			
		||||
        [ scaffold-authors ]
 | 
			
		||||
        [ nip require ]
 | 
			
		||||
        [ nip scaffold-authors ]
 | 
			
		||||
    } 2cleave ;
 | 
			
		||||
 | 
			
		||||
: scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,6 +1,14 @@
 | 
			
		|||
USING: help.markup help.syntax strings ;
 | 
			
		||||
IN: vocabs.files
 | 
			
		||||
 | 
			
		||||
HELP: vocab-tests-file
 | 
			
		||||
{ $values { "vocab" "a vocabulary specifier" } { "path" "pathname string to test file" } }
 | 
			
		||||
{ $description "Outputs a pathname where the unit test file is located." } ;
 | 
			
		||||
 | 
			
		||||
HELP: vocab-tests-dir
 | 
			
		||||
{ $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } }
 | 
			
		||||
{ $description "Outputs a sequence of pathnames for the tests in the test directory." } ;
 | 
			
		||||
 | 
			
		||||
HELP: vocab-files
 | 
			
		||||
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
 | 
			
		||||
{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -4,8 +4,6 @@ USING: io.directories io.files io.pathnames kernel make
 | 
			
		|||
sequences vocabs.loader ;
 | 
			
		||||
IN: vocabs.files
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: vocab-tests-file ( vocab -- path )
 | 
			
		||||
    dup "-tests.factor" vocab-dir+ vocab-append-path dup
 | 
			
		||||
    [ dup exists? [ drop f ] unless ] [ drop f ] if ;
 | 
			
		||||
| 
						 | 
				
			
			@ -18,8 +16,6 @@ IN: vocabs.files
 | 
			
		|||
        ] [ drop f ] if
 | 
			
		||||
    ] [ drop f ] if ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: vocab-tests ( vocab -- tests )
 | 
			
		||||
    [
 | 
			
		||||
        [ vocab-tests-file [ , ] when* ]
 | 
			
		||||
| 
						 | 
				
			
			@ -31,4 +27,4 @@ PRIVATE>
 | 
			
		|||
        [ vocab-source-path [ , ] when* ]
 | 
			
		||||
        [ vocab-docs-path [ , ] when* ]
 | 
			
		||||
        [ vocab-tests % ] tri
 | 
			
		||||
    ] { } make ;
 | 
			
		||||
    ] { } make ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Erik Charlebois
 | 
			
		||||
| 
						 | 
				
			
			@ -0,0 +1,805 @@
 | 
			
		|||
! Copyright (C) 2010 Erik Charlebois.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien.c-types alien.libraries alien.syntax classes.struct
 | 
			
		||||
kernel math windows.types windows.ole32 ;
 | 
			
		||||
IN: windows.ddk.hid
 | 
			
		||||
 | 
			
		||||
<< "hid" "hid.dll" "stdcall" add-library >>
 | 
			
		||||
LIBRARY: hid
 | 
			
		||||
 | 
			
		||||
TYPEDEF: LONG   NTSTATUS
 | 
			
		||||
TYPEDEF: USHORT USAGE
 | 
			
		||||
TYPEDEF: USAGE* PUSAGE
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_UNDEFINED      HEX: 00
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_GENERIC        HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_SIMULATION     HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_VR             HEX: 03
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_SPORT          HEX: 04
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_GAME           HEX: 05
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_KEYBOARD       HEX: 07
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_LED            HEX: 08
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_BUTTON         HEX: 09
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_ORDINAL        HEX: 0A
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_TELEPHONY      HEX: 0B
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_CONSUMER       HEX: 0C
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_DIGITIZER      HEX: 0D
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_UNICODE        HEX: 10
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_ALPHANUMERIC   HEX: 14
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_PAGE_MICROSOFT_BLUETOOTH_HANDSFREE  HEX: FFF3
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_POINTER      HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_MOUSE        HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_JOYSTICK     HEX: 04
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_GAMEPAD      HEX: 05
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_KEYBOARD     HEX: 06
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_KEYPAD       HEX: 07
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSTEM_CTL   HEX: 80
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_X                        HEX: 30
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_Y                        HEX: 31
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_Z                        HEX: 32
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_RX                       HEX: 33
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_RY                       HEX: 34
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_RZ                       HEX: 35
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SLIDER                   HEX: 36
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_DIAL                     HEX: 37
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_WHEEL                    HEX: 38
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_HATSWITCH                HEX: 39
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_COUNTED_BUFFER           HEX: 3A
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_BYTE_COUNT               HEX: 3B
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_MOTION_WAKEUP            HEX: 3C
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VX                       HEX: 40
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VY                       HEX: 41
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VZ                       HEX: 42
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VBRX                     HEX: 43
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VBRY                     HEX: 44
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VBRZ                     HEX: 45
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_VNO                      HEX: 46
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_POWER             HEX: 81
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_SLEEP             HEX: 82
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_WAKE              HEX: 83
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_CONTEXT_MENU      HEX: 84
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MAIN_MENU         HEX: 85
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_APP_MENU          HEX: 86
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_HELP_MENU         HEX: 87
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_EXIT         HEX: 88
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_SELECT       HEX: 89
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_RIGHT        HEX: 8A
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_LEFT         HEX: 8B
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_UP           HEX: 8C
 | 
			
		||||
CONSTANT: HID_USAGE_GENERIC_SYSCTL_MENU_DOWN         HEX: 8D
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_SIMULATION_RUDDER                HEX: BA
 | 
			
		||||
CONSTANT: HID_USAGE_SIMULATION_THROTTLE              HEX: BB
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_NOEVENT     HEX: 00
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_ROLLOVER    HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_POSTFAIL    HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_UNDEFINED   HEX: 03
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_aA          HEX: 04
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_zZ          HEX: 1D
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_ONE         HEX: 1E
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_ZERO        HEX: 27
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_LCTRL       HEX: E0
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_LSHFT       HEX: E1
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_LALT        HEX: E2
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_LGUI        HEX: E3
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_RCTRL       HEX: E4
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_RSHFT       HEX: E5
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_RALT        HEX: E6
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_RGUI        HEX: E7
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_SCROLL_LOCK HEX: 47
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_NUM_LOCK    HEX: 53
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_CAPS_LOCK   HEX: 39
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_F1          HEX: 3A
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_F12         HEX: 45
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_RETURN      HEX: 28
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_ESCAPE      HEX: 29
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_DELETE      HEX: 2A
 | 
			
		||||
CONSTANT: HID_USAGE_KEYBOARD_PRINT_SCREEN HEX: 46
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_LED_NUM_LOCK               HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CAPS_LOCK              HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SCROLL_LOCK            HEX: 03
 | 
			
		||||
CONSTANT: HID_USAGE_LED_COMPOSE                HEX: 04
 | 
			
		||||
CONSTANT: HID_USAGE_LED_KANA                   HEX: 05
 | 
			
		||||
CONSTANT: HID_USAGE_LED_POWER                  HEX: 06
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SHIFT                  HEX: 07
 | 
			
		||||
CONSTANT: HID_USAGE_LED_DO_NOT_DISTURB         HEX: 08
 | 
			
		||||
CONSTANT: HID_USAGE_LED_MUTE                   HEX: 09
 | 
			
		||||
CONSTANT: HID_USAGE_LED_TONE_ENABLE            HEX: 0A
 | 
			
		||||
CONSTANT: HID_USAGE_LED_HIGH_CUT_FILTER        HEX: 0B
 | 
			
		||||
CONSTANT: HID_USAGE_LED_LOW_CUT_FILTER         HEX: 0C
 | 
			
		||||
CONSTANT: HID_USAGE_LED_EQUALIZER_ENABLE       HEX: 0D
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SOUND_FIELD_ON         HEX: 0E
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SURROUND_FIELD_ON      HEX: 0F
 | 
			
		||||
CONSTANT: HID_USAGE_LED_REPEAT                 HEX: 10
 | 
			
		||||
CONSTANT: HID_USAGE_LED_STEREO                 HEX: 11
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SAMPLING_RATE_DETECT   HEX: 12
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SPINNING               HEX: 13
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CAV                    HEX: 14
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CLV                    HEX: 15
 | 
			
		||||
CONSTANT: HID_USAGE_LED_RECORDING_FORMAT_DET   HEX: 16
 | 
			
		||||
CONSTANT: HID_USAGE_LED_OFF_HOOK               HEX: 17
 | 
			
		||||
CONSTANT: HID_USAGE_LED_RING                   HEX: 18
 | 
			
		||||
CONSTANT: HID_USAGE_LED_MESSAGE_WAITING        HEX: 19
 | 
			
		||||
CONSTANT: HID_USAGE_LED_DATA_MODE              HEX: 1A
 | 
			
		||||
CONSTANT: HID_USAGE_LED_BATTERY_OPERATION      HEX: 1B
 | 
			
		||||
CONSTANT: HID_USAGE_LED_BATTERY_OK             HEX: 1C
 | 
			
		||||
CONSTANT: HID_USAGE_LED_BATTERY_LOW            HEX: 1D
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SPEAKER                HEX: 1E
 | 
			
		||||
CONSTANT: HID_USAGE_LED_HEAD_SET               HEX: 1F
 | 
			
		||||
CONSTANT: HID_USAGE_LED_HOLD                   HEX: 20
 | 
			
		||||
CONSTANT: HID_USAGE_LED_MICROPHONE             HEX: 21
 | 
			
		||||
CONSTANT: HID_USAGE_LED_COVERAGE               HEX: 22
 | 
			
		||||
CONSTANT: HID_USAGE_LED_NIGHT_MODE             HEX: 23
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SEND_CALLS             HEX: 24
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CALL_PICKUP            HEX: 25
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CONFERENCE             HEX: 26
 | 
			
		||||
CONSTANT: HID_USAGE_LED_STAND_BY               HEX: 27
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CAMERA_ON              HEX: 28
 | 
			
		||||
CONSTANT: HID_USAGE_LED_CAMERA_OFF             HEX: 29
 | 
			
		||||
CONSTANT: HID_USAGE_LED_ON_LINE                HEX: 2A
 | 
			
		||||
CONSTANT: HID_USAGE_LED_OFF_LINE               HEX: 2B
 | 
			
		||||
CONSTANT: HID_USAGE_LED_BUSY                   HEX: 2C
 | 
			
		||||
CONSTANT: HID_USAGE_LED_READY                  HEX: 2D
 | 
			
		||||
CONSTANT: HID_USAGE_LED_PAPER_OUT              HEX: 2E
 | 
			
		||||
CONSTANT: HID_USAGE_LED_PAPER_JAM              HEX: 2F
 | 
			
		||||
CONSTANT: HID_USAGE_LED_REMOTE                 HEX: 30
 | 
			
		||||
CONSTANT: HID_USAGE_LED_FORWARD                HEX: 31
 | 
			
		||||
CONSTANT: HID_USAGE_LED_REVERSE                HEX: 32
 | 
			
		||||
CONSTANT: HID_USAGE_LED_STOP                   HEX: 33
 | 
			
		||||
CONSTANT: HID_USAGE_LED_REWIND                 HEX: 34
 | 
			
		||||
CONSTANT: HID_USAGE_LED_FAST_FORWARD           HEX: 35
 | 
			
		||||
CONSTANT: HID_USAGE_LED_PLAY                   HEX: 36
 | 
			
		||||
CONSTANT: HID_USAGE_LED_PAUSE                  HEX: 37
 | 
			
		||||
CONSTANT: HID_USAGE_LED_RECORD                 HEX: 38
 | 
			
		||||
CONSTANT: HID_USAGE_LED_ERROR                  HEX: 39
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SELECTED_INDICATOR     HEX: 3A
 | 
			
		||||
CONSTANT: HID_USAGE_LED_IN_USE_INDICATOR       HEX: 3B
 | 
			
		||||
CONSTANT: HID_USAGE_LED_MULTI_MODE_INDICATOR   HEX: 3C
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_ON           HEX: 3D
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_FLASH        HEX: 3E
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_SLOW_BLINK   HEX: 3F
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_FAST_BLINK   HEX: 40
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_OFF          HEX: 41
 | 
			
		||||
CONSTANT: HID_USAGE_LED_FLASH_ON_TIME          HEX: 42
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SLOW_BLINK_ON_TIME     HEX: 43
 | 
			
		||||
CONSTANT: HID_USAGE_LED_SLOW_BLINK_OFF_TIME    HEX: 44
 | 
			
		||||
CONSTANT: HID_USAGE_LED_FAST_BLINK_ON_TIME     HEX: 45
 | 
			
		||||
CONSTANT: HID_USAGE_LED_FAST_BLINK_OFF_TIME    HEX: 46
 | 
			
		||||
CONSTANT: HID_USAGE_LED_INDICATOR_COLOR        HEX: 47
 | 
			
		||||
CONSTANT: HID_USAGE_LED_RED                    HEX: 48
 | 
			
		||||
CONSTANT: HID_USAGE_LED_GREEN                  HEX: 49
 | 
			
		||||
CONSTANT: HID_USAGE_LED_AMBER                  HEX: 4A
 | 
			
		||||
CONSTANT: HID_USAGE_LED_GENERIC_INDICATOR      HEX: 4B
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_PHONE                  HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_ANSWERING_MACHINE      HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_MESSAGE_CONTROLS       HEX: 03
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_HANDSET                HEX: 04
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_HEADSET                HEX: 05
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_KEYPAD                 HEX: 06
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_PROGRAMMABLE_BUTTON    HEX: 07
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_REDIAL                 HEX: 24
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_TRANSFER               HEX: 25
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_DROP                   HEX: 26
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_LINE                   HEX: 2A
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_RING_ENABLE            HEX: 2D
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_SEND                   HEX: 31
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_KEYPAD_0               HEX: B0
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_KEYPAD_D               HEX: BF
 | 
			
		||||
CONSTANT: HID_USAGE_TELEPHONY_HOST_AVAILABLE         HEX: F1
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_MS_BTH_HF_DIALNUMBER             HEX: 21
 | 
			
		||||
CONSTANT: HID_USAGE_MS_BTH_HF_DIALMEMORY             HEX: 22
 | 
			
		||||
 | 
			
		||||
CONSTANT: HID_USAGE_CONSUMERCTRL          HEX: 01
 | 
			
		||||
CONSTANT: HID_USAGE_DIGITIZER_PEN         HEX: 02
 | 
			
		||||
CONSTANT: HID_USAGE_DIGITIZER_IN_RANGE    HEX: 32
 | 
			
		||||
CONSTANT: HID_USAGE_DIGITIZER_TIP_SWITCH  HEX: 42
 | 
			
		||||
CONSTANT: HID_USAGE_DIGITIZER_BARREL_SWITCH HEX: 44
 | 
			
		||||
 | 
			
		||||
CONSTANT: HIDP_LINK_COLLECTION_ROOT        -1
 | 
			
		||||
CONSTANT: HIDP_LINK_COLLECTION_UNSPECIFIED 0
 | 
			
		||||
 | 
			
		||||
C-ENUM:
 | 
			
		||||
    HidP_Input
 | 
			
		||||
    HidP_Output
 | 
			
		||||
    HidP_Feature ;
 | 
			
		||||
TYPEDEF: int HIDP_REPORT_TYPE
 | 
			
		||||
 | 
			
		||||
STRUCT: USAGE_AND_PAGE
 | 
			
		||||
    { Usage     USAGE }
 | 
			
		||||
    { UsagePage USAGE } ;
 | 
			
		||||
TYPEDEF: USAGE_AND_PAGE* PUSAGE_AND_PAGE
 | 
			
		||||
 | 
			
		||||
: HidP_IsSameUsageAndPage ( u1 u2 -- ? ) = ; inline
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_BUTTONS_CAPS_range
 | 
			
		||||
    { UsageMin        USAGE  }
 | 
			
		||||
    { UsageMax        USAGE  }
 | 
			
		||||
    { StringMin       USHORT }
 | 
			
		||||
    { StringMax       USHORT }
 | 
			
		||||
    { DesignatorMin   USHORT }
 | 
			
		||||
    { DesignatorMax   USHORT }
 | 
			
		||||
    { DataIndexMin    USHORT }
 | 
			
		||||
    { DataIndexMax    USHORT } ;
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_BUTTONS_CAPS_not_range
 | 
			
		||||
    { Usage           USAGE  }
 | 
			
		||||
    { Reserved1       USAGE  }
 | 
			
		||||
    { StringIndex     USHORT }
 | 
			
		||||
    { Reserved2       USHORT }
 | 
			
		||||
    { DesignatorIndex USHORT }
 | 
			
		||||
    { Reserved3       USHORT }
 | 
			
		||||
    { DataIndex       USHORT }
 | 
			
		||||
    { Reserved4       USHORT } ;
 | 
			
		||||
 | 
			
		||||
UNION-STRUCT: HIDP_BUTTONS_CAPS_union
 | 
			
		||||
    { Range    HIDP_BUTTONS_CAPS_range     }
 | 
			
		||||
    { NotRange HIDP_BUTTONS_CAPS_not_range } ;
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_BUTTON_CAPS
 | 
			
		||||
    { UsagePage          USAGE                   }
 | 
			
		||||
    { ReportID           UCHAR                   }
 | 
			
		||||
    { IsAlias            BOOLEAN                 }
 | 
			
		||||
    { BitField           USHORT                  }
 | 
			
		||||
    { LinkCollection     USHORT                  }
 | 
			
		||||
    { LinkUsage          USAGE                   }
 | 
			
		||||
    { LinkUsagePage      USAGE                   }
 | 
			
		||||
    { IsRange            BOOLEAN                 }
 | 
			
		||||
    { IsStringRange      BOOLEAN                 }
 | 
			
		||||
    { IsDesignatorRange  BOOLEAN                 }
 | 
			
		||||
    { IsAbsolute         BOOLEAN                 }
 | 
			
		||||
    { Reserved           ULONG[10]               }
 | 
			
		||||
    { Union              HIDP_BUTTONS_CAPS_union } ;
 | 
			
		||||
TYPEDEF: HIDP_BUTTON_CAPS* PHIDP_BUTTON_CAPS
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_VALUE_CAPS_range
 | 
			
		||||
    { UsageMin        USAGE  }
 | 
			
		||||
    { UsageMax        USAGE  }
 | 
			
		||||
    { StringMin       USHORT }
 | 
			
		||||
    { StringMax       USHORT }
 | 
			
		||||
    { DesignatorMin   USHORT }
 | 
			
		||||
    { DesignatorMax   USHORT }
 | 
			
		||||
    { DataIndexMin    USHORT }
 | 
			
		||||
    { DataIndexMax    USHORT } ;
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_VALUE_CAPS_not_range
 | 
			
		||||
    { Usage             USAGE  }
 | 
			
		||||
    { Reserved1         USAGE  }
 | 
			
		||||
    { StringIndex       USHORT }
 | 
			
		||||
    { Reserved2         USHORT }
 | 
			
		||||
    { DesignatorIndex   USHORT }
 | 
			
		||||
    { Reserved3         USHORT }
 | 
			
		||||
    { DataIndex         USHORT }
 | 
			
		||||
    { Reserved4         USHORT } ;
 | 
			
		||||
 | 
			
		||||
UNION-STRUCT: HIDP_VALUE_CAPS_union
 | 
			
		||||
    { Range    HIDP_VALUE_CAPS_range     }
 | 
			
		||||
    { NotRange HIDP_VALUE_CAPS_not_range } ;
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_VALUE_CAPS
 | 
			
		||||
    { UsagePage          USAGE                  }
 | 
			
		||||
    { ReportID           UCHAR                  }
 | 
			
		||||
    { IsAlias            BOOLEAN                }
 | 
			
		||||
    { BitField           USHORT                 }
 | 
			
		||||
    { LinkCollection     USHORT                 }
 | 
			
		||||
    { LinkUsage          USAGE                  }
 | 
			
		||||
    { LinkUsagePage      USAGE                  }
 | 
			
		||||
    { IsRange            BOOLEAN                }
 | 
			
		||||
    { IsStringRange      BOOLEAN                }
 | 
			
		||||
    { IsDesignatorRange  BOOLEAN                }
 | 
			
		||||
    { IsAbsolute         BOOLEAN                }
 | 
			
		||||
    { HasNull            BOOLEAN                }
 | 
			
		||||
    { Reserved           UCHAR                  }
 | 
			
		||||
    { BitSize            USHORT                 }
 | 
			
		||||
    { ReportCount        USHORT                 }
 | 
			
		||||
    { Reserved2          USHORT[5]              }
 | 
			
		||||
    { UnitsExp           ULONG                  }
 | 
			
		||||
    { Units              ULONG                  }
 | 
			
		||||
    { LogicalMin         LONG                   }
 | 
			
		||||
    { LogicalMax         LONG                   }
 | 
			
		||||
    { PhysicalMin        LONG                   }
 | 
			
		||||
    { PhysicalMax        LONG                   }
 | 
			
		||||
    { Union              HIDP_VALUE_CAPS_union  } ;
 | 
			
		||||
TYPEDEF: HIDP_VALUE_CAPS* PHIDP_VALUE_CAPS
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_LINK_COLLECTION_NODE
 | 
			
		||||
    { LinkUsage                        USAGE  }
 | 
			
		||||
    { LinkUsagePage                    USAGE  }
 | 
			
		||||
    { Parent                           USHORT }
 | 
			
		||||
    { NumberOfChildren                 USHORT }
 | 
			
		||||
    { NextSibling                      USHORT }
 | 
			
		||||
    { FirstChild                       USHORT }
 | 
			
		||||
    { CollectionTypeIsAliasBitfield    ULONG  }
 | 
			
		||||
    { UserContext                      PVOID  } ;
 | 
			
		||||
TYPEDEF: HIDP_LINK_COLLECTION_NODE* PHIDP_LINK_COLLECTION_NODE
 | 
			
		||||
 | 
			
		||||
TYPEDEF: PUCHAR PHIDP_REPORT_DESCRIPTOR
 | 
			
		||||
C-TYPE: HIDP_PREPARSED_DATA
 | 
			
		||||
TYPEDEF: HIDP_PREPARSED_DATA* PHIDP_PREPARSED_DATA
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_CAPS
 | 
			
		||||
    { Usage                       USAGE      }
 | 
			
		||||
    { UsagePage                   USAGE      }
 | 
			
		||||
    { InputReportByteLength       USHORT     }
 | 
			
		||||
    { OutputReportByteLength      USHORT     }
 | 
			
		||||
    { FeatureReportByteLength     USHORT     }
 | 
			
		||||
    { Reserved                    USHORT[17] }
 | 
			
		||||
    { NumberLinkCollectionNodes   USHORT     }
 | 
			
		||||
    { NumberInputButtonCaps       USHORT     }
 | 
			
		||||
    { NumberInputValueCaps        USHORT     }
 | 
			
		||||
    { NumberInputDataIndices      USHORT     }
 | 
			
		||||
    { NumberOutputButtonCaps      USHORT     }
 | 
			
		||||
    { NumberOutputValueCaps       USHORT     }
 | 
			
		||||
    { NumberOutputDataIndices     USHORT     }
 | 
			
		||||
    { NumberFeatureButtonCaps     USHORT     }
 | 
			
		||||
    { NumberFeatureValueCaps      USHORT     }
 | 
			
		||||
    { NumberFeatureDataIndices    USHORT     } ;
 | 
			
		||||
TYPEDEF: HIDP_CAPS* PHIDP_CAPS
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_DATA
 | 
			
		||||
    { DataIndex  USHORT }
 | 
			
		||||
    { Reserved   USHORT }
 | 
			
		||||
    { RawValue   ULONG  } ;
 | 
			
		||||
TYPEDEF: HIDP_DATA* PHIDP_DATA
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_UNKNOWN_TOKEN
 | 
			
		||||
    { Token     UCHAR    }
 | 
			
		||||
    { Reserved  UCHAR[3] }
 | 
			
		||||
    { BitField  ULONG    } ;
 | 
			
		||||
TYPEDEF: HIDP_UNKNOWN_TOKEN* PHIDP_UNKNOWN_TOKEN
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_EXTENDED_ATTRIBUTES
 | 
			
		||||
    { NumGlobalUnknowns   UCHAR               }
 | 
			
		||||
    { Reserved            UCHAR[3]            }
 | 
			
		||||
    { GlobalUnknowns      PHIDP_UNKNOWN_TOKEN }
 | 
			
		||||
    { Data                ULONG[1]            } ;
 | 
			
		||||
TYPEDEF: HIDP_EXTENDED_ATTRIBUTES* PHIDP_EXTENDED_ATTRIBUTES
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetCaps (
 | 
			
		||||
   PHIDP_PREPARSED_DATA      PreparsedData,
 | 
			
		||||
   PHIDP_CAPS                Capabilities
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetLinkCollectionNodes (
 | 
			
		||||
   PHIDP_LINK_COLLECTION_NODE LinkCollectionNodes,
 | 
			
		||||
   PULONG                     LinkCollectionNodesLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA       PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetSpecificButtonCaps (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   USAGE                UsagePage,
 | 
			
		||||
   USHORT               LinkCollection,
 | 
			
		||||
   USAGE                Usage,
 | 
			
		||||
   PHIDP_BUTTON_CAPS    ButtonCaps,
 | 
			
		||||
   PUSHORT              ButtonCapsLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetButtonCaps (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   PHIDP_BUTTON_CAPS    ButtonCaps,
 | 
			
		||||
   PUSHORT              ButtonCapsLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData
 | 
			
		||||
) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetSpecificValueCaps (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   USAGE                UsagePage,
 | 
			
		||||
   USHORT               LinkCollection,
 | 
			
		||||
   USAGE                Usage,
 | 
			
		||||
   PHIDP_VALUE_CAPS     ValueCaps,
 | 
			
		||||
   PUSHORT              ValueCapsLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetValueCaps (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   PHIDP_VALUE_CAPS     ValueCaps,
 | 
			
		||||
   PUSHORT              ValueCapsLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData
 | 
			
		||||
) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetExtendedAttributes (
 | 
			
		||||
    HIDP_REPORT_TYPE            ReportType,
 | 
			
		||||
    USHORT                      DataIndex,
 | 
			
		||||
    PHIDP_PREPARSED_DATA        PreparsedData,
 | 
			
		||||
    PHIDP_EXTENDED_ATTRIBUTES   Attributes,
 | 
			
		||||
    PULONG                      LengthAttributes
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_InitializeReportForID (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   UCHAR                ReportID,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
   PCHAR                Report,
 | 
			
		||||
   ULONG                ReportLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_SetData (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    PHIDP_DATA           DataList,
 | 
			
		||||
    PULONG               DataLength,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetData (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    PHIDP_DATA           DataList,
 | 
			
		||||
    PULONG               DataLength,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: ULONG
 | 
			
		||||
HidP_MaxDataListLength (
 | 
			
		||||
   HIDP_REPORT_TYPE      ReportType,
 | 
			
		||||
   PHIDP_PREPARSED_DATA  PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_SetUsages (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   USAGE                UsagePage,
 | 
			
		||||
   USHORT               LinkCollection,
 | 
			
		||||
   PUSAGE               UsageList,
 | 
			
		||||
   PULONG               UsageLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
   PCHAR                Report,
 | 
			
		||||
   ULONG                ReportLength
 | 
			
		||||
   ) ;
 | 
			
		||||
ALIAS: HidP_SetButtons HidP_SetUsages
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_UnsetUsages (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   USAGE                UsagePage,
 | 
			
		||||
   USHORT               LinkCollection,
 | 
			
		||||
   PUSAGE               UsageList,
 | 
			
		||||
   PULONG               UsageLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
   PCHAR                Report,
 | 
			
		||||
   ULONG                ReportLength
 | 
			
		||||
   ) ;
 | 
			
		||||
ALIAS: HidP_UnsetButtons HidP_UnsetUsages
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetUsages (
 | 
			
		||||
   HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
   USAGE                UsagePage,
 | 
			
		||||
   USHORT               LinkCollection,
 | 
			
		||||
   PUSAGE               UsageList,
 | 
			
		||||
   PULONG               UsageLength,
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
   PCHAR                Report,
 | 
			
		||||
   ULONG                ReportLength
 | 
			
		||||
   ) ;
 | 
			
		||||
ALIAS: HidP_GetButtons HidP_GetUsages
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetUsagesEx (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    PUSAGE_AND_PAGE      ButtonList,
 | 
			
		||||
    ULONG*               UsageLength,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
   ) ;
 | 
			
		||||
ALIAS: HidP_GetButtonsEx HidP_GetUsagesEx
 | 
			
		||||
 | 
			
		||||
FUNCTION: ULONG
 | 
			
		||||
HidP_MaxUsageListLength (
 | 
			
		||||
   HIDP_REPORT_TYPE      ReportType,
 | 
			
		||||
   USAGE                 UsagePage,
 | 
			
		||||
   PHIDP_PREPARSED_DATA  PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_SetUsageValue (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    ULONG                UsageValue,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_SetScaledUsageValue (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    LONG                 UsageValue,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_SetUsageValueArray (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    PCHAR                UsageValue,
 | 
			
		||||
    USHORT               UsageValueByteLength,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetUsageValue (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    PULONG               UsageValue,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetScaledUsageValue (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    PLONG                UsageValue,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_GetUsageValueArray (
 | 
			
		||||
    HIDP_REPORT_TYPE     ReportType,
 | 
			
		||||
    USAGE                UsagePage,
 | 
			
		||||
    USHORT               LinkCollection,
 | 
			
		||||
    USAGE                Usage,
 | 
			
		||||
    PCHAR                UsageValue,
 | 
			
		||||
    USHORT               UsageValueByteLength,
 | 
			
		||||
    PHIDP_PREPARSED_DATA PreparsedData,
 | 
			
		||||
    PCHAR                Report,
 | 
			
		||||
    ULONG                ReportLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_UsageListDifference (
 | 
			
		||||
   PUSAGE   PreviousUsageList,
 | 
			
		||||
   PUSAGE   CurrentUsageList,
 | 
			
		||||
   PUSAGE   BreakUsageList,
 | 
			
		||||
   PUSAGE   MakeUsageList,
 | 
			
		||||
   ULONG    UsageListLength
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_UsageAndPageListDifference (
 | 
			
		||||
   PUSAGE_AND_PAGE PreviousUsageList,
 | 
			
		||||
   PUSAGE_AND_PAGE CurrentUsageList,
 | 
			
		||||
   PUSAGE_AND_PAGE BreakUsageList,
 | 
			
		||||
   PUSAGE_AND_PAGE MakeUsageList,
 | 
			
		||||
   ULONG           UsageListLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
C-ENUM:
 | 
			
		||||
    HidP_Keyboard_Break
 | 
			
		||||
    HidP_Keyboard_Make ;
 | 
			
		||||
TYPEDEF: int HIDP_KEYBOARD_DIRECTION
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDP_KEYBOARD_MODIFIER_STATE
 | 
			
		||||
    { ul ULONG } ;
 | 
			
		||||
TYPEDEF: HIDP_KEYBOARD_MODIFIER_STATE* PHIDP_KEYBOARD_MODIFIER_STATE
 | 
			
		||||
 | 
			
		||||
CALLBACK: BOOLEAN PHIDP_INSERT_SCANCODES (
 | 
			
		||||
    PVOID Context,
 | 
			
		||||
    PCHAR NewScanCodes,
 | 
			
		||||
    ULONG Length ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_TranslateUsageAndPagesToI8042ScanCodes (
 | 
			
		||||
    PUSAGE_AND_PAGE               ChangedUsageList,
 | 
			
		||||
    ULONG                         UsageListLength,
 | 
			
		||||
    HIDP_KEYBOARD_DIRECTION       KeyAction,
 | 
			
		||||
    PHIDP_KEYBOARD_MODIFIER_STATE ModifierState,
 | 
			
		||||
    PHIDP_INSERT_SCANCODES        InsertCodesProcedure,
 | 
			
		||||
    PVOID                         InsertCodesContext
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
FUNCTION: NTSTATUS
 | 
			
		||||
HidP_TranslateUsagesToI8042ScanCodes (
 | 
			
		||||
    PUSAGE                        ChangedUsageList,
 | 
			
		||||
    ULONG                         UsageListLength,
 | 
			
		||||
    HIDP_KEYBOARD_DIRECTION       KeyAction,
 | 
			
		||||
    PHIDP_KEYBOARD_MODIFIER_STATE ModifierState,
 | 
			
		||||
    PHIDP_INSERT_SCANCODES        InsertCodesProcedure,
 | 
			
		||||
    PVOID                         InsertCodesContext
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
CONSTANT: FACILITY_HID_ERROR_CODE HEX: 11
 | 
			
		||||
: HIDP_ERROR_CODES ( SEV CODE -- HRESULT )
 | 
			
		||||
    [ 28 shift ] dip bitor FACILITY_HID_ERROR_CODE 16 shift bitor ; inline
 | 
			
		||||
: HIDP_STATUS_SUCCESS                  ( -- HRESULT ) HEX: 0 HEX: 0 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_NULL                     ( -- HRESULT ) HEX: 8 HEX: 1 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_INVALID_PREPARSED_DATA   ( -- HRESULT ) HEX: C HEX: 1 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_INVALID_REPORT_TYPE      ( -- HRESULT ) HEX: C HEX: 2 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_INVALID_REPORT_LENGTH    ( -- HRESULT ) HEX: C HEX: 3 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_USAGE_NOT_FOUND          ( -- HRESULT ) HEX: C HEX: 4 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_VALUE_OUT_OF_RANGE       ( -- HRESULT ) HEX: C HEX: 5 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_BAD_LOG_PHY_VALUES       ( -- HRESULT ) HEX: C HEX: 6 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_BUFFER_TOO_SMALL         ( -- HRESULT ) HEX: C HEX: 7 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_INTERNAL_ERROR           ( -- HRESULT ) HEX: C HEX: 8 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_I8042_TRANS_UNKNOWN      ( -- HRESULT ) HEX: C HEX: 9 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_INCOMPATIBLE_REPORT_ID   ( -- HRESULT ) HEX: C HEX: A HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_NOT_VALUE_ARRAY          ( -- HRESULT ) HEX: C HEX: B HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_IS_VALUE_ARRAY           ( -- HRESULT ) HEX: C HEX: C HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_DATA_INDEX_NOT_FOUND     ( -- HRESULT ) HEX: C HEX: D HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_DATA_INDEX_OUT_OF_RANGE  ( -- HRESULT ) HEX: C HEX: E HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_BUTTON_NOT_PRESSED       ( -- HRESULT ) HEX: C HEX: F HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_REPORT_DOES_NOT_EXIST    ( -- HRESULT ) HEX: C HEX: 10 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_NOT_IMPLEMENTED          ( -- HRESULT ) HEX: C HEX: 20 HIDP_ERROR_CODES ; inline
 | 
			
		||||
: HIDP_STATUS_I8242_TRANS_UNKNOWN      ( -- HRESULT ) HIDP_STATUS_I8042_TRANS_UNKNOWN ; inline
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDD_CONFIGURATION
 | 
			
		||||
    { cookie            PVOID }
 | 
			
		||||
    { size              ULONG }
 | 
			
		||||
    { RingBufferSize    ULONG } ;
 | 
			
		||||
TYPEDEF: HIDD_CONFIGURATION* PHIDD_CONFIGURATION
 | 
			
		||||
 | 
			
		||||
STRUCT: HIDD_ATTRIBUTES
 | 
			
		||||
    { Size           ULONG  }
 | 
			
		||||
    { VendorID       USHORT }
 | 
			
		||||
    { ProductID      USHORT }
 | 
			
		||||
    { VersionNumber  USHORT } ;
 | 
			
		||||
TYPEDEF: HIDD_ATTRIBUTES* PHIDD_ATTRIBUTES
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetAttributes (
 | 
			
		||||
    HANDLE              HidDeviceObject,
 | 
			
		||||
    PHIDD_ATTRIBUTES    Attributes
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: void
 | 
			
		||||
HidD_GetHidGuid (
 | 
			
		||||
   LPGUID   HidGuid
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetPreparsedData (
 | 
			
		||||
   HANDLE                HidDeviceObject,
 | 
			
		||||
   PHIDP_PREPARSED_DATA* PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_FreePreparsedData (
 | 
			
		||||
   PHIDP_PREPARSED_DATA PreparsedData
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_FlushQueue (
 | 
			
		||||
   HANDLE                HidDeviceObject
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetConfiguration (
 | 
			
		||||
   HANDLE               HidDeviceObject,
 | 
			
		||||
   PHIDD_CONFIGURATION  Configuration,
 | 
			
		||||
   ULONG                ConfigurationLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_SetConfiguration (
 | 
			
		||||
   HANDLE               HidDeviceObject,
 | 
			
		||||
   PHIDD_CONFIGURATION  Configuration,
 | 
			
		||||
   ULONG                ConfigurationLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetFeature (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    ReportBuffer,
 | 
			
		||||
   ULONG    ReportBufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_SetFeature (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    ReportBuffer,
 | 
			
		||||
   ULONG    ReportBufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetInputReport (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    ReportBuffer,
 | 
			
		||||
   ULONG    ReportBufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_SetOutputReport (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    ReportBuffer,
 | 
			
		||||
   ULONG    ReportBufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetNumInputBuffers (
 | 
			
		||||
    HANDLE  HidDeviceObject,
 | 
			
		||||
    PULONG  NumberBuffers
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_SetNumInputBuffers (
 | 
			
		||||
    HANDLE HidDeviceObject,
 | 
			
		||||
    ULONG  NumberBuffers
 | 
			
		||||
    ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetPhysicalDescriptor (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetManufacturerString (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetProductString (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetIndexedString (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   ULONG    StringIndex,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetSerialNumberString (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: BOOLEAN
 | 
			
		||||
HidD_GetMsGenreDescriptor (
 | 
			
		||||
   HANDLE   HidDeviceObject,
 | 
			
		||||
   PVOID    Buffer,
 | 
			
		||||
   ULONG    BufferLength
 | 
			
		||||
   ) ;
 | 
			
		||||
| 
						 | 
				
			
			@ -3,7 +3,8 @@
 | 
			
		|||
 | 
			
		||||
USING: accessors assocs compiler.units continuations fuel.eval fuel.help
 | 
			
		||||
fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser
 | 
			
		||||
sequences tools.scaffold vocabs.loader vocabs.parser words ;
 | 
			
		||||
sequences tools.scaffold vocabs.loader vocabs.parser words vocabs.files
 | 
			
		||||
vocabs.metadata ;
 | 
			
		||||
 | 
			
		||||
IN: fuel
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -145,6 +146,22 @@ PRIVATE>
 | 
			
		|||
    [ fuel-scaffold-name dup require dup scaffold-help ] with-scope
 | 
			
		||||
    vocab-docs-path absolute-path fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
: fuel-scaffold-tests ( name devname -- )
 | 
			
		||||
    [ fuel-scaffold-name dup require dup scaffold-tests ] with-scope
 | 
			
		||||
    vocab-tests-file absolute-path fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
: fuel-scaffold-authors ( name devname -- )
 | 
			
		||||
    [ fuel-scaffold-name dup require dup scaffold-authors ] with-scope
 | 
			
		||||
    [ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
: fuel-scaffold-tags ( name tags -- )
 | 
			
		||||
    [ scaffold-tags ]
 | 
			
		||||
    [ drop [ vocab-tags-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
 | 
			
		||||
 | 
			
		||||
: fuel-scaffold-summary ( name summary -- )
 | 
			
		||||
    [ scaffold-summary ]
 | 
			
		||||
    [ drop [ vocab-summary-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
 | 
			
		||||
 | 
			
		||||
: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
 | 
			
		||||
 | 
			
		||||
! Remote connection
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,103 +1,103 @@
 | 
			
		|||
! Copyright (C) 2007 Chris Double.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel accessors arrays alien system combinators
 | 
			
		||||
alien.syntax namespaces alien.c-types sequences vocabs.loader
 | 
			
		||||
shuffle openal openal.alut.backend alien.libraries generalizations
 | 
			
		||||
specialized-arrays alien.destructors ;
 | 
			
		||||
FROM: alien.c-types => float short ;
 | 
			
		||||
SPECIALIZED-ARRAY: uint
 | 
			
		||||
IN: openal.alut
 | 
			
		||||
 | 
			
		||||
<< "alut" {
 | 
			
		||||
        { [ os windows? ]  [ "alut.dll" ] }
 | 
			
		||||
        { [ os macosx? ] [
 | 
			
		||||
            "/System/Library/Frameworks/OpenAL.framework/OpenAL"
 | 
			
		||||
        ] }
 | 
			
		||||
        { [ os unix?  ]  [ "libalut.so" ] }
 | 
			
		||||
    } cond "cdecl" add-library >>
 | 
			
		||||
 | 
			
		||||
<< os macosx? [ "alut" deploy-library ] unless >>
 | 
			
		||||
 | 
			
		||||
LIBRARY: alut
 | 
			
		||||
 | 
			
		||||
CONSTANT: ALUT_API_MAJOR_VERSION 1
 | 
			
		||||
CONSTANT: ALUT_API_MINOR_VERSION 1
 | 
			
		||||
CONSTANT: ALUT_ERROR_NO_ERROR 0
 | 
			
		||||
CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
 | 
			
		||||
CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
 | 
			
		||||
CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
 | 
			
		||||
CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
 | 
			
		||||
CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
 | 
			
		||||
CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
 | 
			
		||||
CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
 | 
			
		||||
CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
 | 
			
		||||
CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
 | 
			
		||||
CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
 | 
			
		||||
CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
 | 
			
		||||
CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
 | 
			
		||||
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
 | 
			
		||||
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
 | 
			
		||||
CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
 | 
			
		||||
CONSTANT: ALUT_LOADER_BUFFER HEX: 300
 | 
			
		||||
CONSTANT: ALUT_LOADER_MEMORY HEX: 301
 | 
			
		||||
 | 
			
		||||
FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
 | 
			
		||||
FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
 | 
			
		||||
FUNCTION: ALboolean alutExit ( ) ;
 | 
			
		||||
FUNCTION: ALenum alutGetError ( ) ;
 | 
			
		||||
FUNCTION: char* alutGetErrorString ( ALenum error ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryFromFile ( char* fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryHelloWorld ( ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;
 | 
			
		||||
FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ;
 | 
			
		||||
FUNCTION: ALint alutGetMajorVersion ( ) ;
 | 
			
		||||
FUNCTION: ALint alutGetMinorVersion ( ) ;
 | 
			
		||||
FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: init
 | 
			
		||||
 | 
			
		||||
: init-openal ( -- )
 | 
			
		||||
    init get-global expired? [
 | 
			
		||||
        f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
 | 
			
		||||
        1337 <alien> init set-global
 | 
			
		||||
    ] when ;
 | 
			
		||||
 | 
			
		||||
: exit-openal ( -- )
 | 
			
		||||
    init get-global expired? [
 | 
			
		||||
        alutExit 0 = [ "Could not close OpenAL" throw ] when
 | 
			
		||||
        f init set-global
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: create-buffer-from-file ( filename -- buffer )
 | 
			
		||||
    alutCreateBufferFromFile dup AL_NONE = [
 | 
			
		||||
        "create-buffer-from-file failed" throw
 | 
			
		||||
    ] when ;
 | 
			
		||||
 | 
			
		||||
os macosx? "openal.alut.macosx" "openal.alut.other" ? require
 | 
			
		||||
 | 
			
		||||
: create-buffer-from-wav ( filename -- buffer )
 | 
			
		||||
    gen-buffer dup rot load-wav-file
 | 
			
		||||
    [ alBufferData ] 4 nkeep alutUnloadWAV ;
 | 
			
		||||
 | 
			
		||||
: check-error ( -- )
 | 
			
		||||
    alGetError dup ALUT_ERROR_NO_ERROR = [
 | 
			
		||||
        drop
 | 
			
		||||
    ] [
 | 
			
		||||
        alGetString throw
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
! Copyright (C) 2007 Chris Double.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: kernel accessors arrays alien system combinators
 | 
			
		||||
alien.syntax namespaces alien.c-types sequences vocabs.loader
 | 
			
		||||
shuffle openal openal.alut.backend alien.libraries generalizations
 | 
			
		||||
specialized-arrays alien.destructors ;
 | 
			
		||||
FROM: alien.c-types => float short ;
 | 
			
		||||
SPECIALIZED-ARRAY: uint
 | 
			
		||||
IN: openal.alut
 | 
			
		||||
 | 
			
		||||
<< "alut" {
 | 
			
		||||
        { [ os windows? ]  [ "alut.dll" ] }
 | 
			
		||||
        { [ os macosx? ] [
 | 
			
		||||
            "/System/Library/Frameworks/OpenAL.framework/OpenAL"
 | 
			
		||||
        ] }
 | 
			
		||||
        { [ os unix?  ]  [ "libalut.so" ] }
 | 
			
		||||
    } cond "cdecl" add-library >>
 | 
			
		||||
 | 
			
		||||
<< os macosx? [ "alut" deploy-library ] unless >>
 | 
			
		||||
 | 
			
		||||
LIBRARY: alut
 | 
			
		||||
 | 
			
		||||
CONSTANT: ALUT_API_MAJOR_VERSION 1
 | 
			
		||||
CONSTANT: ALUT_API_MINOR_VERSION 1
 | 
			
		||||
CONSTANT: ALUT_ERROR_NO_ERROR 0
 | 
			
		||||
CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
 | 
			
		||||
CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
 | 
			
		||||
CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
 | 
			
		||||
CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
 | 
			
		||||
CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
 | 
			
		||||
CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
 | 
			
		||||
CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
 | 
			
		||||
CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
 | 
			
		||||
CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
 | 
			
		||||
CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
 | 
			
		||||
CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
 | 
			
		||||
CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
 | 
			
		||||
CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
 | 
			
		||||
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
 | 
			
		||||
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
 | 
			
		||||
CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
 | 
			
		||||
CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
 | 
			
		||||
CONSTANT: ALUT_LOADER_BUFFER HEX: 300
 | 
			
		||||
CONSTANT: ALUT_LOADER_MEMORY HEX: 301
 | 
			
		||||
 | 
			
		||||
FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
 | 
			
		||||
FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
 | 
			
		||||
FUNCTION: ALboolean alutExit ( ) ;
 | 
			
		||||
FUNCTION: ALenum alutGetError ( ) ;
 | 
			
		||||
FUNCTION: char* alutGetErrorString ( ALenum error ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;
 | 
			
		||||
FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryFromFile ( char* fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryHelloWorld ( ALenum* format, ALsizei* size, ALfloat* frequency ) ;
 | 
			
		||||
FUNCTION: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;
 | 
			
		||||
FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ;
 | 
			
		||||
FUNCTION: ALint alutGetMajorVersion ( ) ;
 | 
			
		||||
FUNCTION: ALint alutGetMinorVersion ( ) ;
 | 
			
		||||
FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;
 | 
			
		||||
 | 
			
		||||
FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;
 | 
			
		||||
 | 
			
		||||
SYMBOL: init
 | 
			
		||||
 | 
			
		||||
: init-openal ( -- )
 | 
			
		||||
    init get-global expired? [
 | 
			
		||||
        f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
 | 
			
		||||
        1337 <alien> init set-global
 | 
			
		||||
    ] when ;
 | 
			
		||||
 | 
			
		||||
: exit-openal ( -- )
 | 
			
		||||
    init get-global expired? [
 | 
			
		||||
        alutExit 0 = [ "Could not close OpenAL" throw ] when
 | 
			
		||||
        f init set-global
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: create-buffer-from-file ( filename -- buffer )
 | 
			
		||||
    alutCreateBufferFromFile dup AL_NONE = [
 | 
			
		||||
        "create-buffer-from-file failed" throw
 | 
			
		||||
    ] when ;
 | 
			
		||||
 | 
			
		||||
os macosx? "openal.alut.macosx" "openal.alut.other" ? require
 | 
			
		||||
 | 
			
		||||
: create-buffer-from-wav ( filename -- buffer )
 | 
			
		||||
    gen-buffer dup rot load-wav-file
 | 
			
		||||
    [ alBufferData ] 4 nkeep alutUnloadWAV ;
 | 
			
		||||
 | 
			
		||||
: check-error ( -- )
 | 
			
		||||
    alGetError dup ALUT_ERROR_NO_ERROR = [
 | 
			
		||||
        drop
 | 
			
		||||
    ] [
 | 
			
		||||
        alGetString throw
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,33 +1,33 @@
 | 
			
		|||
! Copyright (C) 2007 Chris Double.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: calendar kernel openal openal.alut sequences threads ;
 | 
			
		||||
IN: openal.example
 | 
			
		||||
 | 
			
		||||
: play-hello ( -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup AL_BUFFER  alutCreateBufferHelloWorld set-source-param
 | 
			
		||||
    source-play
 | 
			
		||||
    1000 milliseconds sleep ;
 | 
			
		||||
  
 | 
			
		||||
: (play-file) ( source -- )
 | 
			
		||||
    100 milliseconds sleep
 | 
			
		||||
    dup source-playing? [ (play-file) ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
: play-file ( filename -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    create-buffer-from-file 
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup [ AL_BUFFER rot set-source-param ] dip
 | 
			
		||||
    dup source-play
 | 
			
		||||
    check-error
 | 
			
		||||
    (play-file) ;
 | 
			
		||||
 | 
			
		||||
: play-wav ( filename -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    create-buffer-from-wav 
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup [ AL_BUFFER rot set-source-param ] dip
 | 
			
		||||
    dup source-play
 | 
			
		||||
    check-error
 | 
			
		||||
    (play-file) ;
 | 
			
		||||
! Copyright (C) 2007 Chris Double.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: calendar kernel openal openal.alut sequences threads ;
 | 
			
		||||
IN: openal.example
 | 
			
		||||
 | 
			
		||||
: play-hello ( -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup AL_BUFFER  alutCreateBufferHelloWorld set-source-param
 | 
			
		||||
    source-play
 | 
			
		||||
    1000 milliseconds sleep ;
 | 
			
		||||
  
 | 
			
		||||
: (play-file) ( source -- )
 | 
			
		||||
    100 milliseconds sleep
 | 
			
		||||
    dup source-playing? [ (play-file) ] [ drop ] if ;
 | 
			
		||||
 | 
			
		||||
: play-file ( filename -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    create-buffer-from-file 
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup [ AL_BUFFER rot set-source-param ] dip
 | 
			
		||||
    dup source-play
 | 
			
		||||
    check-error
 | 
			
		||||
    (play-file) ;
 | 
			
		||||
 | 
			
		||||
: play-wav ( filename -- )
 | 
			
		||||
    init-openal
 | 
			
		||||
    create-buffer-from-wav 
 | 
			
		||||
    1 gen-sources
 | 
			
		||||
    first dup [ AL_BUFFER rot set-source-param ] dip
 | 
			
		||||
    dup source-play
 | 
			
		||||
    check-error
 | 
			
		||||
    (play-file) ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -245,11 +245,11 @@ code in the buffer."
 | 
			
		|||
(defsubst factor-mode--in-tests (&optional file)
 | 
			
		||||
  (factor-mode--code-file "tests"))
 | 
			
		||||
 | 
			
		||||
(defun factor-mode-visit-other-file (&optional skip)
 | 
			
		||||
(defun factor-mode-visit-other-file (&optional create)
 | 
			
		||||
  "Cycle between code, tests and docs factor files.
 | 
			
		||||
With prefix, non-existing files will be skipped."
 | 
			
		||||
With prefix, non-existing files will be created."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let ((file (factor-mode--cycle-next (buffer-file-name) skip)))
 | 
			
		||||
  (let ((file (factor-mode--cycle-next (buffer-file-name) (not create))))
 | 
			
		||||
    (unless file (error "No other file found"))
 | 
			
		||||
    (find-file file)
 | 
			
		||||
    (unless (file-exists-p file)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -192,12 +192,15 @@ With prefix, you're teletransported to the listener's buffer."
 | 
			
		|||
    (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
 | 
			
		||||
    (comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
 | 
			
		||||
 | 
			
		||||
(defun fuel-test-vocab (vocab)
 | 
			
		||||
  "Run the unit tests for the specified vocabulary."
 | 
			
		||||
  (interactive (list (fuel-completion--read-vocab nil (fuel-syntax--current-vocab))))
 | 
			
		||||
  (comint-send-string (fuel-listener--process)
 | 
			
		||||
                      (concat "\"" vocab "\" reload nl flush\n"
 | 
			
		||||
                              "\"" vocab "\" test nl flush\n")))
 | 
			
		||||
(defun fuel-test-vocab (&optional arg)
 | 
			
		||||
  "Run the unit tests for the current vocabulary. With prefix argument, ask for
 | 
			
		||||
the vocabulary name."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 | 
			
		||||
                    (fuel-completion--read-vocab nil))))
 | 
			
		||||
    (comint-send-string (fuel-listener--process)
 | 
			
		||||
                        (concat "\"" vocab "\" reload nl flush\n"
 | 
			
		||||
                                "\"" vocab "\" test nl flush\n"))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Completion support
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -79,6 +79,23 @@ IN: %s
 | 
			
		|||
                      "fuel")))
 | 
			
		||||
    (fuel-eval--send/wait cmd)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-scaffold--create-tests (vocab)
 | 
			
		||||
  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-tests)
 | 
			
		||||
                      "fuel")))
 | 
			
		||||
    (fuel-eval--send/wait cmd)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-scaffold--create-authors (vocab)
 | 
			
		||||
  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-authors) "fuel")))
 | 
			
		||||
    (fuel-eval--send/wait cmd)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-scaffold--create-tags (vocab tags)
 | 
			
		||||
  (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
 | 
			
		||||
    (fuel-eval--send/wait cmd)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-scaffold--create-summary (vocab summary)
 | 
			
		||||
  (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
 | 
			
		||||
    (fuel-eval--send/wait cmd)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-scaffold--help (parent)
 | 
			
		||||
  (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
 | 
			
		||||
    (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
 | 
			
		||||
| 
						 | 
				
			
			@ -102,7 +119,8 @@ IN: %s
 | 
			
		|||
 | 
			
		||||
(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
 | 
			
		||||
  "Creates a directory in the given root for a new vocabulary and
 | 
			
		||||
adds source, tests and authors.txt files.
 | 
			
		||||
adds source and authors.txt files. Prompts the user for optional summary,
 | 
			
		||||
tags, help, and test file creation.
 | 
			
		||||
 | 
			
		||||
You can configure `fuel-scaffold-developer-name' (set by default to
 | 
			
		||||
`user-full-name') for the name to be inserted in the generated files."
 | 
			
		||||
| 
						 | 
				
			
			@ -111,12 +129,24 @@ You can configure `fuel-scaffold-developer-name' (set by default to
 | 
			
		|||
         (root (completing-read "Vocab root: "
 | 
			
		||||
                                (fuel-scaffold--vocab-roots)
 | 
			
		||||
                                nil t (or root-hint "resource:")))
 | 
			
		||||
         (summary (read-string "Vocab summary (empty for none): "))
 | 
			
		||||
         (tags (read-string "Vocab tags (empty for none): "))
 | 
			
		||||
         (help (y-or-n-p "Scaffold help? "))
 | 
			
		||||
         (tests (y-or-n-p "Scaffold tests? "))
 | 
			
		||||
         (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
 | 
			
		||||
                        (fuel-scaffold-vocab)) "fuel"))
 | 
			
		||||
         (ret (fuel-eval--send/wait cmd))
 | 
			
		||||
         (file (fuel-eval--retort-result ret)))
 | 
			
		||||
    (unless file
 | 
			
		||||
      (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
    (when (not (equal "" summary))
 | 
			
		||||
      (fuel-scaffold--create-summary name summary))
 | 
			
		||||
    (when (not (equal "" tags))
 | 
			
		||||
      (fuel-scaffold--create-tags name tags))
 | 
			
		||||
    (when help
 | 
			
		||||
         (fuel-scaffold--create-docs name))
 | 
			
		||||
    (when tests
 | 
			
		||||
         (fuel-scaffold--create-tests name))
 | 
			
		||||
    (if other-window (find-file-other-window file) (find-file file))
 | 
			
		||||
    (goto-char (point-max))
 | 
			
		||||
    name))
 | 
			
		||||
| 
						 | 
				
			
			@ -137,6 +167,60 @@ You can configure `fuel-scaffold-developer-name' (set by default to
 | 
			
		|||
          (error "Error creating help file" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
        (find-file file)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-scaffold-tests (&optional arg)
 | 
			
		||||
  "Creates, if it does not already exist, a tests file for the current vocabulary.
 | 
			
		||||
 | 
			
		||||
With prefix argument, ask for the vocabulary name.
 | 
			
		||||
You can configure `fuel-scaffold-developer-name' (set by default to
 | 
			
		||||
`user-full-name') for the name to be inserted in the generated file."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 | 
			
		||||
                    (fuel-completion--read-vocab nil)))
 | 
			
		||||
         (ret (fuel-scaffold--create-tests vocab))
 | 
			
		||||
         (file (fuel-eval--retort-result ret)))
 | 
			
		||||
        (unless file
 | 
			
		||||
          (error "Error creating tests file" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
        (find-file file)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-scaffold-authors (&optional arg)
 | 
			
		||||
  "Creates, if it does not already exist, an authors file for the current vocabulary.
 | 
			
		||||
 | 
			
		||||
With prefix argument, ask for the vocabulary name.
 | 
			
		||||
You can configure `fuel-scaffold-developer-name' (set by default to
 | 
			
		||||
`user-full-name') for the name to be inserted in the generated file."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 | 
			
		||||
                    (fuel-completion--read-vocab nil)))
 | 
			
		||||
         (ret (fuel-scaffold--create-authors vocab))
 | 
			
		||||
         (file (fuel-eval--retort-result ret)))
 | 
			
		||||
        (unless file
 | 
			
		||||
          (error "Error creating authors file" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
        (find-file file)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-scaffold-tags (&optional arg)
 | 
			
		||||
  "Creates, if it does not already exist, a tags file for the current vocabulary."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 | 
			
		||||
                    (fuel-completion--read-vocab nil)))
 | 
			
		||||
         (tags (read-string "Tags: "))
 | 
			
		||||
         (ret (fuel-scaffold--create-tags vocab tags))
 | 
			
		||||
         (file (fuel-eval--retort-result ret)))
 | 
			
		||||
        (unless file
 | 
			
		||||
          (error "Error creating tags file" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
        (find-file file)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-scaffold-summary (&optional arg)
 | 
			
		||||
  "Creates, if it does not already exist, a summary file for the current vocabulary."
 | 
			
		||||
  (interactive "P")
 | 
			
		||||
  (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
 | 
			
		||||
                    (fuel-completion--read-vocab nil)))
 | 
			
		||||
         (summary (read-string "Summary: "))
 | 
			
		||||
         (ret (fuel-scaffold--create-summary vocab summary))
 | 
			
		||||
         (file (fuel-eval--retort-result ret)))
 | 
			
		||||
        (unless file
 | 
			
		||||
          (error "Error creating summary file" (car (fuel-eval--retort-error ret))))
 | 
			
		||||
        (find-file file)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'fuel-scaffold)
 | 
			
		||||
;;; fuel-scaffold.el ends here
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,456 +1,456 @@
 | 
			
		|||
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
 | 
			
		||||
;; See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
 | 
			
		||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
 | 
			
		||||
;; Keywords: languages
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Auxiliar constants and functions to parse factor code.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'thingatpt)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Thing-at-point support for factor symbols:
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-symbol ()
 | 
			
		||||
  "Move point to the beginning of the current symbol."
 | 
			
		||||
  (skip-syntax-backward "w_()"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-symbol-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--beginning-of-symbol) (point)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--end-of-symbol ()
 | 
			
		||||
  "Move point to the end of the current symbol."
 | 
			
		||||
  (skip-syntax-forward "w_()"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-symbol-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--end-of-symbol) (point)))
 | 
			
		||||
 | 
			
		||||
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
 | 
			
		||||
(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax-symbol-at-point ()
 | 
			
		||||
  (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
 | 
			
		||||
    (and (> (length s) 0) s)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Regexps galore:
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--parsing-words
 | 
			
		||||
  '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"
 | 
			
		||||
    "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"
 | 
			
		||||
    "B" "BIN:"
 | 
			
		||||
    "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
 | 
			
		||||
    "DEFER:"
 | 
			
		||||
    "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"
 | 
			
		||||
    "f" "FORGET:" "FROM:" "FUNCTION:"
 | 
			
		||||
    "GAME:" "GENERIC#" "GENERIC:"
 | 
			
		||||
    "GLSL-SHADER:" "GLSL-PROGRAM:"
 | 
			
		||||
    "HELP:" "HEX:" "HOOK:"
 | 
			
		||||
    "IN:" "initial:" "INSTANCE:" "INTERSECTION:"
 | 
			
		||||
    "LIBRARY:"
 | 
			
		||||
    "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
 | 
			
		||||
    "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
 | 
			
		||||
    "OCT:"
 | 
			
		||||
    "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
 | 
			
		||||
    "QUALIFIED-WITH:" "QUALIFIED:"
 | 
			
		||||
    "read-only" "RENAME:" "REQUIRE:"  "REQUIRES:"
 | 
			
		||||
    "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"
 | 
			
		||||
    "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"
 | 
			
		||||
    "UNIFORM-TUPLE:" "UNION:" "USE:" "USING:"
 | 
			
		||||
    "VARS:" "VERTEX-FORMAT:"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--parsing-words-regex
 | 
			
		||||
  (regexp-opt fuel-syntax--parsing-words 'words))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--bracers
 | 
			
		||||
  '("B" "BV" "C" "CS" "H" "T" "V" "W"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--brace-words-regex
 | 
			
		||||
  (format "%s{" (regexp-opt fuel-syntax--bracers t)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--declaration-words
 | 
			
		||||
  '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--declaration-words-regex
 | 
			
		||||
  (regexp-opt fuel-syntax--declaration-words 'words))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--second-word-regex (prefixes)
 | 
			
		||||
  (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--method-definition-regex
 | 
			
		||||
  "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--integer-regex
 | 
			
		||||
  "\\_<-?[0-9]+\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--raw-float-regex
 | 
			
		||||
  "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--float-regex
 | 
			
		||||
  (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--number-regex
 | 
			
		||||
  (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--ratio-regex
 | 
			
		||||
  (format "\\_<[+-]?%s/-?%s\\_>"
 | 
			
		||||
          fuel-syntax--number-regex
 | 
			
		||||
          fuel-syntax--number-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--bad-string-regex
 | 
			
		||||
  "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--word-definition-regex
 | 
			
		||||
  (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"
 | 
			
		||||
          (regexp-opt
 | 
			
		||||
           '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"
 | 
			
		||||
             "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alias-definition-regex
 | 
			
		||||
  "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--vocab-ref-regexp
 | 
			
		||||
  (fuel-syntax--second-word-regex
 | 
			
		||||
   '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--int-constant-def-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--type-definition-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex
 | 
			
		||||
   '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--tuple-decl-regex
 | 
			
		||||
  "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--constructor-regex "<[^ >]+>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")
 | 
			
		||||
(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--symbol-definition-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--stack-effect-regex
 | 
			
		||||
  "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alien-function-regex
 | 
			
		||||
  "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alien-callback-regex
 | 
			
		||||
  "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--indent-def-starts '("" ":"
 | 
			
		||||
                                           "C-ENUM" "C-STRUCT" "C-UNION"
 | 
			
		||||
                                           "FROM" "FUNCTION:"
 | 
			
		||||
                                           "INTERSECTION:"
 | 
			
		||||
                                           "M" "M:" "MACRO" "MACRO:"
 | 
			
		||||
                                           "MEMO" "MEMO:" "METHOD"
 | 
			
		||||
                                           "SYNTAX"
 | 
			
		||||
                                           "PREDICATE" "PRIMITIVE"
 | 
			
		||||
                                           "STRUCT" "TAG" "TUPLE"
 | 
			
		||||
                                           "TYPED" "TYPED:"
 | 
			
		||||
                                           "UNIFORM-TUPLE"
 | 
			
		||||
                                           "UNION-STRUCT" "UNION"
 | 
			
		||||
                                           "VERTEX-FORMAT"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"
 | 
			
		||||
                                              "HELP"
 | 
			
		||||
                                              "SINGLETONS"
 | 
			
		||||
                                              "SPECIALIZED-ARRAYS"
 | 
			
		||||
                                              "SYMBOLS"
 | 
			
		||||
                                              "VARS"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--indent-def-start-regex
 | 
			
		||||
  (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-start-regex
 | 
			
		||||
  (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts
 | 
			
		||||
                                            fuel-syntax--indent-def-starts))))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-end-regex
 | 
			
		||||
  (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
 | 
			
		||||
          fuel-syntax--declaration-words-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--single-liner-regex
 | 
			
		||||
  (regexp-opt '("ABOUT:"
 | 
			
		||||
                "ALIAS:"
 | 
			
		||||
                "CONSTANT:" "C:" "C-TYPE:"
 | 
			
		||||
                "DEFER:"
 | 
			
		||||
                "FORGET:"
 | 
			
		||||
                "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" 
 | 
			
		||||
                "HEX:" "HOOK:"
 | 
			
		||||
                "IN:" "INSTANCE:"
 | 
			
		||||
                "LIBRARY:"
 | 
			
		||||
                "MAIN:" "MATH:" "MIXIN:"
 | 
			
		||||
                "OCT:"
 | 
			
		||||
                "POSTPONE:" "PRIVATE>" "<PRIVATE"
 | 
			
		||||
                "QUALIFIED-WITH:" "QUALIFIED:"
 | 
			
		||||
                "RENAME:"
 | 
			
		||||
                "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"
 | 
			
		||||
                "TYPEDEF:"
 | 
			
		||||
                "USE:"
 | 
			
		||||
                "VAR:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--begin-of-def-regex
 | 
			
		||||
  (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
 | 
			
		||||
          fuel-syntax--definition-start-regex
 | 
			
		||||
          fuel-syntax--single-liner-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--end-of-def-line-regex
 | 
			
		||||
  (format "^.*%s" fuel-syntax--definition-end-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--end-of-def-regex
 | 
			
		||||
  (format "\\(%s\\)\\|\\(^%s .*\\)"
 | 
			
		||||
          fuel-syntax--end-of-def-line-regex
 | 
			
		||||
          fuel-syntax--single-liner-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--word-signature-regex
 | 
			
		||||
  (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--defun-signature-regex
 | 
			
		||||
  (format "\\(%s\\|%s\\)"
 | 
			
		||||
          fuel-syntax--word-signature-regex
 | 
			
		||||
          "M[^:]*: [^ ]+ [^ ]+"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--constructor-decl-regex
 | 
			
		||||
  "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--typedef-regex
 | 
			
		||||
  "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--rename-regex
 | 
			
		||||
  "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Factor syntax table
 | 
			
		||||
 | 
			
		||||
(setq fuel-syntax--syntax-table
 | 
			
		||||
  (let ((table (make-syntax-table)))
 | 
			
		||||
    ;; Default is word constituent
 | 
			
		||||
    (dotimes (i 256)
 | 
			
		||||
      (modify-syntax-entry i "w" table))
 | 
			
		||||
    ;; Whitespace (TAB is not whitespace)
 | 
			
		||||
    (modify-syntax-entry ?\f " " table)
 | 
			
		||||
    (modify-syntax-entry ?\r " " table)
 | 
			
		||||
    (modify-syntax-entry ?\  " " table)
 | 
			
		||||
    (modify-syntax-entry ?\n " " table)
 | 
			
		||||
    table))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--syntactic-keywords
 | 
			
		||||
  `(;; Strings and chars
 | 
			
		||||
    ("\\_<<\\(\"\\)\\_>" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(\"\\)>\\_>" (1 ">b"))
 | 
			
		||||
    ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"
 | 
			
		||||
     (3 "\"") (6 "\""))
 | 
			
		||||
    ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
 | 
			
		||||
     (1 "w") (2 "<b") (4 ">b"))
 | 
			
		||||
    ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))
 | 
			
		||||
    ;; Comments
 | 
			
		||||
    ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ;; postpone
 | 
			
		||||
    ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ;; Multiline constructs
 | 
			
		||||
    ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
 | 
			
		||||
    ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ("\\_<USING:\\( \\)" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"
 | 
			
		||||
     (2 "<b"))
 | 
			
		||||
    ("\\(\n\\| \\);\\_>" (1 ">b"))
 | 
			
		||||
    ;; Let and lambda:
 | 
			
		||||
    ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
 | 
			
		||||
    ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
 | 
			
		||||
    (" \\(|\\) " (1 "(|"))
 | 
			
		||||
    (" \\(|\\)$" (1 ")"))
 | 
			
		||||
    ;; Opening brace words:
 | 
			
		||||
    ("\\_<\\w*\\({\\)\\_>" (1 "(}"))
 | 
			
		||||
    ("\\_<\\(}\\)\\_>" (1 "){"))
 | 
			
		||||
    ;; Parenthesis:
 | 
			
		||||
    ("\\_<\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\w*\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\()\\)\\_>" (1 ")("))
 | 
			
		||||
    ("\\_<(\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\()\\))\\_>" (1 ")("))
 | 
			
		||||
    ;; Quotations:
 | 
			
		||||
    ("\\_<'\\(\\[\\)\\_>" (1 "(]"))      ; fried
 | 
			
		||||
    ("\\_<$\\(\\[\\)\\_>" (1 "(]"))      ; parse-time
 | 
			
		||||
    ("\\_<\\(\\[\\)\\_>" (1 "(]"))
 | 
			
		||||
    ("\\_<\\(\\]\\)\\_>" (1 ")["))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Source code analysis:
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--brackets-depth ()
 | 
			
		||||
  (nth 0 (syntax-ppss)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--brackets-start ()
 | 
			
		||||
  (nth 1 (syntax-ppss)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--brackets-end ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (fuel-syntax--brackets-start))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (progn (forward-sexp)
 | 
			
		||||
               (1- (point)))
 | 
			
		||||
      (error -1))))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--indentation-at (pos)
 | 
			
		||||
  (save-excursion (goto-char pos) (current-indentation)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--increased-indentation (&optional i)
 | 
			
		||||
  (+ (or i (current-indentation)) factor-indent-width))
 | 
			
		||||
(defsubst fuel-syntax--decreased-indentation (&optional i)
 | 
			
		||||
  (- (or i (current-indentation)) factor-indent-width))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-begin-of-def ()
 | 
			
		||||
  (looking-at fuel-syntax--begin-of-def-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-begin-of-indent-def ()
 | 
			
		||||
  (looking-at fuel-syntax--indent-def-start-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-end-of-def ()
 | 
			
		||||
  (looking-at fuel-syntax--end-of-def-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--looking-at-emptiness ()
 | 
			
		||||
  (looking-at "^[ ]*$\\|$"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--is-last-char (pos)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (1+ pos))
 | 
			
		||||
    (looking-at-p "[ ]*$")))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--line-offset (pos)
 | 
			
		||||
  (- pos (save-excursion
 | 
			
		||||
           (goto-char pos)
 | 
			
		||||
           (beginning-of-line)
 | 
			
		||||
           (point))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--previous-non-blank ()
 | 
			
		||||
  (forward-line -1)
 | 
			
		||||
  (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
 | 
			
		||||
    (forward-line -1)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-block-pos ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (if (> (fuel-syntax--brackets-depth) 0)
 | 
			
		||||
        (fuel-syntax--brackets-start)
 | 
			
		||||
      (fuel-syntax--beginning-of-defun)
 | 
			
		||||
      (point))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--at-setter-line ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (beginning-of-line)
 | 
			
		||||
    (when (re-search-forward fuel-syntax--setter-regex
 | 
			
		||||
                             (line-end-position)
 | 
			
		||||
                             t)
 | 
			
		||||
      (let* ((to (match-beginning 0))
 | 
			
		||||
             (from (fuel-syntax--beginning-of-block-pos)))
 | 
			
		||||
        (goto-char from)
 | 
			
		||||
        (let ((depth (fuel-syntax--brackets-depth)))
 | 
			
		||||
          (and (or (re-search-forward fuel-syntax--constructor-regex to t)
 | 
			
		||||
                   (re-search-forward fuel-syntax--setter-regex to t))
 | 
			
		||||
               (= depth (fuel-syntax--brackets-depth))))))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--at-constructor-line ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (beginning-of-line)
 | 
			
		||||
    (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-using ()
 | 
			
		||||
  (looking-at fuel-syntax--using-lines-regex))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--in-using ()
 | 
			
		||||
  (let ((p (point)))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (and (re-search-backward "^USING: " nil t)
 | 
			
		||||
           (re-search-forward " ;" nil t)
 | 
			
		||||
           (< p (match-end 0))))))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-defun (&optional times)
 | 
			
		||||
  (re-search-backward fuel-syntax--begin-of-def-regex nil t times))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-defun ()
 | 
			
		||||
  (re-search-forward fuel-syntax--end-of-def-regex nil t))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-defun-pos ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (re-search-forward fuel-syntax--end-of-def-regex nil t)
 | 
			
		||||
    (point)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-body ()
 | 
			
		||||
  (let ((p (point)))
 | 
			
		||||
    (and (fuel-syntax--beginning-of-defun)
 | 
			
		||||
         (re-search-forward fuel-syntax--defun-signature-regex p t)
 | 
			
		||||
         (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-sexp ()
 | 
			
		||||
  (if (> (fuel-syntax--brackets-depth) 0)
 | 
			
		||||
      (goto-char (fuel-syntax--brackets-start))
 | 
			
		||||
    (fuel-syntax--beginning-of-body)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-sexp-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--beginning-of-sexp) (point)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; USING/IN:
 | 
			
		||||
 | 
			
		||||
(make-variable-buffer-local
 | 
			
		||||
 (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--current-vocab ()
 | 
			
		||||
  (funcall fuel-syntax--current-vocab-function))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--find-in ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (when (re-search-backward fuel-syntax--current-vocab-regex nil t)
 | 
			
		||||
      (match-string-no-properties 1))))
 | 
			
		||||
 | 
			
		||||
(make-variable-buffer-local
 | 
			
		||||
 (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--usings ()
 | 
			
		||||
  (funcall fuel-syntax--usings-function))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--file-has-private ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
 | 
			
		||||
         (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--find-usings (&optional no-private)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (let ((usings))
 | 
			
		||||
      (goto-char (point-max))
 | 
			
		||||
      (while (re-search-backward fuel-syntax--using-lines-regex nil t)
 | 
			
		||||
        (dolist (u (split-string (match-string-no-properties 1) nil t))
 | 
			
		||||
          (push u usings)))
 | 
			
		||||
      (when (and (not no-private) (fuel-syntax--file-has-private))
 | 
			
		||||
        (goto-char (point-max))
 | 
			
		||||
        (push (concat (fuel-syntax--find-in) ".private") usings))
 | 
			
		||||
      usings)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'fuel-syntax)
 | 
			
		||||
;;; fuel-syntax.el ends here
 | 
			
		||||
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
 | 
			
		||||
 | 
			
		||||
;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
 | 
			
		||||
;; See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
 | 
			
		||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
 | 
			
		||||
;; Keywords: languages
 | 
			
		||||
 | 
			
		||||
;;; Commentary:
 | 
			
		||||
 | 
			
		||||
;; Auxiliar constants and functions to parse factor code.
 | 
			
		||||
 | 
			
		||||
;;; Code:
 | 
			
		||||
 | 
			
		||||
(require 'thingatpt)
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Thing-at-point support for factor symbols:
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-symbol ()
 | 
			
		||||
  "Move point to the beginning of the current symbol."
 | 
			
		||||
  (skip-syntax-backward "w_()"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-symbol-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--beginning-of-symbol) (point)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--end-of-symbol ()
 | 
			
		||||
  "Move point to the end of the current symbol."
 | 
			
		||||
  (skip-syntax-forward "w_()"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-symbol-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--end-of-symbol) (point)))
 | 
			
		||||
 | 
			
		||||
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
 | 
			
		||||
(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax-symbol-at-point ()
 | 
			
		||||
  (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
 | 
			
		||||
    (and (> (length s) 0) s)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Regexps galore:
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--parsing-words
 | 
			
		||||
  '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"
 | 
			
		||||
    "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"
 | 
			
		||||
    "B" "BIN:"
 | 
			
		||||
    "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
 | 
			
		||||
    "DEFER:"
 | 
			
		||||
    "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"
 | 
			
		||||
    "f" "FORGET:" "FROM:" "FUNCTION:"
 | 
			
		||||
    "GAME:" "GENERIC#" "GENERIC:"
 | 
			
		||||
    "GLSL-SHADER:" "GLSL-PROGRAM:"
 | 
			
		||||
    "HELP:" "HEX:" "HOOK:"
 | 
			
		||||
    "IN:" "initial:" "INSTANCE:" "INTERSECTION:"
 | 
			
		||||
    "LIBRARY:"
 | 
			
		||||
    "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
 | 
			
		||||
    "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
 | 
			
		||||
    "OCT:"
 | 
			
		||||
    "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
 | 
			
		||||
    "QUALIFIED-WITH:" "QUALIFIED:"
 | 
			
		||||
    "read-only" "RENAME:" "REQUIRE:"  "REQUIRES:"
 | 
			
		||||
    "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"
 | 
			
		||||
    "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"
 | 
			
		||||
    "UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:"
 | 
			
		||||
    "VARS:" "VERTEX-FORMAT:"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--parsing-words-regex
 | 
			
		||||
  (regexp-opt fuel-syntax--parsing-words 'words))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--bracers
 | 
			
		||||
  '("B" "BV" "C" "CS" "H" "T" "V" "W"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--brace-words-regex
 | 
			
		||||
  (format "%s{" (regexp-opt fuel-syntax--bracers t)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--declaration-words
 | 
			
		||||
  '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--declaration-words-regex
 | 
			
		||||
  (regexp-opt fuel-syntax--declaration-words 'words))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--second-word-regex (prefixes)
 | 
			
		||||
  (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--method-definition-regex
 | 
			
		||||
  "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--integer-regex
 | 
			
		||||
  "\\_<-?[0-9]+\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--raw-float-regex
 | 
			
		||||
  "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--float-regex
 | 
			
		||||
  (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--number-regex
 | 
			
		||||
  (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--ratio-regex
 | 
			
		||||
  (format "\\_<[+-]?%s/-?%s\\_>"
 | 
			
		||||
          fuel-syntax--number-regex
 | 
			
		||||
          fuel-syntax--number-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--bad-string-regex
 | 
			
		||||
  "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--word-definition-regex
 | 
			
		||||
  (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"
 | 
			
		||||
          (regexp-opt
 | 
			
		||||
           '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"
 | 
			
		||||
             "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alias-definition-regex
 | 
			
		||||
  "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--vocab-ref-regexp
 | 
			
		||||
  (fuel-syntax--second-word-regex
 | 
			
		||||
   '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--int-constant-def-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--type-definition-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex
 | 
			
		||||
   '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--tuple-decl-regex
 | 
			
		||||
  "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--constructor-regex "<[^ >]+>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")
 | 
			
		||||
(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--symbol-definition-regex
 | 
			
		||||
  (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--stack-effect-regex
 | 
			
		||||
  "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alien-function-regex
 | 
			
		||||
  "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--alien-callback-regex
 | 
			
		||||
  "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--indent-def-starts '("" ":"
 | 
			
		||||
                                           "C-ENUM" "C-STRUCT" "C-UNION"
 | 
			
		||||
                                           "FROM" "FUNCTION:"
 | 
			
		||||
                                           "INTERSECTION:"
 | 
			
		||||
                                           "M" "M:" "MACRO" "MACRO:"
 | 
			
		||||
                                           "MEMO" "MEMO:" "METHOD"
 | 
			
		||||
                                           "SYNTAX"
 | 
			
		||||
                                           "PREDICATE" "PRIMITIVE"
 | 
			
		||||
                                           "STRUCT" "TAG" "TUPLE"
 | 
			
		||||
                                           "TYPED" "TYPED:"
 | 
			
		||||
                                           "UNIFORM-TUPLE"
 | 
			
		||||
                                           "UNION-STRUCT" "UNION"
 | 
			
		||||
                                           "VERTEX-FORMAT"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"
 | 
			
		||||
                                              "HELP"
 | 
			
		||||
                                              "SINGLETONS"
 | 
			
		||||
                                              "SPECIALIZED-ARRAYS"
 | 
			
		||||
                                              "SYMBOLS"
 | 
			
		||||
                                              "VARS"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--indent-def-start-regex
 | 
			
		||||
  (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-start-regex
 | 
			
		||||
  (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts
 | 
			
		||||
                                            fuel-syntax--indent-def-starts))))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--definition-end-regex
 | 
			
		||||
  (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
 | 
			
		||||
          fuel-syntax--declaration-words-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--single-liner-regex
 | 
			
		||||
  (regexp-opt '("ABOUT:"
 | 
			
		||||
                "ALIAS:"
 | 
			
		||||
                "CONSTANT:" "C:" "C-TYPE:"
 | 
			
		||||
                "DEFER:"
 | 
			
		||||
                "FORGET:"
 | 
			
		||||
                "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" 
 | 
			
		||||
                "HEX:" "HOOK:"
 | 
			
		||||
                "IN:" "INSTANCE:"
 | 
			
		||||
                "LIBRARY:"
 | 
			
		||||
                "MAIN:" "MATH:" "MIXIN:"
 | 
			
		||||
                "OCT:"
 | 
			
		||||
                "POSTPONE:" "PRIVATE>" "<PRIVATE"
 | 
			
		||||
                "QUALIFIED-WITH:" "QUALIFIED:"
 | 
			
		||||
                "RENAME:"
 | 
			
		||||
                "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"
 | 
			
		||||
                "TYPEDEF:"
 | 
			
		||||
                "USE:"
 | 
			
		||||
                "VAR:")))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--begin-of-def-regex
 | 
			
		||||
  (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
 | 
			
		||||
          fuel-syntax--definition-start-regex
 | 
			
		||||
          fuel-syntax--single-liner-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--end-of-def-line-regex
 | 
			
		||||
  (format "^.*%s" fuel-syntax--definition-end-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--end-of-def-regex
 | 
			
		||||
  (format "\\(%s\\)\\|\\(^%s .*\\)"
 | 
			
		||||
          fuel-syntax--end-of-def-line-regex
 | 
			
		||||
          fuel-syntax--single-liner-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--word-signature-regex
 | 
			
		||||
  (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--defun-signature-regex
 | 
			
		||||
  (format "\\(%s\\|%s\\)"
 | 
			
		||||
          fuel-syntax--word-signature-regex
 | 
			
		||||
          "M[^:]*: [^ ]+ [^ ]+"))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--constructor-decl-regex
 | 
			
		||||
  "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--typedef-regex
 | 
			
		||||
  "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--rename-regex
 | 
			
		||||
  "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Factor syntax table
 | 
			
		||||
 | 
			
		||||
(setq fuel-syntax--syntax-table
 | 
			
		||||
  (let ((table (make-syntax-table)))
 | 
			
		||||
    ;; Default is word constituent
 | 
			
		||||
    (dotimes (i 256)
 | 
			
		||||
      (modify-syntax-entry i "w" table))
 | 
			
		||||
    ;; Whitespace (TAB is not whitespace)
 | 
			
		||||
    (modify-syntax-entry ?\f " " table)
 | 
			
		||||
    (modify-syntax-entry ?\r " " table)
 | 
			
		||||
    (modify-syntax-entry ?\  " " table)
 | 
			
		||||
    (modify-syntax-entry ?\n " " table)
 | 
			
		||||
    table))
 | 
			
		||||
 | 
			
		||||
(defconst fuel-syntax--syntactic-keywords
 | 
			
		||||
  `(;; Strings and chars
 | 
			
		||||
    ("\\_<<\\(\"\\)\\_>" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(\"\\)>\\_>" (1 ">b"))
 | 
			
		||||
    ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"
 | 
			
		||||
     (3 "\"") (6 "\""))
 | 
			
		||||
    ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
 | 
			
		||||
     (1 "w") (2 "<b") (4 ">b"))
 | 
			
		||||
    ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))
 | 
			
		||||
    ;; Comments
 | 
			
		||||
    ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ;; postpone
 | 
			
		||||
    ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ;; Multiline constructs
 | 
			
		||||
    ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
 | 
			
		||||
    ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ("\\_<USING:\\( \\)" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
 | 
			
		||||
    ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))
 | 
			
		||||
    ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"
 | 
			
		||||
     (2 "<b"))
 | 
			
		||||
    ("\\(\n\\| \\);\\_>" (1 ">b"))
 | 
			
		||||
    ;; Let and lambda:
 | 
			
		||||
    ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
 | 
			
		||||
    ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
 | 
			
		||||
    (" \\(|\\) " (1 "(|"))
 | 
			
		||||
    (" \\(|\\)$" (1 ")"))
 | 
			
		||||
    ;; Opening brace words:
 | 
			
		||||
    ("\\_<\\w*\\({\\)\\_>" (1 "(}"))
 | 
			
		||||
    ("\\_<\\(}\\)\\_>" (1 "){"))
 | 
			
		||||
    ;; Parenthesis:
 | 
			
		||||
    ("\\_<\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\w*\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\()\\)\\_>" (1 ")("))
 | 
			
		||||
    ("\\_<(\\((\\)\\_>" (1 "()"))
 | 
			
		||||
    ("\\_<\\()\\))\\_>" (1 ")("))
 | 
			
		||||
    ;; Quotations:
 | 
			
		||||
    ("\\_<'\\(\\[\\)\\_>" (1 "(]"))      ; fried
 | 
			
		||||
    ("\\_<$\\(\\[\\)\\_>" (1 "(]"))      ; parse-time
 | 
			
		||||
    ("\\_<\\(\\[\\)\\_>" (1 "(]"))
 | 
			
		||||
    ("\\_<\\(\\]\\)\\_>" (1 ")["))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; Source code analysis:
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--brackets-depth ()
 | 
			
		||||
  (nth 0 (syntax-ppss)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--brackets-start ()
 | 
			
		||||
  (nth 1 (syntax-ppss)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--brackets-end ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (fuel-syntax--brackets-start))
 | 
			
		||||
    (condition-case nil
 | 
			
		||||
        (progn (forward-sexp)
 | 
			
		||||
               (1- (point)))
 | 
			
		||||
      (error -1))))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--indentation-at (pos)
 | 
			
		||||
  (save-excursion (goto-char pos) (current-indentation)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--increased-indentation (&optional i)
 | 
			
		||||
  (+ (or i (current-indentation)) factor-indent-width))
 | 
			
		||||
(defsubst fuel-syntax--decreased-indentation (&optional i)
 | 
			
		||||
  (- (or i (current-indentation)) factor-indent-width))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-begin-of-def ()
 | 
			
		||||
  (looking-at fuel-syntax--begin-of-def-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-begin-of-indent-def ()
 | 
			
		||||
  (looking-at fuel-syntax--indent-def-start-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-end-of-def ()
 | 
			
		||||
  (looking-at fuel-syntax--end-of-def-regex))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--looking-at-emptiness ()
 | 
			
		||||
  (looking-at "^[ ]*$\\|$"))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--is-last-char (pos)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (1+ pos))
 | 
			
		||||
    (looking-at-p "[ ]*$")))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--line-offset (pos)
 | 
			
		||||
  (- pos (save-excursion
 | 
			
		||||
           (goto-char pos)
 | 
			
		||||
           (beginning-of-line)
 | 
			
		||||
           (point))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--previous-non-blank ()
 | 
			
		||||
  (forward-line -1)
 | 
			
		||||
  (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
 | 
			
		||||
    (forward-line -1)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-block-pos ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (if (> (fuel-syntax--brackets-depth) 0)
 | 
			
		||||
        (fuel-syntax--brackets-start)
 | 
			
		||||
      (fuel-syntax--beginning-of-defun)
 | 
			
		||||
      (point))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--at-setter-line ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (beginning-of-line)
 | 
			
		||||
    (when (re-search-forward fuel-syntax--setter-regex
 | 
			
		||||
                             (line-end-position)
 | 
			
		||||
                             t)
 | 
			
		||||
      (let* ((to (match-beginning 0))
 | 
			
		||||
             (from (fuel-syntax--beginning-of-block-pos)))
 | 
			
		||||
        (goto-char from)
 | 
			
		||||
        (let ((depth (fuel-syntax--brackets-depth)))
 | 
			
		||||
          (and (or (re-search-forward fuel-syntax--constructor-regex to t)
 | 
			
		||||
                   (re-search-forward fuel-syntax--setter-regex to t))
 | 
			
		||||
               (= depth (fuel-syntax--brackets-depth))))))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--at-constructor-line ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (beginning-of-line)
 | 
			
		||||
    (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--at-using ()
 | 
			
		||||
  (looking-at fuel-syntax--using-lines-regex))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--in-using ()
 | 
			
		||||
  (let ((p (point)))
 | 
			
		||||
    (save-excursion
 | 
			
		||||
      (and (re-search-backward "^USING: " nil t)
 | 
			
		||||
           (re-search-forward " ;" nil t)
 | 
			
		||||
           (< p (match-end 0))))))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-defun (&optional times)
 | 
			
		||||
  (re-search-backward fuel-syntax--begin-of-def-regex nil t times))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-defun ()
 | 
			
		||||
  (re-search-forward fuel-syntax--end-of-def-regex nil t))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--end-of-defun-pos ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (re-search-forward fuel-syntax--end-of-def-regex nil t)
 | 
			
		||||
    (point)))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-body ()
 | 
			
		||||
  (let ((p (point)))
 | 
			
		||||
    (and (fuel-syntax--beginning-of-defun)
 | 
			
		||||
         (re-search-forward fuel-syntax--defun-signature-regex p t)
 | 
			
		||||
         (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--beginning-of-sexp ()
 | 
			
		||||
  (if (> (fuel-syntax--brackets-depth) 0)
 | 
			
		||||
      (goto-char (fuel-syntax--brackets-start))
 | 
			
		||||
    (fuel-syntax--beginning-of-body)))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--beginning-of-sexp-pos ()
 | 
			
		||||
  (save-excursion (fuel-syntax--beginning-of-sexp) (point)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;; USING/IN:
 | 
			
		||||
 | 
			
		||||
(make-variable-buffer-local
 | 
			
		||||
 (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--current-vocab ()
 | 
			
		||||
  (funcall fuel-syntax--current-vocab-function))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--find-in ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (when (re-search-backward fuel-syntax--current-vocab-regex nil t)
 | 
			
		||||
      (match-string-no-properties 1))))
 | 
			
		||||
 | 
			
		||||
(make-variable-buffer-local
 | 
			
		||||
 (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
 | 
			
		||||
 | 
			
		||||
(defsubst fuel-syntax--usings ()
 | 
			
		||||
  (funcall fuel-syntax--usings-function))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--file-has-private ()
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (goto-char (point-min))
 | 
			
		||||
    (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
 | 
			
		||||
         (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
 | 
			
		||||
 | 
			
		||||
(defun fuel-syntax--find-usings (&optional no-private)
 | 
			
		||||
  (save-excursion
 | 
			
		||||
    (let ((usings))
 | 
			
		||||
      (goto-char (point-max))
 | 
			
		||||
      (while (re-search-backward fuel-syntax--using-lines-regex nil t)
 | 
			
		||||
        (dolist (u (split-string (match-string-no-properties 1) nil t))
 | 
			
		||||
          (push u usings)))
 | 
			
		||||
      (when (and (not no-private) (fuel-syntax--file-has-private))
 | 
			
		||||
        (goto-char (point-max))
 | 
			
		||||
        (push (concat (fuel-syntax--find-in) ".private") usings))
 | 
			
		||||
      usings)))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(provide 'fuel-syntax)
 | 
			
		||||
;;; fuel-syntax.el ends here
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue