-
Notifications
You must be signed in to change notification settings - Fork 0
/
options.tcl
68 lines (57 loc) · 2.06 KB
/
options.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
# -*- tcl -*-
## Ankh - Andreas Kupries Hashes
## (c) 2021-2024 Andreas Kupries http://wiki.tcl.tk/andreas%20kupries
# Option handling common to the hash commands.
# # ## ### ##### ######## #############
## FUTURE: Code generated by critcl from argument type definition.
##
## {options {
## -offset {wide >= 0}
## -length {wide >= 0}
## }} opts
critcl::ccode {
typedef struct _ankh_options {
Tcl_WideInt offset; /* #bytes after the start to start hashing from */
Tcl_WideInt length; /* #bytes to hash, at most (*) */
/* (*) May be limited to less by the end of the value. */
} _options;
#define EM(m,...) (Tcl_SetObjResult(ip, Tcl_ObjPrintf(m, __VA_ARGS__)))
#define EC(...) (Tcl_SetErrorCode(ip, "ANKH", __VA_ARGS__ , NULL))
static int handle_options (_options* options, Tcl_Interp* ip, Tcl_Obj* objv[], int objc) {
options->offset = -1;
options->length = -1;
if ((objc % 2) == 1) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("wrong # args: last option without value", -1)); /* OK tcl9 */
EC ("WRONG#ARGS", "NO LAST VALUE");
return TCL_ERROR;
}
int k = 0;
for (k = 0; k < objc; k += 2) {
char* option = Tcl_GetString (objv[k]);
if (0 == strcmp (option, "-offset")) {
if ((TCL_OK != Tcl_GetWideIntFromObj (ip, objv[k+1], &options->offset)) || (options->offset < 0)) {
char* value = Tcl_GetString(objv[k+1]);
EM ("invalid offset value. Expected wideInt >= 0, got %s", value);
EC ("INVALID OFFSET", value);
return TCL_ERROR;
}
continue;
}
if (0 == strcmp (option, "-length")) {
if ((TCL_OK != Tcl_GetWideIntFromObj (ip, objv[k+1], &options->length)) || (options->length < 0)) {
char* value = Tcl_GetString(objv[k+1]);
EM ("invalid length value. Expected wideInt >= 0, got %s", value);
EC ("INVALID LENGTH", value);
return TCL_ERROR;
}
continue;
}
EM ("invalid option %s, expected -length, or -offset", option);
EC ("INVALID OPTION", option);
return TCL_ERROR;
}
return TCL_OK;
}
}
# # ## ### ##### ######## #############
return