steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://github.com/erikcharlebois/factor

db4
Slava Pestov 2010-02-22 20:09:20 +13:00
parent 2c34ecbdb5 a56d0a7602
commit 1986dc49e4
18 changed files with 1752 additions and 796 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/alien/parser/parser-tests.factor
View File

@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors alien.c-types alien.parser alien.syntax USING: accessors alien.c-types alien.parser alien.syntax
tools.test vocabs.parser parser eval vocabs.parser debugger tools.test vocabs.parser parser eval debugger kernel
continuations ; continuations words ;
IN: alien.parser.tests IN: alien.parser.tests
TYPEDEF: char char2 TYPEDEF: char char2
@ -34,6 +34,11 @@ CONSTANT: eleven 11
] with-file-vocabs ] 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 ! Reported by mnestic
TYPEDEF: int alien-parser-test-int ! reasonably unique name... TYPEDEF: int alien-parser-test-int ! reasonably unique name...

6
basis/alien/parser/parser.factor
View File

@ -72,10 +72,10 @@ IN: alien.parser
: function-quot ( return library function types -- quot ) : function-quot ( return library function types -- quot )
'[ _ _ _ _ alien-invoke ] ; '[ _ _ _ _ alien-invoke ] ;
:: make-function ( return! library function! parameters -- word quot effect ) :: make-function ( return library function parameters -- word quot effect )
return function normalize-c-arg function! return! return function normalize-c-arg :> ( return-c-type function )
function create-in dup reset-generic function create-in dup reset-generic
return library function return-c-type library function
parameters return parse-arglist [ function-quot ] dip ; parameters return parse-arglist [ function-quot ] dip ;
: parse-arg-tokens ( -- tokens ) : parse-arg-tokens ( -- tokens )

108
basis/concurrency/mailboxes/mailboxes-tests.factor
View File

