FEAT: possibility to resolve context handle's type

resolves: Oldes/Rebol-issues#2465

Author: Oldes

src/boot/actions.reb

@@ -448,7 +448,7 @@ open?: action [
 
 query: action [
 	{Returns information about target if possible.}
-	target [port! file! url! block! vector! date!]
+	target [port! file! url! block! vector! date! handle!]
 	/mode "Get mode information"
 	field [word! block! none!] "NONE will return valid modes for target type"
 ]

src/boot/sysobj.reb

@@ -36,7 +36,7 @@ catalog: object [
 	reflectors: [
 		spec   [any-function! any-object! vector! datatype! struct!]
 		body   [any-function! any-object! map!]
-		words  [any-function! any-object! map! date!]
+		words  [any-function! any-object! map! date! handle!]
 		values [any-object! map! struct!]
 		types  [any-function!]
 		title  [any-function! datatype! module!]
@@ -318,6 +318,9 @@ standard: object [
 		utc:
 		julian:
 	]
+	handle-info: construct [
+		type:
+	]
 
 	midi-info: construct [
 		devices-in:

src/boot/types.reb

@@ -99,7 +99,7 @@ REBOL [
 
 	gob         self        gob         *        *       *      *   -  
 	event       self        event       *        *       *      *   -  
-	handle      self        handle      -        -       -      -   -
+	handle      self        handle      -        -       *      -   -
 	struct      self        struct      *        *       *      *   -  
 	library     invalid     0           -        -       -      -   -  
 	utype       self        utype       -        -       -      -   -  

src/core/t-handle.c

@@ -93,6 +93,58 @@
 }
 
 
+/***********************************************************************
+**
+*/	REBINT PD_Handle(REBPVS *pvs)
+/*
+***********************************************************************/
+{
+	REBVAL *data = pvs->value;
+	REBVAL *arg = pvs->select;
+	REBVAL *val = pvs->setval;
+	REBINT sym = 0;
+
+	if (!IS_HANDLE(data)) return PE_BAD_ARGUMENT;
+	if (!ANY_WORD(arg)) return PE_BAD_SELECT;
+
+	sym = VAL_WORD_CANON(arg);
+
+	if (val == 0) {
+		// onle get-path is allowed for handles and only /type value so far
+		if (sym != SYM_TYPE) return PE_BAD_SELECT;
+		if (IS_CONTEXT_HANDLE(data)) {
+			val = pvs->store;
+			Set_Word(val, VAL_HANDLE_SYM(data), NULL, 0);
+			return PE_USE;
+		}
+		// for the data handles, return NONE
+		return PE_NONE;
+	}
+	else {
+		// changing handle's type is not allowed
+		return PE_BAD_SET;
+	}
+}
+
+
+/***********************************************************************
+**
+*/	static REBOOL Query_Handle_Field(REBVAL *data, REBVAL *select, REBVAL *ret)
+/*
+**		Set a value with handle data according specified mode
+**
+***********************************************************************/
+{
+	REBPVS pvs;
+	pvs.value = data;
+	pvs.select = select;
+	pvs.setval = 0;
+	pvs.store = ret;
+
+	return (PE_BAD_SELECT > PD_Handle(&pvs));
+}
+
+
 /***********************************************************************
 **
 */	REBTYPE(Handle)
@@ -101,8 +153,64 @@
 ***********************************************************************/
 {
 	REBVAL *val = D_ARG(1);
+	REBVAL *spec;
+	REBINT num;
 
 	switch (action) {
+	case A_REFLECT:
+		*D_ARG(3) = *D_ARG(2);
+		// continue..
+	case A_QUERY:
+		//TODO: this code could be made resusable with other types!
+		spec = Get_System(SYS_STANDARD, STD_HANDLE_INFO);
+		if (!IS_OBJECT(spec)) Trap_Arg(spec);
+		if (D_REF(2)) { // query/mode refinement
+			REBVAL *field = D_ARG(3);
+			if (IS_WORD(field)) {
+				switch (VAL_WORD_CANON(field)) {
+				case SYM_WORDS:
+					Set_Block(D_RET, Get_Object_Words(spec));
+					return R_RET;
+				case SYM_SPEC:
+					return R_ARG1;
+				}
+				if (!Query_Handle_Field(val, field, D_RET))
+					Trap_Reflect(VAL_TYPE(val), field); // better error?
+			}
+			else if (IS_BLOCK(field)) {
+				REBVAL *out = D_RET;
+				REBSER *values = Make_Block(2 * BLK_LEN(VAL_SERIES(field)));
+				REBVAL *word = VAL_BLK_DATA(field);
+				for (; NOT_END(word); word++) {
+					if (ANY_WORD(word)) {
+						if (IS_SET_WORD(word)) {
+							// keep the set-word in result
+							out = Append_Value(values);
+							*out = *word;
+							VAL_SET_LINE(out);
+						}
+						out = Append_Value(values);
+						if (!Query_Handle_Field(val, word, out))
+							Trap1(RE_INVALID_ARG, word);
+					}
+					else  Trap1(RE_INVALID_ARG, word);
+				}
+				Set_Series(REB_BLOCK, D_RET, values);
+			}
+			else {
+				Set_Block(D_RET, Get_Object_Words(spec));
+			}
+		}
+		else {
+			REBSER *obj = CLONE_OBJECT(VAL_OBJ_FRAME(spec));
+			REBSER *words = VAL_OBJ_WORDS(spec);
+			REBVAL *word = BLK_HEAD(words);
+			for (num = 0; NOT_END(word); word++, num++) {
+				Query_Handle_Field(val, word, OFV(obj, num));
+			}
+			SET_OBJECT(D_RET, obj);
+		}
+		return R_RET;
 
 	default:
 		Trap_Action(VAL_TYPE(val), action);

src/tests/units/handle-test.r3

@@ -77,6 +77,16 @@ h4: aes/key #{00000000000000000000000000000000} none
 	--assert                "[#[handle! aes]]" = mold intersect  reduce [h1 h3] reduce [h3 h2]
 	--assert                "[#[handle! rc4]]" = mold exclude    reduce [h1 h3] reduce [h3 h2]
 
+--test-- "query handle's type"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/2465
+	; short and easy way
+	--assert h1/type = 'rc4
+	--assert h3/type = 'aes
+	; for consistency with other types (like date, image, etc..)
+	--assert [type] = words-of h1
+	--assert 'rc4 = query/mode h1 'type
+	--assert all [object? o: query h1 o/type = 'rc4]
+
 ===end-group===
 
 ~~~end-file~~~