! (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
] 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...
: 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 )
-USING: concurrency.mailboxes concurrency.count-downs concurrency.conditions\r
-vectors sequences threads tools.test math kernel strings namespaces\r
-continuations calendar destructors ;\r
-IN: concurrency.mailboxes.tests\r
-\r
-{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as\r
-\r
-[ V{ 1 2 3 } ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ mailbox-get swap push ] in-thread\r
- [ mailbox-get swap push ] in-thread\r
- [ mailbox-get swap push ] in-thread\r
- 1 over mailbox-put\r
- 2 over mailbox-put\r
- 3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 2 3 } ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- 1 over mailbox-put\r
- 2 over mailbox-put\r
- 3 swap mailbox-put\r
-] unit-test\r
-\r
-[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [\r
- 0 <vector>\r
- <mailbox>\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ integer? ] mailbox-get? swap push ] in-thread\r
- [ [ string? ] mailbox-get? swap push ] in-thread\r
- [ [ string? ] mailbox-get? swap push ] in-thread\r
- 1 over mailbox-put\r
- "junk" over mailbox-put\r
- [ 456 ] over mailbox-put\r
- 3 over mailbox-put\r
- "junk2" over mailbox-put\r
- mailbox-get\r
-] unit-test\r
-\r
-[ { "foo" "bar" } ] [\r
- <mailbox>\r
- "foo" over mailbox-put\r
- "bar" over mailbox-put\r
- mailbox-get-all\r
-] unit-test\r
-\r
-[\r
- <mailbox> 1 seconds mailbox-get-timeout\r
-] [ wait-timeout? ] must-fail-with\r
+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
-! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: dlists deques threads sequences continuations namespaces\r
-math quotations words kernel arrays assocs init system\r
-concurrency.conditions accessors debugger debugger.threads\r
-locals fry ;\r
-IN: concurrency.mailboxes\r
-\r
-TUPLE: mailbox threads data ;\r
-\r
-: <mailbox> ( -- mailbox )\r
- mailbox new\r
- <dlist> >>threads\r
- <dlist> >>data ;\r
-\r
-: mailbox-empty? ( mailbox -- bool )\r
- data>> deque-empty? ;\r
-\r
-: mailbox-put ( obj mailbox -- )\r
- [ data>> push-front ]\r
- [ threads>> notify-all ] bi yield ;\r
-\r
-: wait-for-mailbox ( mailbox timeout -- )\r
- [ threads>> ] dip "mailbox" wait ;\r
-\r
-:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )\r
- mailbox data>> pred dlist-any? [\r
- mailbox timeout wait-for-mailbox\r
- mailbox timeout pred block-unless-pred\r
- ] unless ; inline recursive\r
-\r
-: block-if-empty ( mailbox timeout -- mailbox )\r
- over mailbox-empty? [\r
- 2dup wait-for-mailbox block-if-empty\r
- ] [\r
- drop\r
- ] if ;\r
-\r
-: mailbox-peek ( mailbox -- obj )\r
- data>> peek-back ;\r
-\r
-: mailbox-get-timeout ( mailbox timeout -- obj )\r
- block-if-empty data>> pop-back ;\r
-\r
-: mailbox-get ( mailbox -- obj )\r
- f mailbox-get-timeout ;\r
-\r
-: mailbox-get-all-timeout ( mailbox timeout -- array )\r
- block-if-empty\r
- [ dup mailbox-empty? not ]\r
- [ dup data>> pop-back ]\r
- produce nip ;\r
-\r
-: mailbox-get-all ( mailbox -- array )\r
- f mailbox-get-all-timeout ;\r
-\r
-: while-mailbox-empty ( mailbox quot -- )\r
- [ '[ _ mailbox-empty? ] ] dip while ; inline\r
-\r
-: mailbox-get-timeout? ( mailbox timeout pred -- obj )\r
- [ block-unless-pred ]\r
- [ [ drop data>> ] dip delete-node-if ]\r
- 3bi ; inline\r
-\r
-: mailbox-get? ( mailbox pred -- obj )\r
- f swap mailbox-get-timeout? ; inline\r
-\r
-: wait-for-close-timeout ( mailbox timeout -- )\r
- over disposed>>\r
- [ 2drop ] [ 2dup wait-for-mailbox wait-for-close-timeout ] if ;\r
-\r
-: wait-for-close ( mailbox -- )\r
- f wait-for-close-timeout ;\r
-\r
-TUPLE: linked-error error thread ;\r
-\r
-M: linked-error error.\r
- [ thread>> error-in-thread. ] [ error>> error. ] bi ;\r
-\r
-C: <linked-error> linked-error\r
-\r
-: ?linked ( message -- message )\r
- dup linked-error? [ rethrow ] when ;\r
-\r
-TUPLE: linked-thread < thread supervisor ;\r
-\r
-M: linked-thread error-in-thread\r
- [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;\r
-\r
-: <linked-thread> ( quot name mailbox -- thread' )\r
- [ linked-thread new-thread ] dip >>supervisor ;\r
-\r
-: spawn-linked-to ( quot name mailbox -- thread )\r
- <linked-thread> [ (spawn) ] keep ;\r
+! 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, 2008 Chris Double, Slava Pestov.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors concurrency.mailboxes kernel continuations ;\r
-IN: concurrency.promises\r
-\r
-TUPLE: promise mailbox ;\r
-\r
-: <promise> ( -- promise )\r
- <mailbox> promise boa ;\r
-\r
-: promise-fulfilled? ( promise -- ? )\r
- mailbox>> mailbox-empty? not ;\r
-\r
-ERROR: promise-already-fulfilled promise ;\r
-\r
-: fulfill ( value promise -- )\r
- dup promise-fulfilled? [ \r
- promise-already-fulfilled\r
- ] [\r
- mailbox>> mailbox-put\r
- ] if ;\r
-\r
-: ?promise-timeout ( promise timeout -- result )\r
- [ mailbox>> ] dip block-if-empty mailbox-peek ;\r
-\r
-: ?promise ( promise -- result )\r
- f ?promise-timeout ;\r
+! 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) 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
{ 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 } }
: 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 ;
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
: 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 ;
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." } ;
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 ;
] [ drop f ] if
] [ drop f ] if ;
-PRIVATE>
-
: vocab-tests ( vocab -- tests )
[
[ vocab-tests-file [ , ] when* ]
[ vocab-source-path [ , ] when* ]
[ vocab-docs-path [ , ] when* ]
[ vocab-tests % ] tri
- ] { } make ;
\ No newline at end of file
+ ] { } make ;
--- /dev/null
+Erik Charlebois
\ No newline at end of file
--- /dev/null
+! 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
+ ) ;
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
[ 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
-! Copyright (C) 2007 Chris Double.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel accessors arrays alien system combinators\r
-alien.syntax namespaces alien.c-types sequences vocabs.loader\r
-shuffle openal openal.alut.backend alien.libraries generalizations\r
-specialized-arrays alien.destructors ;\r
-FROM: alien.c-types => float short ;\r
-SPECIALIZED-ARRAY: uint\r
-IN: openal.alut\r
-\r
-<< "alut" {\r
- { [ os windows? ] [ "alut.dll" ] }\r
- { [ os macosx? ] [\r
- "/System/Library/Frameworks/OpenAL.framework/OpenAL"\r
- ] }\r
- { [ os unix? ] [ "libalut.so" ] }\r
- } cond "cdecl" add-library >>\r
-\r
-<< os macosx? [ "alut" deploy-library ] unless >>\r
-\r
-LIBRARY: alut\r
-\r
-CONSTANT: ALUT_API_MAJOR_VERSION 1\r
-CONSTANT: ALUT_API_MINOR_VERSION 1\r
-CONSTANT: ALUT_ERROR_NO_ERROR 0\r
-CONSTANT: ALUT_ERROR_OUT_OF_MEMORY HEX: 200\r
-CONSTANT: ALUT_ERROR_INVALID_ENUM HEX: 201\r
-CONSTANT: ALUT_ERROR_INVALID_VALUE HEX: 202\r
-CONSTANT: ALUT_ERROR_INVALID_OPERATION HEX: 203\r
-CONSTANT: ALUT_ERROR_NO_CURRENT_CONTEXT HEX: 204\r
-CONSTANT: ALUT_ERROR_AL_ERROR_ON_ENTRY HEX: 205\r
-CONSTANT: ALUT_ERROR_ALC_ERROR_ON_ENTRY HEX: 206\r
-CONSTANT: ALUT_ERROR_OPEN_DEVICE HEX: 207\r
-CONSTANT: ALUT_ERROR_CLOSE_DEVICE HEX: 208\r
-CONSTANT: ALUT_ERROR_CREATE_CONTEXT HEX: 209\r
-CONSTANT: ALUT_ERROR_MAKE_CONTEXT_CURRENT HEX: 20A\r
-CONSTANT: ALUT_ERROR_DESTRY_CONTEXT HEX: 20B\r
-CONSTANT: ALUT_ERROR_GEN_BUFFERS HEX: 20C\r
-CONSTANT: ALUT_ERROR_BUFFER_DATA HEX: 20D\r
-CONSTANT: ALUT_ERROR_IO_ERROR HEX: 20E\r
-CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_TYPE HEX: 20F\r
-CONSTANT: ALUT_ERROR_UNSUPPORTED_FILE_SUBTYPE HEX: 210\r
-CONSTANT: ALUT_ERROR_CORRUPT_OR_TRUNCATED_DATA HEX: 211\r
-CONSTANT: ALUT_WAVEFORM_SINE HEX: 100\r
-CONSTANT: ALUT_WAVEFORM_SQUARE HEX: 101\r
-CONSTANT: ALUT_WAVEFORM_SAWTOOTH HEX: 102\r
-CONSTANT: ALUT_WAVEFORM_WHITENOISE HEX: 103\r
-CONSTANT: ALUT_WAVEFORM_IMPULSE HEX: 104\r
-CONSTANT: ALUT_LOADER_BUFFER HEX: 300\r
-CONSTANT: ALUT_LOADER_MEMORY HEX: 301\r
-\r
-FUNCTION: ALboolean alutInit ( int* argcp, char** argv ) ;\r
-FUNCTION: ALboolean alutInitWithoutContext ( int* argcp, char** argv ) ;\r
-FUNCTION: ALboolean alutExit ( ) ;\r
-FUNCTION: ALenum alutGetError ( ) ;\r
-FUNCTION: char* alutGetErrorString ( ALenum error ) ;\r
-FUNCTION: ALuint alutCreateBufferFromFile ( char* fileName ) ;\r
-FUNCTION: ALuint alutCreateBufferFromFileImage ( void* data, ALsizei length ) ;\r
-FUNCTION: ALuint alutCreateBufferHelloWorld ( ) ;\r
-FUNCTION: ALuint alutCreateBufferWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration ) ;\r
-FUNCTION: void* alutLoadMemoryFromFile ( char* fileName, ALenum* format, ALsizei* size, ALfloat* frequency ) ;\r
-FUNCTION: void* alutLoadMemoryFromFileImage ( void* data, ALsizei length, ALenum* format, ALsizei* size, ALfloat* frequency ) ;\r
-FUNCTION: void* alutLoadMemoryHelloWorld ( ALenum* format, ALsizei* size, ALfloat* frequency ) ;\r
-FUNCTION: void* alutLoadMemoryWaveform ( ALenum waveshape, ALfloat frequency, ALfloat phase, ALfloat duration, ALenum* format, ALsizei* size, ALfloat* freq ) ;\r
-FUNCTION: char* alutGetMIMETypes ( ALenum loader ) ;\r
-FUNCTION: ALint alutGetMajorVersion ( ) ;\r
-FUNCTION: ALint alutGetMinorVersion ( ) ;\r
-FUNCTION: ALboolean alutSleep ( ALfloat duration ) ;\r
-\r
-FUNCTION: void alutUnloadWAV ( ALenum format, void* data, ALsizei size, ALsizei frequency ) ;\r
-\r
-SYMBOL: init\r
-\r
-: init-openal ( -- )\r
- init get-global expired? [\r
- f f alutInit 0 = [ "Could not initialize OpenAL" throw ] when\r
- 1337 <alien> init set-global\r
- ] when ;\r
-\r
-: exit-openal ( -- )\r
- init get-global expired? [\r
- alutExit 0 = [ "Could not close OpenAL" throw ] when\r
- f init set-global\r
- ] unless ;\r
-\r
-: create-buffer-from-file ( filename -- buffer )\r
- alutCreateBufferFromFile dup AL_NONE = [\r
- "create-buffer-from-file failed" throw\r
- ] when ;\r
-\r
-os macosx? "openal.alut.macosx" "openal.alut.other" ? require\r
-\r
-: create-buffer-from-wav ( filename -- buffer )\r
- gen-buffer dup rot load-wav-file\r
- [ alBufferData ] 4 nkeep alutUnloadWAV ;\r
-\r
-: check-error ( -- )\r
- alGetError dup ALUT_ERROR_NO_ERROR = [\r
- drop\r
- ] [\r
- alGetString throw\r
- ] if ;\r
-\r
+! 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.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: calendar kernel openal openal.alut sequences threads ;\r
-IN: openal.example\r
-\r
-: play-hello ( -- )\r
- init-openal\r
- 1 gen-sources\r
- first dup AL_BUFFER alutCreateBufferHelloWorld set-source-param\r
- source-play\r
- 1000 milliseconds sleep ;\r
- \r
-: (play-file) ( source -- )\r
- 100 milliseconds sleep\r
- dup source-playing? [ (play-file) ] [ drop ] if ;\r
-\r
-: play-file ( filename -- )\r
- init-openal\r
- create-buffer-from-file \r
- 1 gen-sources\r
- first dup [ AL_BUFFER rot set-source-param ] dip\r
- dup source-play\r
- check-error\r
- (play-file) ;\r
-\r
-: play-wav ( filename -- )\r
- init-openal\r
- create-buffer-from-wav \r
- 1 gen-sources\r
- first dup [ AL_BUFFER rot set-source-param ] dip\r
- dup source-play\r
- check-error\r
- (play-file) ;\r
+! 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) ;
(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)
(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"))))
\f
;;; Completion support
"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)))
(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."
(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))
(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)))
+
\f
(provide 'fuel-scaffold)
;;; fuel-scaffold.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)
-
-\f
-;;; 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)))
-
-
-\f
-;;; 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+\\)\\( .*\\)?$")
-
-\f
-;;; 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 ")["))))
-
-\f
-;;; 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)))
-
-\f
-;;; 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)))
-
-\f
-(provide 'fuel-syntax)
-;;; fuel-syntax.el ends here
+;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.\r
+\r
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz\r
+;; See http://factorcode.org/license.txt for BSD license.\r
+\r
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>\r
+;; Keywords: languages\r
+\r
+;;; Commentary:\r
+\r
+;; Auxiliar constants and functions to parse factor code.\r
+\r
+;;; Code:\r
+\r
+(require 'thingatpt)\r
+\r
+\f\r
+;;; Thing-at-point support for factor symbols:\r
+\r
+(defun fuel-syntax--beginning-of-symbol ()\r
+ "Move point to the beginning of the current symbol."\r
+ (skip-syntax-backward "w_()"))\r
+\r
+(defsubst fuel-syntax--beginning-of-symbol-pos ()\r
+ (save-excursion (fuel-syntax--beginning-of-symbol) (point)))\r
+\r
+(defun fuel-syntax--end-of-symbol ()\r
+ "Move point to the end of the current symbol."\r
+ (skip-syntax-forward "w_()"))\r
+\r
+(defsubst fuel-syntax--end-of-symbol-pos ()\r
+ (save-excursion (fuel-syntax--end-of-symbol) (point)))\r
+\r
+(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)\r
+(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)\r
+\r
+(defsubst fuel-syntax-symbol-at-point ()\r
+ (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))\r
+ (and (> (length s) 0) s)))\r
+\r
+\r
+\f\r
+;;; Regexps galore:\r
+\r
+(defconst fuel-syntax--parsing-words\r
+ '(":" "::" ";" "&:" "<<" "<PRIVATE" ">>"\r
+ "ABOUT:" "ALIAS:" "ALIEN:" "ARTICLE:"\r
+ "B" "BIN:"\r
+ "C:" "CALLBACK:" "C-ENUM:" "C-STRUCT:" "C-TYPE:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"\r
+ "DEFER:"\r
+ "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:"\r
+ "f" "FORGET:" "FROM:" "FUNCTION:"\r
+ "GAME:" "GENERIC#" "GENERIC:"\r
+ "GLSL-SHADER:" "GLSL-PROGRAM:"\r
+ "HELP:" "HEX:" "HOOK:"\r
+ "IN:" "initial:" "INSTANCE:" "INTERSECTION:"\r
+ "LIBRARY:"\r
+ "M:" "M::" "MACRO:" "MACRO::" "MAIN:" "MATH:"\r
+ "MEMO:" "MEMO:" "METHOD:" "MIXIN:"\r
+ "OCT:"\r
+ "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"\r
+ "QUALIFIED-WITH:" "QUALIFIED:"\r
+ "read-only" "RENAME:" "REQUIRE:" "REQUIRES:"\r
+ "SINGLETON:" "SINGLETONS:" "SLOT:" "SPECIALIZED-ARRAY:" "SPECIALIZED-ARRAYS:" "STRING:" "STRUCT:" "SYMBOL:" "SYMBOLS:" "SYNTAX:"\r
+ "TUPLE:" "t" "t?" "TYPEDEF:" "TYPED:" "TYPED::"\r
+ "UNIFORM-TUPLE:" "UNION:" "UNION-STRUCT:" "USE:" "USING:"\r
+ "VARS:" "VERTEX-FORMAT:"))\r
+\r
+(defconst fuel-syntax--parsing-words-regex\r
+ (regexp-opt fuel-syntax--parsing-words 'words))\r
+\r
+(defconst fuel-syntax--bracers\r
+ '("B" "BV" "C" "CS" "H" "T" "V" "W"))\r
+\r
+(defconst fuel-syntax--brace-words-regex\r
+ (format "%s{" (regexp-opt fuel-syntax--bracers t)))\r
+\r
+(defconst fuel-syntax--declaration-words\r
+ '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))\r
+\r
+(defconst fuel-syntax--declaration-words-regex\r
+ (regexp-opt fuel-syntax--declaration-words 'words))\r
+\r
+(defsubst fuel-syntax--second-word-regex (prefixes)\r
+ (format "%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))\r
+\r
+(defconst fuel-syntax--method-definition-regex\r
+ "^M::? +\\([^ ]+\\) +\\([^ ]+\\)")\r
+\r
+(defconst fuel-syntax--integer-regex\r
+ "\\_<-?[0-9]+\\_>")\r
+\r
+(defconst fuel-syntax--raw-float-regex\r
+ "[0-9]*\\.[0-9]*\\([eE][+-]?[0-9]+\\)?")\r
+\r
+(defconst fuel-syntax--float-regex\r
+ (format "\\_<-?%s\\_>" fuel-syntax--raw-float-regex))\r
+\r
+(defconst fuel-syntax--number-regex\r
+ (format "\\([0-9]+\\|%s\\)" fuel-syntax--raw-float-regex))\r
+\r
+(defconst fuel-syntax--ratio-regex\r
+ (format "\\_<[+-]?%s/-?%s\\_>"\r
+ fuel-syntax--number-regex\r
+ fuel-syntax--number-regex))\r
+\r
+(defconst fuel-syntax--bad-string-regex\r
+ "\\_<\"[^>]\\([^\"\n]\\|\\\\\"\\)*\n")\r
+\r
+(defconst fuel-syntax--word-definition-regex\r
+ (format "\\_<\\(%s\\)?: +\\_<\\(\\w+\\)\\_>"\r
+ (regexp-opt\r
+ '(":" "GENERIC" "DEFER" "HOOK" "MAIN" "MATH" "POSTPONE"\r
+ "SYMBOL" "SYNTAX" "TYPED" "RENAME"))))\r
+\r
+(defconst fuel-syntax--alias-definition-regex\r
+ "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")\r
+\r
+(defconst fuel-syntax--vocab-ref-regexp\r
+ (fuel-syntax--second-word-regex\r
+ '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))\r
+\r
+(defconst fuel-syntax--int-constant-def-regex\r
+ (fuel-syntax--second-word-regex '("ALIEN:" "CHAR:" "BIN:" "HEX:" "OCT:")))\r
+\r
+(defconst fuel-syntax--type-definition-regex\r
+ (fuel-syntax--second-word-regex\r
+ '("C-STRUCT:" "C-UNION:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:")))\r
+\r
+(defconst fuel-syntax--tuple-decl-regex\r
+ "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>")\r
+\r
+(defconst fuel-syntax--constructor-regex "<[^ >]+>")\r
+\r
+(defconst fuel-syntax--getter-regex "\\(^\\|\\_<\\)[^ ]+?>>\\_>")\r
+(defconst fuel-syntax--setter-regex "\\_<>>.+?\\_>")\r
+\r
+(defconst fuel-syntax--symbol-definition-regex\r
+ (fuel-syntax--second-word-regex '("&:" "SYMBOL:" "VAR:")))\r
+\r
+(defconst fuel-syntax--stack-effect-regex\r
+ "\\( ( [^\n]* )\\)\\|\\( (( [^\n]* ))\\)")\r
+\r
+(defconst fuel-syntax--using-lines-regex "^USING: +\\([^;]+\\);")\r
+\r
+(defconst fuel-syntax--use-line-regex "^USE: +\\(.*\\)$")\r
+\r
+(defconst fuel-syntax--current-vocab-regex "^IN: +\\([^ \r\n\f]+\\)")\r
+\r
+(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")\r
+\r
+(defconst fuel-syntax--alien-function-regex\r
+ "\\_<FUNCTION: \\(\\w+\\) \\(\\w+\\)")\r
+\r
+(defconst fuel-syntax--alien-callback-regex\r
+ "\\_<CALLBACK: \\(\\w+\\) \\(\\w+\\)")\r
+\r
+(defconst fuel-syntax--indent-def-starts '("" ":"\r
+ "C-ENUM" "C-STRUCT" "C-UNION"\r
+ "FROM" "FUNCTION:"\r
+ "INTERSECTION:"\r
+ "M" "M:" "MACRO" "MACRO:"\r
+ "MEMO" "MEMO:" "METHOD"\r
+ "SYNTAX"\r
+ "PREDICATE" "PRIMITIVE"\r
+ "STRUCT" "TAG" "TUPLE"\r
+ "TYPED" "TYPED:"\r
+ "UNIFORM-TUPLE"\r
+ "UNION-STRUCT" "UNION"\r
+ "VERTEX-FORMAT"))\r
+\r
+(defconst fuel-syntax--no-indent-def-starts '("ARTICLE"\r
+ "HELP"\r
+ "SINGLETONS"\r
+ "SPECIALIZED-ARRAYS"\r
+ "SYMBOLS"\r
+ "VARS"))\r
+\r
+(defconst fuel-syntax--indent-def-start-regex\r
+ (format "^\\(%s:\\)\\( \\|\n\\)" (regexp-opt fuel-syntax--indent-def-starts)))\r
+\r
+(defconst fuel-syntax--definition-start-regex\r
+ (format "^\\(%s:\\) " (regexp-opt (append fuel-syntax--no-indent-def-starts\r
+ fuel-syntax--indent-def-starts))))\r
+\r
+(defconst fuel-syntax--definition-end-regex\r
+ (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"\r
+ fuel-syntax--declaration-words-regex))\r
+\r
+(defconst fuel-syntax--single-liner-regex\r
+ (regexp-opt '("ABOUT:"\r
+ "ALIAS:"\r
+ "CONSTANT:" "C:" "C-TYPE:"\r
+ "DEFER:"\r
+ "FORGET:"\r
+ "GAME:" "GENERIC:" "GENERIC#" "GLSL-PROGRAM:" \r
+ "HEX:" "HOOK:"\r
+ "IN:" "INSTANCE:"\r
+ "LIBRARY:"\r
+ "MAIN:" "MATH:" "MIXIN:"\r
+ "OCT:"\r
+ "POSTPONE:" "PRIVATE>" "<PRIVATE"\r
+ "QUALIFIED-WITH:" "QUALIFIED:"\r
+ "RENAME:"\r
+ "SINGLETON:" "SLOT:" "SPECIALIZED-ARRAY:" "SYMBOL:"\r
+ "TYPEDEF:"\r
+ "USE:"\r
+ "VAR:")))\r
+\r
+(defconst fuel-syntax--begin-of-def-regex\r
+ (format "^USING: \\|\\(%s\\)\\|\\(^%s .*\\)"\r
+ fuel-syntax--definition-start-regex\r
+ fuel-syntax--single-liner-regex))\r
+\r
+(defconst fuel-syntax--end-of-def-line-regex\r
+ (format "^.*%s" fuel-syntax--definition-end-regex))\r
+\r
+(defconst fuel-syntax--end-of-def-regex\r
+ (format "\\(%s\\)\\|\\(^%s .*\\)"\r
+ fuel-syntax--end-of-def-line-regex\r
+ fuel-syntax--single-liner-regex))\r
+\r
+(defconst fuel-syntax--word-signature-regex\r
+ (format ":[^ ]* \\([^ ]+\\)\\(%s\\)*" fuel-syntax--stack-effect-regex))\r
+\r
+(defconst fuel-syntax--defun-signature-regex\r
+ (format "\\(%s\\|%s\\)"\r
+ fuel-syntax--word-signature-regex\r
+ "M[^:]*: [^ ]+ [^ ]+"))\r
+\r
+(defconst fuel-syntax--constructor-decl-regex\r
+ "\\_<C: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+(defconst fuel-syntax--typedef-regex\r
+ "\\_<TYPEDEF: +\\(\\w+\\) +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+(defconst fuel-syntax--rename-regex\r
+ "\\_<RENAME: +\\(\\w+\\) +\\(\\w+\\) +=> +\\(\\w+\\)\\( .*\\)?$")\r
+\r
+\f\r
+;;; Factor syntax table\r
+\r
+(setq fuel-syntax--syntax-table\r
+ (let ((table (make-syntax-table)))\r
+ ;; Default is word constituent\r
+ (dotimes (i 256)\r
+ (modify-syntax-entry i "w" table))\r
+ ;; Whitespace (TAB is not whitespace)\r
+ (modify-syntax-entry ?\f " " table)\r
+ (modify-syntax-entry ?\r " " table)\r
+ (modify-syntax-entry ?\ " " table)\r
+ (modify-syntax-entry ?\n " " table)\r
+ table))\r
+\r
+(defconst fuel-syntax--syntactic-keywords\r
+ `(;; Strings and chars\r
+ ("\\_<<\\(\"\\)\\_>" (1 "<b"))\r
+ ("\\_<\\(\"\\)>\\_>" (1 ">b"))\r
+ ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)"\r
+ (3 "\"") (6 "\""))\r
+ ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)"\r
+ (1 "w") (2 "<b") (4 ">b"))\r
+ ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w"))\r
+ ;; Comments\r
+ ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">"))\r
+ ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))\r
+ ;; postpone\r
+ ("\\_<POSTPONE:\\( \\).*\\(\n\\)" (1 "<b") (2 ">b"))\r
+ ;; Multiline constructs\r
+ ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "<b"))\r
+ ("\\_<;EBN\\(F\\)\\_>" (1 ">b"))\r
+ ("\\_<\\(U\\)SING: \\(;\\)" (1 "<b") (2 ">b"))\r
+ ("\\_<USING:\\( \\)" (1 "<b"))\r
+ ("\\_<\\(C\\)-ENUM: \\(;\\)" (1 "<b") (2 ">b"))\r
+ ("\\_<C-ENUM:\\( \\|\n\\)" (1 "<b"))\r
+ ("\\_<TUPLE: +\\w+? +< +\\w+? *\\( \\|\n\\)\\([^;]\\|$\\)" (1 "<b"))\r
+ ("\\_<TUPLE: +\\w+? *\\( \\|\n\\)\\([^;<\n]\\|\\_>\\)" (1 "<b"))\r
+ ("\\_<\\(SYMBOLS\\|VARS\\|SPECIALIZED-ARRAYS\\|SINGLETONS\\): *?\\( \\|\n\\)\\([^;\n]\\|\\_>\\)"\r
+ (2 "<b"))\r
+ ("\\(\n\\| \\);\\_>" (1 ">b"))\r
+ ;; Let and lambda:\r
+ ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))\r
+ ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))\r
+ ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))\r
+ (" \\(|\\) " (1 "(|"))\r
+ (" \\(|\\)$" (1 ")"))\r
+ ;; Opening brace words:\r
+ ("\\_<\\w*\\({\\)\\_>" (1 "(}"))\r
+ ("\\_<\\(}\\)\\_>" (1 "){"))\r
+ ;; Parenthesis:\r
+ ("\\_<\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\w*\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\()\\)\\_>" (1 ")("))\r
+ ("\\_<(\\((\\)\\_>" (1 "()"))\r
+ ("\\_<\\()\\))\\_>" (1 ")("))\r
+ ;; Quotations:\r
+ ("\\_<'\\(\\[\\)\\_>" (1 "(]")) ; fried\r
+ ("\\_<$\\(\\[\\)\\_>" (1 "(]")) ; parse-time\r
+ ("\\_<\\(\\[\\)\\_>" (1 "(]"))\r
+ ("\\_<\\(\\]\\)\\_>" (1 ")["))))\r
+\r
+\f\r
+;;; Source code analysis:\r
+\r
+(defsubst fuel-syntax--brackets-depth ()\r
+ (nth 0 (syntax-ppss)))\r
+\r
+(defsubst fuel-syntax--brackets-start ()\r
+ (nth 1 (syntax-ppss)))\r
+\r
+(defun fuel-syntax--brackets-end ()\r
+ (save-excursion\r
+ (goto-char (fuel-syntax--brackets-start))\r
+ (condition-case nil\r
+ (progn (forward-sexp)\r
+ (1- (point)))\r
+ (error -1))))\r
+\r
+(defsubst fuel-syntax--indentation-at (pos)\r
+ (save-excursion (goto-char pos) (current-indentation)))\r
+\r
+(defsubst fuel-syntax--increased-indentation (&optional i)\r
+ (+ (or i (current-indentation)) factor-indent-width))\r
+(defsubst fuel-syntax--decreased-indentation (&optional i)\r
+ (- (or i (current-indentation)) factor-indent-width))\r
+\r
+(defsubst fuel-syntax--at-begin-of-def ()\r
+ (looking-at fuel-syntax--begin-of-def-regex))\r
+\r
+(defsubst fuel-syntax--at-begin-of-indent-def ()\r
+ (looking-at fuel-syntax--indent-def-start-regex))\r
+\r
+(defsubst fuel-syntax--at-end-of-def ()\r
+ (looking-at fuel-syntax--end-of-def-regex))\r
+\r
+(defsubst fuel-syntax--looking-at-emptiness ()\r
+ (looking-at "^[ ]*$\\|$"))\r
+\r
+(defsubst fuel-syntax--is-last-char (pos)\r
+ (save-excursion\r
+ (goto-char (1+ pos))\r
+ (looking-at-p "[ ]*$")))\r
+\r
+(defsubst fuel-syntax--line-offset (pos)\r
+ (- pos (save-excursion\r
+ (goto-char pos)\r
+ (beginning-of-line)\r
+ (point))))\r
+\r
+(defun fuel-syntax--previous-non-blank ()\r
+ (forward-line -1)\r
+ (while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))\r
+ (forward-line -1)))\r
+\r
+(defun fuel-syntax--beginning-of-block-pos ()\r
+ (save-excursion\r
+ (if (> (fuel-syntax--brackets-depth) 0)\r
+ (fuel-syntax--brackets-start)\r
+ (fuel-syntax--beginning-of-defun)\r
+ (point))))\r
+\r
+(defun fuel-syntax--at-setter-line ()\r
+ (save-excursion\r
+ (beginning-of-line)\r
+ (when (re-search-forward fuel-syntax--setter-regex\r
+ (line-end-position)\r
+ t)\r
+ (let* ((to (match-beginning 0))\r
+ (from (fuel-syntax--beginning-of-block-pos)))\r
+ (goto-char from)\r
+ (let ((depth (fuel-syntax--brackets-depth)))\r
+ (and (or (re-search-forward fuel-syntax--constructor-regex to t)\r
+ (re-search-forward fuel-syntax--setter-regex to t))\r
+ (= depth (fuel-syntax--brackets-depth))))))))\r
+\r
+(defun fuel-syntax--at-constructor-line ()\r
+ (save-excursion\r
+ (beginning-of-line)\r
+ (re-search-forward fuel-syntax--constructor-regex (line-end-position) t)))\r
+\r
+(defsubst fuel-syntax--at-using ()\r
+ (looking-at fuel-syntax--using-lines-regex))\r
+\r
+(defun fuel-syntax--in-using ()\r
+ (let ((p (point)))\r
+ (save-excursion\r
+ (and (re-search-backward "^USING: " nil t)\r
+ (re-search-forward " ;" nil t)\r
+ (< p (match-end 0))))))\r
+\r
+(defsubst fuel-syntax--beginning-of-defun (&optional times)\r
+ (re-search-backward fuel-syntax--begin-of-def-regex nil t times))\r
+\r
+(defsubst fuel-syntax--end-of-defun ()\r
+ (re-search-forward fuel-syntax--end-of-def-regex nil t))\r
+\r
+(defsubst fuel-syntax--end-of-defun-pos ()\r
+ (save-excursion\r
+ (re-search-forward fuel-syntax--end-of-def-regex nil t)\r
+ (point)))\r
+\r
+(defun fuel-syntax--beginning-of-body ()\r
+ (let ((p (point)))\r
+ (and (fuel-syntax--beginning-of-defun)\r
+ (re-search-forward fuel-syntax--defun-signature-regex p t)\r
+ (not (re-search-forward fuel-syntax--end-of-def-regex p t)))))\r
+\r
+(defun fuel-syntax--beginning-of-sexp ()\r
+ (if (> (fuel-syntax--brackets-depth) 0)\r
+ (goto-char (fuel-syntax--brackets-start))\r
+ (fuel-syntax--beginning-of-body)))\r
+\r
+(defsubst fuel-syntax--beginning-of-sexp-pos ()\r
+ (save-excursion (fuel-syntax--beginning-of-sexp) (point)))\r
+\r
+\f\r
+;;; USING/IN:\r
+\r
+(make-variable-buffer-local\r
+ (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))\r
+\r
+(defsubst fuel-syntax--current-vocab ()\r
+ (funcall fuel-syntax--current-vocab-function))\r
+\r
+(defun fuel-syntax--find-in ()\r
+ (save-excursion\r
+ (when (re-search-backward fuel-syntax--current-vocab-regex nil t)\r
+ (match-string-no-properties 1))))\r
+\r
+(make-variable-buffer-local\r
+ (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))\r
+\r
+(defsubst fuel-syntax--usings ()\r
+ (funcall fuel-syntax--usings-function))\r
+\r
+(defun fuel-syntax--file-has-private ()\r
+ (save-excursion\r
+ (goto-char (point-min))\r
+ (and (re-search-forward "\\_<<PRIVATE\\_>" nil t)\r
+ (re-search-forward "\\_<PRIVATE>\\_>" nil t))))\r
+\r
+(defun fuel-syntax--find-usings (&optional no-private)\r
+ (save-excursion\r
+ (let ((usings))\r
+ (goto-char (point-max))\r
+ (while (re-search-backward fuel-syntax--using-lines-regex nil t)\r
+ (dolist (u (split-string (match-string-no-properties 1) nil t))\r
+ (push u usings)))\r
+ (when (and (not no-private) (fuel-syntax--file-has-private))\r
+ (goto-char (point-max))\r
+ (push (concat (fuel-syntax--find-in) ".private") usings))\r
+ usings)))\r
+\r
+\f\r
+(provide 'fuel-syntax)\r
+;;; fuel-syntax.el ends here\r
projects / factor.git / commitdiff