@ -1,54 +1,54 @@
USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions
vectors sequences threads tools.test math kernel strings namespaces vectors sequences threads tools.test math kernel strings namespaces
continuations calendar destructors ; continuations calendar destructors ;
IN: concurrency.mailboxes.tests IN: concurrency.mailboxes.tests
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as { 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
[ V{ 1 2 3 } ] [ [ V{ 1 2 3 } ] [
0 <vector> 0 <vector>
<mailbox> <mailbox>
[ mailbox-get swap push ] in-thread [ mailbox-get swap push ] in-thread
[ mailbox-get swap push ] in-thread [ mailbox-get swap push ] in-thread
[ mailbox-get swap push ] in-thread [ mailbox-get swap push ] in-thread
1 over mailbox-put 1 over mailbox-put
2 over mailbox-put 2 over mailbox-put
3 swap mailbox-put 3 swap mailbox-put
] unit-test ] unit-test
[ V{ 1 2 3 } ] [ [ V{ 1 2 3 } ] [
0 <vector> 0 <vector>
<mailbox> <mailbox>
[ [ integer? ] mailbox-get? swap push ] in-thread [ [ integer? ] mailbox-get? swap push ] in-thread
[ [ integer? ] mailbox-get? swap push ] in-thread [ [ 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 1 over mailbox-put
2 over mailbox-put 2 over mailbox-put
3 swap mailbox-put 3 swap mailbox-put
] unit-test ] unit-test
[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [ [ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
0 <vector> 0 <vector>
<mailbox> <mailbox>
[ [ integer? ] mailbox-get? swap push ] in-thread [ [ integer? ] mailbox-get? swap push ] in-thread
[ [ 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
[ [ string? ] mailbox-get? swap push ] in-thread [ [ string? ] mailbox-get? swap push ] in-thread
1 over mailbox-put 1 over mailbox-put
"junk" over mailbox-put "junk" over mailbox-put
[ 456 ] over mailbox-put [ 456 ] over mailbox-put
3 over mailbox-put 3 over mailbox-put
"junk2" over mailbox-put "junk2" over mailbox-put
mailbox-get mailbox-get
] unit-test ] unit-test
[ { "foo" "bar" } ] [ [ { "foo" "bar" } ] [
<mailbox> <mailbox>
"foo" over mailbox-put "foo" over mailbox-put
"bar" over mailbox-put "bar" over mailbox-put
mailbox-get-all mailbox-get-all
] unit-test ] unit-test
[ [
<mailbox> 1 seconds mailbox-get-timeout <mailbox> 1 seconds mailbox-get-timeout
] [ wait-timeout? ] must-fail-with ] [ wait-timeout? ] must-fail-with

188
basis/concurrency/mailboxes/mailboxes.factor
View File

@ -1,94 +1,94 @@
! Copyright (C) 2005, 2010 Chris Double, Slava Pestov. ! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: dlists deques threads sequences continuations namespaces USING: dlists deques threads sequences continuations namespaces
math quotations words kernel arrays assocs init system math quotations words kernel arrays assocs init system
concurrency.conditions accessors debugger debugger.threads concurrency.conditions accessors debugger debugger.threads
locals fry ; locals fry ;
IN: concurrency.mailboxes IN: concurrency.mailboxes
TUPLE: mailbox threads data ; TUPLE: mailbox threads data ;
: <mailbox> ( -- mailbox ) : <mailbox> ( -- mailbox )
mailbox new mailbox new
<dlist> >>threads <dlist> >>threads
<dlist> >>data ; <dlist> >>data ;
: mailbox-empty? ( mailbox -- bool ) : mailbox-empty? ( mailbox -- bool )
data>> deque-empty? ; data>> deque-empty? ;
: mailbox-put ( obj mailbox -- ) : mailbox-put ( obj mailbox -- )
[ data>> push-front ] [ data>> push-front ]
[ threads>> notify-all ] bi yield ; [ threads>> notify-all ] bi yield ;
: wait-for-mailbox ( mailbox timeout -- ) : wait-for-mailbox ( mailbox timeout -- )
[ threads>> ] dip "mailbox" wait ; [ threads>> ] dip "mailbox" wait ;
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- ) :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
mailbox data>> pred dlist-any? [ mailbox data>> pred dlist-any? [
mailbox timeout wait-for-mailbox mailbox timeout wait-for-mailbox
mailbox timeout pred block-unless-pred mailbox timeout pred block-unless-pred
] unless ; inline recursive ] unless ; inline recursive
: block-if-empty ( mailbox timeout -- mailbox ) : block-if-empty ( mailbox timeout -- mailbox )
over mailbox-empty? [ over mailbox-empty? [
2dup wait-for-mailbox block-if-empty 2dup wait-for-mailbox block-if-empty
] [ ] [
drop drop
] if ; ] if ;
: mailbox-peek ( mailbox -- obj ) : mailbox-peek ( mailbox -- obj )
data>> peek-back ; data>> peek-back ;
: mailbox-get-timeout ( mailbox timeout -- obj ) : mailbox-get-timeout ( mailbox timeout -- obj )
block-if-empty data>> pop-back ; block-if-empty data>> pop-back ;
: mailbox-get ( mailbox -- obj ) : mailbox-get ( mailbox -- obj )
f mailbox-get-timeout ; f mailbox-get-timeout ;
: mailbox-get-all-timeout ( mailbox timeout -- array ) : mailbox-get-all-timeout ( mailbox timeout -- array )
block-if-empty block-if-empty
[ dup mailbox-empty? not ] [ dup mailbox-empty? not ]
[ dup data>> pop-back ] [ dup data>> pop-back ]
produce nip ; produce nip ;
: mailbox-get-all ( mailbox -- array ) : mailbox-get-all ( mailbox -- array )
f mailbox-get-all-timeout ; f mailbox-get-all-timeout ;
: while-mailbox-empty ( mailbox quot -- ) : while-mailbox-empty ( mailbox quot -- )
[ '[ _ mailbox-empty? ] ] dip while ; inline [ '[ _ mailbox-empty? ] ] dip while ; inline
: mailbox-get-timeout? ( mailbox timeout pred -- obj ) : mailbox-get-timeout? ( mailbox timeout pred -- obj )
[ block-unless-pred ] [ block-unless-pred ]
[ [ drop data>> ] dip delete-node-if ] [ [ drop data>> ] dip delete-node-if ]
3bi ; inline 3bi ; inline
: mailbox-get? ( mailbox pred -- obj ) : mailbox-get? ( mailbox pred -- obj )
f swap mailbox-get-timeout? ; inline f swap mailbox-get-timeout? ; inline
: wait-for-close-timeout ( mailbox timeout -- ) : wait-for-close-timeout ( mailbox timeout -- )
over disposed>> over disposed>>
[ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ; [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;
: wait-for-close ( mailbox -- ) : wait-for-close ( mailbox -- )
f wait-for-close-timeout ; f wait-for-close-timeout ;
TUPLE: linked-error error thread ; TUPLE: linked-error error thread ;
M: linked-error error. M: linked-error error.
[ thread>> error-in-thread. ] [ error>> error. ] bi ; [ thread>> error-in-thread. ] [ error>> error. ] bi ;
C: <linked-error> linked-error C: <linked-error> linked-error
: ?linked ( message -- message ) : ?linked ( message -- message )
dup linked-error? [ rethrow ] when ; dup linked-error? [ rethrow ] when ;
TUPLE: linked-thread < thread supervisor ; TUPLE: linked-thread < thread supervisor ;
M: linked-thread error-in-thread M: linked-thread error-in-thread
[ <linked-error> ] [ supervisor>> ] bi mailbox-put ; [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
: <linked-thread> ( quot name mailbox -- thread' ) : <linked-thread> ( quot name mailbox -- thread' )
[ linked-thread new-thread ] dip >>supervisor ; [ linked-thread new-thread ] dip >>supervisor ;
: spawn-linked-to ( quot name mailbox -- thread ) : spawn-linked-to ( quot name mailbox -- thread )
<linked-thread> [ (spawn) ] keep ; <linked-thread> [ (spawn) ] keep ;

54
basis/concurrency/promises/promises.factor
View File

@ -1,27 +1,27 @@
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors concurrency.mailboxes kernel continuations ; USING: accessors concurrency.mailboxes kernel continuations ;
IN: concurrency.promises IN: concurrency.promises
TUPLE: promise mailbox ; TUPLE: promise mailbox ;
: <promise> ( -- promise ) : <promise> ( -- promise )
<mailbox> promise boa ; <mailbox> promise boa ;
: promise-fulfilled? ( promise -- ? ) : promise-fulfilled? ( promise -- ? )
mailbox>> mailbox-empty? not ; mailbox>> mailbox-empty? not ;
ERROR: promise-already-fulfilled promise ; ERROR: promise-already-fulfilled promise ;
: fulfill ( value promise -- ) : fulfill ( value promise -- )
dup promise-fulfilled? [ dup promise-fulfilled? [
promise-already-fulfilled promise-already-fulfilled
] [ ] [
mailbox>> mailbox-put mailbox>> mailbox-put
] if ; ] if ;
: ?promise-timeout ( promise timeout -- result ) : ?promise-timeout ( promise timeout -- result )
[ mailbox>> ] dip block-if-empty mailbox-peek ; [ mailbox>> ] dip block-if-empty mailbox-peek ;
: ?promise ( promise -- result ) : ?promise ( promise -- result )
f ?promise-timeout ; f ?promise-timeout ;

26
basis/tools/scaffold/scaffold-docs.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: tools.scaffold
HELP: developer-name HELP: developer-name
@ -23,6 +23,30 @@ HELP: scaffold-undocumented
{ scaffold-help scaffold-undocumented } related-words { 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 HELP: scaffold-vocab
{ $values { $values
{ "vocab-root" "a vocabulary root string" } { "string" string } } { "vocab-root" "a vocabulary root string" } { "string" string } }

27
basis/tools/scaffold/scaffold.factor
View File

@ -59,6 +59,9 @@ M: bad-developer-name summary
: vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path ) : vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path )
[ vocab-root/vocab>path dup file-name append-path ] dip append ; [ 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/suffix>path ( vocab suffix -- path )
[ vocab>path dup file-name append-path ] dip append ; [ vocab>path dup file-name append-path ] dip append ;
@ -100,16 +103,17 @@ M: bad-developer-name summary
2drop 2drop
] if ; ] if ;
: scaffold-authors ( vocab-root vocab -- ) : scaffold-metadata ( vocab file contents -- )
developer-name get [ [ ensure-vocab-exists ] 2dip
"authors.txt" vocab-root/vocab/file>path scaffolding? [ [
developer-name get swap utf8 set-file-contents [ vocab/file>path ] dip swap scaffolding? [
utf8 set-file-contents
] [ ] [
drop 2drop
] if ] if
] [ ] [
2drop 2drop
] if ; ] if* ;
: lookup-type ( string -- object/string ? ) : lookup-type ( string -- object/string ? )
"new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
@ -254,12 +258,21 @@ PRIVATE>
: scaffold-undocumented ( string -- ) : scaffold-undocumented ( string -- )
[ interesting-words. ] [ link-vocab ] bi ; [ 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-vocab ( vocab-root string -- )
{ {
[ scaffold-directory ] [ scaffold-directory ]
[ scaffold-main ] [ scaffold-main ]
[ scaffold-authors ]
[ nip require ] [ nip require ]
[ nip scaffold-authors ]
} 2cleave ; } 2cleave ;
: scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ; : scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;

8
basis/vocabs/files/files-docs.factor
View File

@ -1,6 +1,14 @@
USING: help.markup help.syntax strings ; USING: help.markup help.syntax strings ;
IN: vocabs.files 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 HELP: vocab-files
{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } } { $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." } ; { $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;

6
basis/vocabs/files/files.factor
View File

@ -4,8 +4,6 @@ USING: io.directories io.files io.pathnames kernel make
sequences vocabs.loader ; sequences vocabs.loader ;
IN: vocabs.files IN: vocabs.files
<PRIVATE
: vocab-tests-file ( vocab -- path ) : vocab-tests-file ( vocab -- path )
dup "-tests.factor" vocab-dir+ vocab-append-path dup dup "-tests.factor" vocab-dir+ vocab-append-path dup
[ dup exists? [ drop f ] unless ] [ drop f ] if ; [ dup exists? [ drop f ] unless ] [ drop f ] if ;
@ -18,8 +16,6 @@ IN: vocabs.files
] [ drop f ] if ] [ drop f ] if
] [ drop f ] if ; ] [ drop f ] if ;
PRIVATE>
: vocab-tests ( vocab -- tests ) : vocab-tests ( vocab -- tests )
[ [
[ vocab-tests-file [ , ] when* ] [ vocab-tests-file [ , ] when* ]
@ -31,4 +27,4 @@ PRIVATE>
[ vocab-source-path [ , ] when* ] [ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ] [ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri [ vocab-tests % ] tri
] { } make ; ] { } make ;

1
basis/windows/ddk/hid/authors.txt Normal file
View File

@ -0,0 +1 @@
Erik Charlebois

805
basis/windows/ddk/hid/hid.factor Normal file
View File

@ -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
) ;

19
extra/fuel/fuel.factor
View File

@ -3,7 +3,8 @@
USING: accessors assocs compiler.units continuations fuel.eval fuel.help USING: accessors assocs compiler.units continuations fuel.eval fuel.help
fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser 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 IN: fuel
@ -145,6 +146,22 @@ PRIVATE>
[ fuel-scaffold-name dup require dup scaffold-help ] with-scope [ fuel-scaffold-name dup require dup scaffold-help ] with-scope
vocab-docs-path absolute-path fuel-eval-set-result ; 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 ; : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
! Remote connection ! Remote connection

206
extra/openal/alut/alut.factor
View File

@ -1,103 +1,103 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors arrays alien system combinators USING: kernel accessors arrays alien system combinators
alien.syntax namespaces alien.c-types sequences vocabs.loader alien.syntax namespaces alien.c-types sequences vocabs.loader
shuffle openal openal.alut.backend alien.libraries generalizations shuffle openal openal.alut.backend alien.libraries generalizations
specialized-arrays alien.destructors ; specialized-arrays alien.destructors ;
FROM: alien.c-types => float short ; FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint
IN: openal.alut IN: openal.alut
<< "alut" { << "alut" {
{ [ os windows? ] [ "alut.dll" ] } { [ os windows? ] [ "alut.dll" ] }
{ [ os macosx? ] [ { [ os macosx? ] [
"/System/Library/Frameworks/OpenAL.framework/OpenAL" "/System/Library/Frameworks/OpenAL.framework/OpenAL"
] } ] }
{ [ os unix? ] [ "libalut.so" ] } { [ os unix? ] [ "libalut.so" ] }
} cond "cdecl" add-library >> } cond "cdecl" add-library >>
<< os macosx? [ "alut" deploy-library ] unless >> << os macosx? [ "alut" deploy-library ] unless >>
LIBRARY: alut LIBRARY: alut
CONSTANT: ALUT_API_MAJOR_VERSION 1 CONSTANT: ALUT_API_MAJOR_VERSION 1
CONSTANT: ALUT_API_MINOR_VERSION 1 CONSTANT: ALUT_API_MINOR_VERSION 1
CONSTANT: ALUT_ERROR_NO_ERROR 0 CONSTANT: ALUT_ERROR_NO_ERROR 0
CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200 CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200
CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201 CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201
CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202 CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202
CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203 CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203
CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204 CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204
CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205 CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205
CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206 CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206
CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207 CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207
CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208 CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208
CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209 CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209
CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A
CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B
CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C
CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D
CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F
CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210 CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210
CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211 CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211
CONSTANT: ALUT_WAVEFORM_SINE HEX: 100 CONSTANT: ALUT_WAVEFORM_SINE HEX: 100
CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101 CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101
CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102 CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102
CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103 CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103
CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104 CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104
CONSTANT: ALUT_LOADER_BUFFER HEX: 300 CONSTANT: ALUT_LOADER_BUFFER HEX: 300
CONSTANT: ALUT_LOADER_MEMORY HEX: 301 CONSTANT: ALUT_LOADER_MEMORY HEX: 301
FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ; FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;
FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ; FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;
FUNCTION: ALboolean alutExit ( ) ; FUNCTION: ALboolean alutExit ( ) ;
FUNCTION: ALenum alutGetError ( ) ; FUNCTION: ALenum alutGetError ( ) ;
FUNCTION: char* alutGetErrorString ( ALenum error ) ; FUNCTION: char* alutGetErrorString ( ALenum error ) ;
FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ; FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ;
FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ; FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;
FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ; FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;
FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ; FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;
FUNCTION: void* alutLoadMemoryFromFile ( char* fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ; 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* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;
FUNCTION: void* alutLoadMemoryHelloWorld ( 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: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;
FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ; FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ;
FUNCTION: ALint alutGetMajorVersion ( ) ; FUNCTION: ALint alutGetMajorVersion ( ) ;
FUNCTION: ALint alutGetMinorVersion ( ) ; FUNCTION: ALint alutGetMinorVersion ( ) ;
FUNCTION: ALboolean alutSleep ( ALfloat duration ) ; FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;
FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ; FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;
SYMBOL: init SYMBOL: init
: init-openal ( -- ) : init-openal ( -- )
init get-global expired? [ init get-global expired? [
f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when
1337 <alien> init set-global 1337 <alien> init set-global
] when ; ] when ;
: exit-openal ( -- ) : exit-openal ( -- )
init get-global expired? [ init get-global expired? [
alutExit 0 = [ "Could not close OpenAL" throw ] when alutExit 0 = [ "Could not close OpenAL" throw ] when
f init set-global f init set-global
] unless ; ] unless ;
: create-buffer-from-file ( filename -- buffer ) : create-buffer-from-file ( filename -- buffer )
alutCreateBufferFromFile dup AL_NONE = [ alutCreateBufferFromFile dup AL_NONE = [
"create-buffer-from-file failed" throw "create-buffer-from-file failed" throw
] when ; ] when ;
os macosx? "openal.alut.macosx" "openal.alut.other" ? require os macosx? "openal.alut.macosx" "openal.alut.other" ? require
: create-buffer-from-wav ( filename -- buffer ) : create-buffer-from-wav ( filename -- buffer )
gen-buffer dup rot load-wav-file gen-buffer dup rot load-wav-file
[ alBufferData ] 4 nkeep alutUnloadWAV ; [ alBufferData ] 4 nkeep alutUnloadWAV ;
: check-error ( -- ) : check-error ( -- )
alGetError dup ALUT_ERROR_NO_ERROR = [ alGetError dup ALUT_ERROR_NO_ERROR = [
drop drop
] [ ] [
alGetString throw alGetString throw
] if ; ] if ;

66
extra/openal/example/example.factor
View File

@ -1,33 +1,33 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: calendar kernel openal openal.alut sequences threads ; USING: calendar kernel openal openal.alut sequences threads ;
IN: openal.example IN: openal.example
: play-hello ( -- ) : play-hello ( -- )
init-openal init-openal
1 gen-sources 1 gen-sources
first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param
source-play source-play
1000 milliseconds sleep ; 1000 milliseconds sleep ;
: (play-file) ( source -- ) : (play-file) ( source -- )
100 milliseconds sleep 100 milliseconds sleep
dup source-playing? [ (play-file) ] [ drop ] if ; dup source-playing? [ (play-file) ] [ drop ] if ;
: play-file ( filename -- ) : play-file ( filename -- )
init-openal init-openal
create-buffer-from-file create-buffer-from-file
1 gen-sources 1 gen-sources
first dup [ AL_BUFFER rot set-source-param ] dip first dup [ AL_BUFFER rot set-source-param ] dip
dup source-play dup source-play
check-error check-error
(play-file) ; (play-file) ;
: play-wav ( filename -- ) : play-wav ( filename -- )
init-openal init-openal
create-buffer-from-wav create-buffer-from-wav
1 gen-sources 1 gen-sources
first dup [ AL_BUFFER rot set-source-param ] dip first dup [ AL_BUFFER rot set-source-param ] dip
dup source-play dup source-play
check-error check-error
(play-file) ; (play-file) ;

6
misc/fuel/factor-mode.el
View File

@ -245,11 +245,11 @@ code in the buffer."
(defsubst factor-mode--in-tests (&optional file) (defsubst factor-mode--in-tests (&optional file)
(factor-mode--code-file "tests")) (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. "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") (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")) (unless file (error "No other file found"))
(find-file file) (find-file file)
(unless (file-exists-p file) (unless (file-exists-p file)

15
misc/fuel/fuel-listener.el
View 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 "\"Refreshing loaded vocabs...\" write nl flush")
(comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))) (comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
(defun fuel-test-vocab (vocab) (defun fuel-test-vocab (&optional arg)
"Run the unit tests for the specified vocabulary." "Run the unit tests for the current vocabulary. With prefix argument, ask for
(interactive (list (fuel-completion--read-vocab nil (fuel-syntax--current-vocab)))) the vocabulary name."
(comint-send-string (fuel-listener--process) (interactive "P")
(concat "\"" vocab "\" reload nl flush\n" (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
"\"" vocab "\" test nl flush\n"))) (fuel-completion--read-vocab nil))))
(comint-send-string (fuel-listener--process)
(concat "\"" vocab "\" reload nl flush\n"
"\"" vocab "\" test nl flush\n"))))
;;; Completion support ;;; Completion support

86
misc/fuel/fuel-scaffold.el
View File

@ -79,6 +79,23 @@ IN: %s
"fuel"))) "fuel")))
(fuel-eval--send/wait cmd))) (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) (defun fuel-scaffold--help (parent)
(when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p)) (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
(let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent))) (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) (defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
"Creates a directory in the given root for a new vocabulary and "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 You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated files." `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: " (root (completing-read "Vocab root: "
(fuel-scaffold--vocab-roots) (fuel-scaffold--vocab-roots)
nil t (or root-hint "resource:"))) 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) (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
(fuel-scaffold-vocab)) "fuel")) (fuel-scaffold-vocab)) "fuel"))
(ret (fuel-eval--send/wait cmd)) (ret (fuel-eval--send/wait cmd))
(file (fuel-eval--retort-result ret))) (file (fuel-eval--retort-result ret)))
(unless file (unless file
(error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret)))) (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)) (if other-window (find-file-other-window file) (find-file file))
(goto-char (point-max)) (goto-char (point-max))
name)) 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)))) (error "Error creating help file" (car (fuel-eval--retort-error ret))))
(find-file file))) (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) (provide 'fuel-scaffold)
;;; fuel-scaffold.el ends here ;;; fuel-scaffold.el ends here

912
misc/fuel/fuel-syntax.el
View File

@ -1,456 +1,456 @@
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation. ;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license. ;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages ;; Keywords: languages
;;; Commentary: ;;; Commentary:
;; Auxiliar constants and functions to parse factor code. ;; Auxiliar constants and functions to parse factor code.
;;; Code: ;;; Code:
(require 'thingatpt) (require 'thingatpt)
;;; Thing-at-point support for factor symbols: ;;; Thing-at-point support for factor symbols:
(defun fuel-syntax--beginning-of-symbol () (defun fuel-syntax--beginning-of-symbol ()
"Move point to the beginning of the current symbol." "Move point to the beginning of the current symbol."
(skip-syntax-backward "w_()")) (skip-syntax-backward "w_()"))
(defsubst fuel-syntax--beginning-of-symbol-pos () (defsubst fuel-syntax--beginning-of-symbol-pos ()
(save-excursion (fuel-syntax--beginning-of-symbol) (point))) (save-excursion (fuel-syntax--beginning-of-symbol) (point)))
(defun fuel-syntax--end-of-symbol () (defun fuel-syntax--end-of-symbol ()
"Move point to the end of the current symbol." "Move point to the end of the current symbol."
(skip-syntax-forward "w_()")) (skip-syntax-forward "w_()"))
(defsubst fuel-syntax--end-of-symbol-pos () (defsubst fuel-syntax--end-of-symbol-pos ()
(save-excursion (fuel-syntax--end-of-symbol) (point))) (save-excursion (fuel-syntax--end-of-symbol) (point)))
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol) (put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol) (put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
(defsubst fuel-syntax-symbol-at-point () (defsubst fuel-syntax-symbol-at-point ()
(let ((s (substring-no-properties (thing-at-point 'factor-symbol)))) (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
(and (> (length s) 0) s))) (and (> (length s) 0) s)))
;;; Regexps galore: ;;; Regexps galore:
(defconst fuel-syntax--parsing-words (defconst fuel-syntax--parsing-words
'(":" "::" ";" "&:" "<<" "<PRIVATE" ">>" '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"
"ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:" "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"
"B" "BIN:" "B" "BIN:"
"C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method" "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
"DEFER:" "DEFER:"
"EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"
"f" "FORGET:" "FROM:" "FUNCTION:" "f" "FORGET:" "FROM:" "FUNCTION:"
"GAME:" "GENERIC#" "GENERIC:" "GAME:" "GENERIC#" "GENERIC:"
"GLSL-SHADER:" "GLSL-PROGRAM:" "GLSL-SHADER:" "GLSL-PROGRAM:"
"HELP:" "HEX:" "HOOK:" "HELP:" "HEX:" "HOOK:"
"IN:" "initial:" "INSTANCE:" "INTERSECTION:" "IN:" "initial:" "INSTANCE:" "INTERSECTION:"
"LIBRARY:" "LIBRARY:"
"M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:" "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"
"MEMO:" "MEMO:" "METHOD:" "MIXIN:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
"OCT:" "OCT:"
"POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
"QUALIFIED-WITH:" "QUALIFIED:" "QUALIFIED-WITH:" "QUALIFIED:"
"read-only" "RENAME:" "REQUIRE:" "REQUIRES:" "read-only" "RENAME:" "REQUIRE:" "REQUIRES:"
"SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:" "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"
"TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::" "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"
"UNIFORM-TUPLE:" "UNION:" "USE:" "USING:" "UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:"
"VARS:" "VERTEX-FORMAT:")) "VARS:" "VERTEX-FORMAT:"))
(defconst fuel-syntax--parsing-words-regex (defconst fuel-syntax--parsing-words-regex
(regexp-opt fuel-syntax--parsing-words 'words)) (regexp-opt fuel-syntax--parsing-words 'words))
(defconst fuel-syntax--bracers (defconst fuel-syntax--bracers
'("B" "BV" "C" "CS" "H" "T" "V" "W")) '("B" "BV" "C" "CS" "H" "T" "V" "W"))
(defconst fuel-syntax--brace-words-regex (defconst fuel-syntax--brace-words-regex
(format "%s{" (regexp-opt fuel-syntax--bracers t))) (format "%s{" (regexp-opt fuel-syntax--bracers t)))
(defconst fuel-syntax--declaration-words (defconst fuel-syntax--declaration-words
'("flushable" "foldable" "inline" "parsing" "recursive" "delimiter")) '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
(defconst fuel-syntax--declaration-words-regex (defconst fuel-syntax--declaration-words-regex
(regexp-opt fuel-syntax--declaration-words 'words)) (regexp-opt fuel-syntax--declaration-words 'words))
(defsubst fuel-syntax--second-word-regex (prefixes) (defsubst fuel-syntax--second-word-regex (prefixes)
(format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t))) (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
(defconst fuel-syntax--method-definition-regex (defconst fuel-syntax--method-definition-regex
"^M::? +\\([^ ]+\\) +\\([^ ]+\\)") "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")
(defconst fuel-syntax--integer-regex (defconst fuel-syntax--integer-regex
"\\_<-?[0-9]+\\_>") "\\_<-?[0-9]+\\_>")
(defconst fuel-syntax--raw-float-regex (defconst fuel-syntax--raw-float-regex
"[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?") "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")
(defconst fuel-syntax--float-regex (defconst fuel-syntax--float-regex
(format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex)) (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))
(defconst fuel-syntax--number-regex (defconst fuel-syntax--number-regex
(format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex)) (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))
(defconst fuel-syntax--ratio-regex (defconst fuel-syntax--ratio-regex
(format "\\_<[+-]?%s/-?%s\\_>" (format "\\_<[+-]?%s/-?%s\\_>"
fuel-syntax--number-regex fuel-syntax--number-regex
fuel-syntax--number-regex)) fuel-syntax--number-regex))
(defconst fuel-syntax--bad-string-regex (defconst fuel-syntax--bad-string-regex
"\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n") "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")
(defconst fuel-syntax--word-definition-regex (defconst fuel-syntax--word-definition-regex
(format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>" (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"
(regexp-opt (regexp-opt
'(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE" '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"
"SYMBOL" "SYNTAX" "TYPED" "RENAME")))) "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))
(defconst fuel-syntax--alias-definition-regex (defconst fuel-syntax--alias-definition-regex
"^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)") "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
(defconst fuel-syntax--vocab-ref-regexp (defconst fuel-syntax--vocab-ref-regexp
(fuel-syntax--second-word-regex (fuel-syntax--second-word-regex
'("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:"))) '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
(defconst fuel-syntax--int-constant-def-regex (defconst fuel-syntax--int-constant-def-regex
(fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:"))) (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))
(defconst fuel-syntax--type-definition-regex (defconst fuel-syntax--type-definition-regex
(fuel-syntax--second-word-regex (fuel-syntax--second-word-regex
'("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:"))) '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:")))
(defconst fuel-syntax--tuple-decl-regex (defconst fuel-syntax--tuple-decl-regex
"^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>") "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")
(defconst fuel-syntax--constructor-regex "<[^ >]+>") (defconst fuel-syntax--constructor-regex "<[^ >]+>")
(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>") (defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")
(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>") (defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")
(defconst fuel-syntax--symbol-definition-regex (defconst fuel-syntax--symbol-definition-regex
(fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:"))) (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))
(defconst fuel-syntax--stack-effect-regex (defconst fuel-syntax--stack-effect-regex
"\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)") "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")
(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);") (defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")
(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$") (defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")
(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)") (defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$") (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
(defconst fuel-syntax--alien-function-regex (defconst fuel-syntax--alien-function-regex
"\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)") "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")
(defconst fuel-syntax--alien-callback-regex (defconst fuel-syntax--alien-callback-regex
"\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)") "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")
(defconst fuel-syntax--indent-def-starts '("" ":" (defconst fuel-syntax--indent-def-starts '("" ":"
"C-ENUM" "C-STRUCT" "C-UNION" "C-ENUM" "C-STRUCT" "C-UNION"
"FROM" "FUNCTION:" "FROM" "FUNCTION:"
"INTERSECTION:" "INTERSECTION:"
"M" "M:" "MACRO" "MACRO:" "M" "M:" "MACRO" "MACRO:"
"MEMO" "MEMO:" "METHOD" "MEMO" "MEMO:" "METHOD"
"SYNTAX" "SYNTAX"
"PREDICATE" "PRIMITIVE" "PREDICATE" "PRIMITIVE"
"STRUCT" "TAG" "TUPLE" "STRUCT" "TAG" "TUPLE"
"TYPED" "TYPED:" "TYPED" "TYPED:"
"UNIFORM-TUPLE" "UNIFORM-TUPLE"
"UNION-STRUCT" "UNION" "UNION-STRUCT" "UNION"
"VERTEX-FORMAT")) "VERTEX-FORMAT"))
(defconst fuel-syntax--no-indent-def-starts '("ARTICLE" (defconst fuel-syntax--no-indent-def-starts '("ARTICLE"
"HELP" "HELP"
"SINGLETONS" "SINGLETONS"
"SPECIALIZED-ARRAYS" "SPECIALIZED-ARRAYS"
"SYMBOLS" "SYMBOLS"
"VARS")) "VARS"))
(defconst fuel-syntax--indent-def-start-regex (defconst fuel-syntax--indent-def-start-regex
(format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts))) (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))
(defconst fuel-syntax--definition-start-regex (defconst fuel-syntax--definition-start-regex
(format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts
fuel-syntax--indent-def-starts)))) fuel-syntax--indent-def-starts))))
(defconst fuel-syntax--definition-end-regex (defconst fuel-syntax--definition-end-regex
(format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)" (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
fuel-syntax--declaration-words-regex)) fuel-syntax--declaration-words-regex))
(defconst fuel-syntax--single-liner-regex (defconst fuel-syntax--single-liner-regex
(regexp-opt '("ABOUT:" (regexp-opt '("ABOUT:"
"ALIAS:" "ALIAS:"
"CONSTANT:" "C:" "C-TYPE:" "CONSTANT:" "C:" "C-TYPE:"
"DEFER:" "DEFER:"
"FORGET:" "FORGET:"
"GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:"
"HEX:" "HOOK:" "HEX:" "HOOK:"
"IN:" "INSTANCE:" "IN:" "INSTANCE:"
"LIBRARY:" "LIBRARY:"
"MAIN:" "MATH:" "MIXIN:" "MAIN:" "MATH:" "MIXIN:"
"OCT:" "OCT:"
"POSTPONE:" "PRIVATE>" "<PRIVATE" "POSTPONE:" "PRIVATE>" "<PRIVATE"
"QUALIFIED-WITH:" "QUALIFIED:" "QUALIFIED-WITH:" "QUALIFIED:"
"RENAME:" "RENAME:"
"SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:" "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"
"TYPEDEF:" "TYPEDEF:"
"USE:" "USE:"
"VAR:"))) "VAR:")))
(defconst fuel-syntax--begin-of-def-regex (defconst fuel-syntax--begin-of-def-regex
(format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)" (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"
fuel-syntax--definition-start-regex fuel-syntax--definition-start-regex
fuel-syntax--single-liner-regex)) fuel-syntax--single-liner-regex))
(defconst fuel-syntax--end-of-def-line-regex (defconst fuel-syntax--end-of-def-line-regex
(format "^.*%s" fuel-syntax--definition-end-regex)) (format "^.*%s" fuel-syntax--definition-end-regex))
(defconst fuel-syntax--end-of-def-regex (defconst fuel-syntax--end-of-def-regex
(format "\\(%s\\)\\|\\(^%s .*\\)" (format "\\(%s\\)\\|\\(^%s .*\\)"
fuel-syntax--end-of-def-line-regex fuel-syntax--end-of-def-line-regex
fuel-syntax--single-liner-regex)) fuel-syntax--single-liner-regex))
(defconst fuel-syntax--word-signature-regex (defconst fuel-syntax--word-signature-regex
(format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex)) (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))
(defconst fuel-syntax--defun-signature-regex (defconst fuel-syntax--defun-signature-regex
(format "\\(%s\\|%s\\)" (format "\\(%s\\|%s\\)"
fuel-syntax--word-signature-regex fuel-syntax--word-signature-regex
"M[^:]*: [^ ]+ [^ ]+")) "M[^:]*: [^ ]+ [^ ]+"))
(defconst fuel-syntax--constructor-decl-regex (defconst fuel-syntax--constructor-decl-regex
"\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$") "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--typedef-regex (defconst fuel-syntax--typedef-regex
"\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$") "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")
(defconst fuel-syntax--rename-regex (defconst fuel-syntax--rename-regex
"\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$") "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")
;;; Factor syntax table ;;; Factor syntax table
(setq fuel-syntax--syntax-table (setq fuel-syntax--syntax-table
(let ((table (make-syntax-table))) (let ((table (make-syntax-table)))
;; Default is word constituent ;; Default is word constituent
(dotimes (i 256) (dotimes (i 256)
(modify-syntax-entry i "w" table)) (modify-syntax-entry i "w" table))
;; Whitespace (TAB is not whitespace) ;; Whitespace (TAB is not whitespace)
(modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\r " " table) (modify-syntax-entry ?\r " " table)
(modify-syntax-entry ?\ " " table) (modify-syntax-entry ?\ " " table)
(modify-syntax-entry ?\n " " table) (modify-syntax-entry ?\n " " table)
table)) table))
(defconst fuel-syntax--syntactic-keywords (defconst fuel-syntax--syntactic-keywords
`(;; Strings and chars `(;; Strings and chars
("\\_<<\\(\"\\)\\_>" (1 "<b")) ("\\_<<\\(\"\\)\\_>" (1 "<b"))
("\\_<\\(\"\\)>\\_>" (1 ">b")) ("\\_<\\(\"\\)>\\_>" (1 ">b"))
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)" ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"
(3 "\"") (6 "\"")) (3 "\"") (6 "\""))
("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)" ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"
(1 "w") (2 "<b") (4 ">b")) (1 "w") (2 "<b") (4 ">b"))
("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w")) ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))
;; Comments ;; Comments
("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))
("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
;; postpone ;; postpone
("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b")) ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))
;; Multiline constructs ;; Multiline constructs
("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b")) ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))
("\\_<;EBN\\(F\\)\\_>" (1 ">b")) ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))
("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b")) ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))
("\\_<USING:\\( \\)" (1 "<b")) ("\\_<USING:\\( \\)" (1 "<b"))
("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b")) ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))
("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b")) ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))
("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b")) ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))
("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b")) ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))
("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)" ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"
(2 "<b")) (2 "<b"))
("\\(\n\\| \\);\\_>" (1 ">b")) ("\\(\n\\| \\);\\_>" (1 ">b"))
;; Let and lambda: ;; Let and lambda:
("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]")) ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|")) ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
(" \\(|\\) " (1 "(|")) (" \\(|\\) " (1 "(|"))
(" \\(|\\)$" (1 ")")) (" \\(|\\)$" (1 ")"))
;; Opening brace words: ;; Opening brace words:
("\\_<\\w*\\({\\)\\_>" (1 "(}")) ("\\_<\\w*\\({\\)\\_>" (1 "(}"))
("\\_<\\(}\\)\\_>" (1 "){")) ("\\_<\\(}\\)\\_>" (1 "){"))
;; Parenthesis: ;; Parenthesis:
("\\_<\\((\\)\\_>" (1 "()")) ("\\_<\\((\\)\\_>" (1 "()"))
("\\_<\\w*\\((\\)\\_>" (1 "()")) ("\\_<\\w*\\((\\)\\_>" (1 "()"))
("\\_<\\()\\)\\_>" (1 ")(")) ("\\_<\\()\\)\\_>" (1 ")("))
("\\_<(\\((\\)\\_>" (1 "()")) ("\\_<(\\((\\)\\_>" (1 "()"))
("\\_<\\()\\))\\_>" (1 ")(")) ("\\_<\\()\\))\\_>" (1 ")("))
;; Quotations: ;; Quotations:
("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried
("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time ("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time
("\\_<\\(\\[\\)\\_>" (1 "(]")) ("\\_<\\(\\[\\)\\_>" (1 "(]"))
("\\_<\\(\\]\\)\\_>" (1 ")[")))) ("\\_<\\(\\]\\)\\_>" (1 ")["))))
;;; Source code analysis: ;;; Source code analysis:
(defsubst fuel-syntax--brackets-depth () (defsubst fuel-syntax--brackets-depth ()
(nth 0 (syntax-ppss))) (nth 0 (syntax-ppss)))
(defsubst fuel-syntax--brackets-start () (defsubst fuel-syntax--brackets-start ()
(nth 1 (syntax-ppss))) (nth 1 (syntax-ppss)))
(defun fuel-syntax--brackets-end () (defun fuel-syntax--brackets-end ()
(save-excursion (save-excursion
(goto-char (fuel-syntax--brackets-start)) (goto-char (fuel-syntax--brackets-start))
(condition-case nil (condition-case nil
(progn (forward-sexp) (progn (forward-sexp)
(1- (point))) (1- (point)))
(error -1)))) (error -1))))
(defsubst fuel-syntax--indentation-at (pos) (defsubst fuel-syntax--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation))) (save-excursion (goto-char pos) (current-indentation)))
(defsubst fuel-syntax--increased-indentation (&optional i) (defsubst fuel-syntax--increased-indentation (&optional i)
(+ (or i (current-indentation)) factor-indent-width)) (+ (or i (current-indentation)) factor-indent-width))
(defsubst fuel-syntax--decreased-indentation (&optional i) (defsubst fuel-syntax--decreased-indentation (&optional i)
(- (or i (current-indentation)) factor-indent-width)) (- (or i (current-indentation)) factor-indent-width))
(defsubst fuel-syntax--at-begin-of-def () (defsubst fuel-syntax--at-begin-of-def ()
(looking-at fuel-syntax--begin-of-def-regex)) (looking-at fuel-syntax--begin-of-def-regex))
(defsubst fuel-syntax--at-begin-of-indent-def () (defsubst fuel-syntax--at-begin-of-indent-def ()
(looking-at fuel-syntax--indent-def-start-regex)) (looking-at fuel-syntax--indent-def-start-regex))
(defsubst fuel-syntax--at-end-of-def () (defsubst fuel-syntax--at-end-of-def ()
(looking-at fuel-syntax--end-of-def-regex)) (looking-at fuel-syntax--end-of-def-regex))
(defsubst fuel-syntax--looking-at-emptiness () (defsubst fuel-syntax--looking-at-emptiness ()
(looking-at "^[ ]*$\\|$")) (looking-at "^[ ]*$\\|$"))
(defsubst fuel-syntax--is-last-char (pos) (defsubst fuel-syntax--is-last-char (pos)
(save-excursion (save-excursion
(goto-char (1+ pos)) (goto-char (1+ pos))
(looking-at-p "[ ]*$"))) (looking-at-p "[ ]*$")))
(defsubst fuel-syntax--line-offset (pos) (defsubst fuel-syntax--line-offset (pos)
(- pos (save-excursion (- pos (save-excursion
(goto-char pos) (goto-char pos)
(beginning-of-line) (beginning-of-line)
(point)))) (point))))
(defun fuel-syntax--previous-non-blank () (defun fuel-syntax--previous-non-blank ()
(forward-line -1) (forward-line -1)
(while (and (not (bobp)) (fuel-syntax--looking-at-emptiness)) (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
(forward-line -1))) (forward-line -1)))
(defun fuel-syntax--beginning-of-block-pos () (defun fuel-syntax--beginning-of-block-pos ()
(save-excursion (save-excursion
(if (> (fuel-syntax--brackets-depth) 0) (if (> (fuel-syntax--brackets-depth) 0)
(fuel-syntax--brackets-start) (fuel-syntax--brackets-start)
(fuel-syntax--beginning-of-defun) (fuel-syntax--beginning-of-defun)
(point)))) (point))))
(defun fuel-syntax--at-setter-line () (defun fuel-syntax--at-setter-line ()
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(when (re-search-forward fuel-syntax--setter-regex (when (re-search-forward fuel-syntax--setter-regex
(line-end-position) (line-end-position)
t) t)
(let* ((to (match-beginning 0)) (let* ((to (match-beginning 0))
(from (fuel-syntax--beginning-of-block-pos))) (from (fuel-syntax--beginning-of-block-pos)))
(goto-char from) (goto-char from)
(let ((depth (fuel-syntax--brackets-depth))) (let ((depth (fuel-syntax--brackets-depth)))
(and (or (re-search-forward fuel-syntax--constructor-regex to t) (and (or (re-search-forward fuel-syntax--constructor-regex to t)
(re-search-forward fuel-syntax--setter-regex to t)) (re-search-forward fuel-syntax--setter-regex to t))
(= depth (fuel-syntax--brackets-depth)))))))) (= depth (fuel-syntax--brackets-depth))))))))
(defun fuel-syntax--at-constructor-line () (defun fuel-syntax--at-constructor-line ()
(save-excursion (save-excursion
(beginning-of-line) (beginning-of-line)
(re-search-forward fuel-syntax--constructor-regex (line-end-position) t))) (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))
(defsubst fuel-syntax--at-using () (defsubst fuel-syntax--at-using ()
(looking-at fuel-syntax--using-lines-regex)) (looking-at fuel-syntax--using-lines-regex))
(defun fuel-syntax--in-using () (defun fuel-syntax--in-using ()
(let ((p (point))) (let ((p (point)))
(save-excursion (save-excursion
(and (re-search-backward "^USING: " nil t) (and (re-search-backward "^USING: " nil t)
(re-search-forward " ;" nil t) (re-search-forward " ;" nil t)
(< p (match-end 0)))))) (< p (match-end 0))))))
(defsubst fuel-syntax--beginning-of-defun (&optional times) (defsubst fuel-syntax--beginning-of-defun (&optional times)
(re-search-backward fuel-syntax--begin-of-def-regex nil t times)) (re-search-backward fuel-syntax--begin-of-def-regex nil t times))
(defsubst fuel-syntax--end-of-defun () (defsubst fuel-syntax--end-of-defun ()
(re-search-forward fuel-syntax--end-of-def-regex nil t)) (re-search-forward fuel-syntax--end-of-def-regex nil t))
(defsubst fuel-syntax--end-of-defun-pos () (defsubst fuel-syntax--end-of-defun-pos ()
(save-excursion (save-excursion
(re-search-forward fuel-syntax--end-of-def-regex nil t) (re-search-forward fuel-syntax--end-of-def-regex nil t)
(point))) (point)))
(defun fuel-syntax--beginning-of-body () (defun fuel-syntax--beginning-of-body ()
(let ((p (point))) (let ((p (point)))
(and (fuel-syntax--beginning-of-defun) (and (fuel-syntax--beginning-of-defun)
(re-search-forward fuel-syntax--defun-signature-regex p t) (re-search-forward fuel-syntax--defun-signature-regex p t)
(not (re-search-forward fuel-syntax--end-of-def-regex p t))))) (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
(defun fuel-syntax--beginning-of-sexp () (defun fuel-syntax--beginning-of-sexp ()
(if (> (fuel-syntax--brackets-depth) 0) (if (> (fuel-syntax--brackets-depth) 0)
(goto-char (fuel-syntax--brackets-start)) (goto-char (fuel-syntax--brackets-start))
(fuel-syntax--beginning-of-body))) (fuel-syntax--beginning-of-body)))
(defsubst fuel-syntax--beginning-of-sexp-pos () (defsubst fuel-syntax--beginning-of-sexp-pos ()
(save-excursion (fuel-syntax--beginning-of-sexp) (point))) (save-excursion (fuel-syntax--beginning-of-sexp) (point)))
;;; USING/IN: ;;; USING/IN:
(make-variable-buffer-local (make-variable-buffer-local
(defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in)) (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
(defsubst fuel-syntax--current-vocab () (defsubst fuel-syntax--current-vocab ()
(funcall fuel-syntax--current-vocab-function)) (funcall fuel-syntax--current-vocab-function))
(defun fuel-syntax--find-in () (defun fuel-syntax--find-in ()
(save-excursion (save-excursion
(when (re-search-backward fuel-syntax--current-vocab-regex nil t) (when (re-search-backward fuel-syntax--current-vocab-regex nil t)
(match-string-no-properties 1)))) (match-string-no-properties 1))))
(make-variable-buffer-local (make-variable-buffer-local
(defvar fuel-syntax--usings-function 'fuel-syntax--find-usings)) (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
(defsubst fuel-syntax--usings () (defsubst fuel-syntax--usings ()
(funcall fuel-syntax--usings-function)) (funcall fuel-syntax--usings-function))
(defun fuel-syntax--file-has-private () (defun fuel-syntax--file-has-private ()
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(and (re-search-forward "\\_<<PRIVATE\\_>" nil t) (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)
(re-search-forward "\\_<PRIVATE>\\_>" nil t)))) (re-search-forward "\\_<PRIVATE>\\_>" nil t))))
(defun fuel-syntax--find-usings (&optional no-private) (defun fuel-syntax--find-usings (&optional no-private)
(save-excursion (save-excursion
(let ((usings)) (let ((usings))
(goto-char (point-max)) (goto-char (point-max))
(while (re-search-backward fuel-syntax--using-lines-regex nil t) (while (re-search-backward fuel-syntax--using-lines-regex nil t)
(dolist (u (split-string (match-string-no-properties 1) nil t)) (dolist (u (split-string (match-string-no-properties 1) nil t))
(push u usings))) (push u usings)))
(when (and (not no-private) (fuel-syntax--file-has-private)) (when (and (not no-private) (fuel-syntax--file-has-private))
(goto-char (point-max)) (goto-char (point-max))
(push (concat (fuel-syntax--find-in) ".private") usings)) (push (concat (fuel-syntax--find-in) ".private") usings))
usings))) usings)))
(provide 'fuel-syntax) (provide 'fuel-syntax)
;;; fuel-syntax.el ends here ;;; fuel-syntax.el ends here