From 0f1aa770a193867e6f286f2b44b2f028c54c0f9e Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sat, 20 Feb 2010 00:22:01 -0800 Subject: [PATCH 01/10] Merge up --- extra/openal/alut/alut.factor | 206 ++++++++++++++-------------- extra/openal/example/example.factor | 66 ++++----- 2 files changed, 136 insertions(+), 136 deletions(-) diff --git a/extra/openal/alut/alut.factor b/extra/openal/alut/alut.factor index d1b8d2600d..9e37d9886c 100755 --- a/extra/openal/alut/alut.factor +++ b/extra/openal/alut/alut.factor @@ -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 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 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 ; + diff --git a/extra/openal/example/example.factor b/extra/openal/example/example.factor index 7789ee6e0a..54ce402957 100755 --- a/extra/openal/example/example.factor +++ b/extra/openal/example/example.factor @@ -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) ; From 30b586ef5fd035bc5d681cf7a0e14a952a3407b9 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sat, 20 Feb 2010 00:24:37 -0800 Subject: [PATCH 02/10] Merge up --- .../mailboxes/mailboxes-tests.factor | 108 +++++----- basis/concurrency/mailboxes/mailboxes.factor | 188 +++++++++--------- basis/concurrency/promises/promises.factor | 54 ++--- 3 files changed, 175 insertions(+), 175 deletions(-) diff --git a/basis/concurrency/mailboxes/mailboxes-tests.factor b/basis/concurrency/mailboxes/mailboxes-tests.factor index 3435a01455..87a4c3cdba 100644 --- a/basis/concurrency/mailboxes/mailboxes-tests.factor +++ b/basis/concurrency/mailboxes/mailboxes-tests.factor @@ -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 - - [ 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 - - [ [ 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 - - [ [ 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" } ] [ - - "foo" over mailbox-put - "bar" over mailbox-put - mailbox-get-all -] unit-test - -[ - 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 + + [ 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 + + [ [ 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 + + [ [ 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" } ] [ + + "foo" over mailbox-put + "bar" over mailbox-put + mailbox-get-all +] unit-test + +[ + 1 seconds mailbox-get-timeout +] [ wait-timeout? ] must-fail-with diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor index 06da3b34a6..221a5a1fa3 100644 --- a/basis/concurrency/mailboxes/mailboxes.factor +++ b/basis/concurrency/mailboxes/mailboxes.factor @@ -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 new - >>threads - >>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 ( message -- message ) - dup linked-error? [ rethrow ] when ; - -TUPLE: linked-thread < thread supervisor ; - -M: linked-thread error-in-thread - [ ] [ supervisor>> ] bi mailbox-put ; - -: ( quot name mailbox -- thread' ) - [ linked-thread new-thread ] dip >>supervisor ; - -: spawn-linked-to ( quot name mailbox -- 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 new + >>threads + >>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 ( message -- message ) + dup linked-error? [ rethrow ] when ; + +TUPLE: linked-thread < thread supervisor ; + +M: linked-thread error-in-thread + [ ] [ supervisor>> ] bi mailbox-put ; + +: ( quot name mailbox -- thread' ) + [ linked-thread new-thread ] dip >>supervisor ; + +: spawn-linked-to ( quot name mailbox -- thread ) + [ (spawn) ] keep ; diff --git a/basis/concurrency/promises/promises.factor b/basis/concurrency/promises/promises.factor index 3381bcc00b..4d6439cf30 100644 --- a/basis/concurrency/promises/promises.factor +++ b/basis/concurrency/promises/promises.factor @@ -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 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 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 ; From b25e945c746e357b54107fa6212184555dd83f94 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sat, 20 Feb 2010 03:02:56 -0800 Subject: [PATCH 03/10] The return values in the stack effects of FUNCTION: words were c-types rather than strings. This was causing scaffold-help to fail on vocabularies with FUNCTION:. --- basis/alien/parser/parser.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 0cf495fd25..d706446799 100644 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -72,10 +72,10 @@ IN: alien.parser : function-quot ( return library function types -- quot ) '[ _ _ _ _ alien-invoke ] ; -:: make-function ( return! library function! parameters -- word quot effect ) - return function normalize-c-arg function! return! +:: make-function ( return library function parameters -- word quot effect ) + return function normalize-c-arg :> ( return-c-type function ) function create-in dup reset-generic - return library function + return-c-type library function parameters return parse-arglist [ function-quot ] dip ; : parse-arg-tokens ( -- tokens ) From 536ae3c64856a95f18eb96f62adca63a3b022caa Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sat, 20 Feb 2010 21:15:47 -0800 Subject: [PATCH 04/10] Unit test checking the stack effects from FUNCTION:. --- basis/alien/parser/parser-tests.factor | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/basis/alien/parser/parser-tests.factor b/basis/alien/parser/parser-tests.factor index e405f49995..2fec2d9a4c 100644 --- a/basis/alien/parser/parser-tests.factor +++ b/basis/alien/parser/parser-tests.factor @@ -1,7 +1,7 @@ ! (c)2009 Joe Groff bsd license USING: accessors alien.c-types alien.parser alien.syntax -tools.test vocabs.parser parser eval vocabs.parser debugger -continuations ; +tools.test vocabs.parser parser eval debugger kernel +continuations words ; IN: alien.parser.tests TYPEDEF: char char2 @@ -34,6 +34,11 @@ CONSTANT: eleven 11 ] with-file-vocabs +FUNCTION: void* alien-parser-effect-test ( int *arg1 float arg2 ) ; +[ (( arg1 arg2 -- void* )) ] [ + \ alien-parser-effect-test "declared-effect" word-prop +] unit-test + ! Reported by mnestic TYPEDEF: int alien-parser-test-int ! reasonably unique name... From bb3665f37e7a7f9a101ff88c7820ec5d37d8c8cb Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 03:27:16 -0800 Subject: [PATCH 05/10] FUEL: Flip the default behavior of visit-other-file so that it does not try to create -docs or -tests files if they do not exist by default. This is the more common case when spelunking in code and in general you want to scaffold those files anyway. --- misc/fuel/factor-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index bef6e4c774..c26abab997 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -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) From ffddca36b74ea54be2f52b8ada2b0e17802a3582 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 03:34:08 -0800 Subject: [PATCH 06/10] Add scaffolding words for tags, summary and authors and hook these up to FUEL. Modified fuel-scaffold-vocab to prompt the user for tags, summary and whether to create help and test files immediately. --- basis/tools/scaffold/scaffold-docs.factor | 26 ++++++- basis/tools/scaffold/scaffold.factor | 27 +++++-- basis/vocabs/files/files-docs.factor | 8 +++ basis/vocabs/files/files.factor | 6 +- extra/fuel/fuel.factor | 19 ++++- misc/fuel/fuel-scaffold.el | 88 ++++++++++++++++++++++- 6 files changed, 159 insertions(+), 15 deletions(-) diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index f4200f8cb2..4476f5ec9f 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -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 } } diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 936d388b01..151d98a134 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -63,6 +63,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 ; @@ -104,16 +107,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 @@ -258,12 +262,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 ; diff --git a/basis/vocabs/files/files-docs.factor b/basis/vocabs/files/files-docs.factor index e2c6a5f373..61a2e68707 100644 --- a/basis/vocabs/files/files-docs.factor +++ b/basis/vocabs/files/files-docs.factor @@ -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." } ; diff --git a/basis/vocabs/files/files.factor b/basis/vocabs/files/files.factor index c1d7dcfd59..1c3e3731bd 100644 --- a/basis/vocabs/files/files.factor +++ b/basis/vocabs/files/files.factor @@ -4,8 +4,6 @@ USING: io.directories io.files io.pathnames kernel make sequences vocabs.loader ; IN: vocabs.files - - : 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 ; \ No newline at end of file + ] { } make ; diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index d64ef41f8c..2934d5d43c 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el index 9b7d9861c7..9e8e56475d 100644 --- a/misc/fuel/fuel-scaffold.el +++ b/misc/fuel/fuel-scaffold.el @@ -79,6 +79,25 @@ 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))) + +(defsubst fuel-scaffold--creaet- + (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 +121,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 +131,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 +169,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 From a452966af9724f83260204ea4cc1abab6aa810b0 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 03:35:15 -0800 Subject: [PATCH 07/10] FUEL: Add prefix key behavior to fuel-test-vocab so that it is similar to other FUEL interactive functions. --- misc/fuel/fuel-listener.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index d5fec4bf5f..485d97e81f 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -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 From 9b8fd8d160adb77ea560aa31f1aa2ac1b33aa5e6 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 04:39:44 -0800 Subject: [PATCH 08/10] Fix parse error in elisp file --- misc/fuel/fuel-scaffold.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el index 9e8e56475d..dc2a09713d 100644 --- a/misc/fuel/fuel-scaffold.el +++ b/misc/fuel/fuel-scaffold.el @@ -96,8 +96,6 @@ IN: %s (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel"))) (fuel-eval--send/wait cmd))) -(defsubst fuel-scaffold--creaet- - (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))) From 52a8c3ebc9cec2943ad1dc02a69d6d66cc62e56f Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 16:42:31 -0800 Subject: [PATCH 09/10] FUEL: Add UNION-STRUCT: to syntax highlighting. --- misc/fuel/fuel-syntax.el | 912 +++++++++++++++++++-------------------- 1 file changed, 456 insertions(+), 456 deletions(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 1b060e5dd1..7de627f8f5 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -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 -;; 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 - '(":" "::" ";" "&:" "<<" ">" - "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 - "\\_" " +\\(\\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 "\\_>" (1 ">b")) - ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)" - (3 "\"") (6 "\"")) - ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)" - (1 "w") (2 "b")) - ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w")) - ;; Comments - ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) - ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) - ;; postpone - ("\\_b")) - ;; Multiline constructs - ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b")) - ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) - ("\\_b")) - ("\\_\\)" (1 "\\)" - (2 "" (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 "\\_<" nil t) - (re-search-forward "\\_\\_>" 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 +;; 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 + '(":" "::" ";" "&:" "<<" ">" + "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 + "\\_" " +\\(\\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 "\\_>" (1 ">b")) + ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)?\\(\"\\)\\(\\([^\n\r\f\"\\]\\|\\\\.\\)*\\)\\(\"\\)" + (3 "\"") (6 "\"")) + ("CHAR: \\(\"\\) [^\\\"]*?\\(\"\\)\\([^\\\"]\\|\\\\.\\)*?\\(\"\\)" + (1 "w") (2 "b")) + ("\\(CHAR:\\|\\\\\\) \\(\\w\\|!\\)\\( \\|$\\)" (2 "w")) + ;; Comments + ("\\_<\\(#?!\\) .*\\(\n\\|$\\)" (1 "<") (2 ">")) + ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">")) + ;; postpone + ("\\_b")) + ;; Multiline constructs + ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b")) + ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) + ("\\_b")) + ("\\_\\)" (1 "\\)" + (2 "" (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 "\\_<" nil t) + (re-search-forward "\\_\\_>" 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 From a56d0a760283d928017ab9b20ca4873de9ff92a7 Mon Sep 17 00:00:00 2001 From: Erik Charlebois Date: Sun, 21 Feb 2010 16:43:09 -0800 Subject: [PATCH 10/10] Bindings to the HID portion of the Windows DDK. --- basis/windows/ddk/hid/authors.txt | 1 + basis/windows/ddk/hid/hid.factor | 805 ++++++++++++++++++++++++++++++ 2 files changed, 806 insertions(+) create mode 100644 basis/windows/ddk/hid/authors.txt create mode 100644 basis/windows/ddk/hid/hid.factor diff --git a/basis/windows/ddk/hid/authors.txt b/basis/windows/ddk/hid/authors.txt new file mode 100644 index 0000000000..67cf648cf5 --- /dev/null +++ b/basis/windows/ddk/hid/authors.txt @@ -0,0 +1 @@ +Erik Charlebois \ No newline at end of file diff --git a/basis/windows/ddk/hid/hid.factor b/basis/windows/ddk/hid/hid.factor new file mode 100644 index 0000000000..9c8a55ee7c --- /dev/null +++ b/basis/windows/ddk/hid/hid.factor @@ -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 + ) ;