Merge branch 'master' of git://factorcode.org/git/factor into new-alien-pointers

db4
Joe Groff 2010-02-21 23:14:08 -08:00
commit 338edac16c
18 changed files with 1752 additions and 796 deletions

View File

@ -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
@ -30,6 +30,11 @@ CONSTANT: eleven 11
[ "not-word" parse-c-type ] [ error>> no-word-error? ] must-fail-with
] 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...

View File

@ -73,10 +73,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 )

View File

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

View File

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

View File

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

View File

@ -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 } }

View File

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

View File

@ -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." } ;

View File

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

View File

@ -0,0 +1 @@
Erik Charlebois

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

View File

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

View File

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

View File

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

View 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)

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 " 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

View File

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

View File

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