cmdr
Check-in [7acf8ff192]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:cmdr::table - Documented the package. Added testsuite. Added more validation and introspection. Added TEApot metadata.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7acf8ff192d118e43995ac679489c527f69f8f27
User & Date: aku 2016-06-29 07:03:22.681
Context
2016-06-29
07:04
cmdr::color - Added standard symbolic color "heading", for use by cmdr::table. check-in: 8358279e61 user: aku tags: trunk
07:03
cmdr::table - Documented the package. Added testsuite. Added more validation and introspection. Added TEApot metadata. check-in: 7acf8ff192 user: aku tags: trunk
2016-06-22
20:01
Drop the todo marker about the fail-* commands from the changes document check-in: 24b3dc9ad2 user: aku tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added doc/cmdr_table.man.






































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
[comment {-*- tcl -*- doctools manpage}]
[include parts/definitions.inc]
[vset VERSION 0.1]
[manpage_begin [vset LABEL_TABLE] [vset MAN_SECTION] [vset VERSION]]
[include parts/module.inc]
[require cmdr::util]
[titledesc [vset TITLE_TABLE]]
[description]
[include parts/welcome.inc]

This package provides convenience commands for the easy creation of
simple tables.

[comment {- - -- --- ----- -------- ------------- ---------------------}]
[section API]
[list_begin definitions]
[comment {- - -- --- ----- -------- -------------}]
[call [cmd ::cmdr::table] [method general] [arg var] [arg headers] [arg script]]

This command creates a new table with the words found in the list of
[arg headers] as the top row.

The [arg script] is run in the calling context to configure and
populate the table.

The table's object command is stored in the named [arg var] for access
by the [arg script].

The result of the command is the table's object command.

[list_begin arguments]
[arg_def varname var]
The name of the variable in the calling scope the new table's object
command will be stored into.
[arg_def list headers]
The list of words to user as column headers.
[arg_def string  script]
The tcl script to be run to configure and populate the table.
[list_end]

[comment {- - -- --- ----- -------- -------------}]
[call [cmd ::cmdr::table] [method dict] [arg var] [arg script]]

This command creates a new table intended for the display of a Tcl
dictionary.
It will have two columns titled [const Key] and [const Value].

The [arg script] is run in the calling context to configure and
populate the table.

The table's object command is stored in the named [arg var] for access
by the [arg script].

The result of the command is the table's object command.

[list_begin arguments]
[arg_def varname var]
The name of the variable in the calling scope the new table's object
command will be stored into.
[arg_def string  script]
The tcl script to be run to configure and populate the table.
[list_end]

[comment {- - -- --- ----- -------- -------------}]
[call [cmd ::cmdr::table] [method borders] [opt [arg enable]]]

This command configures the global [term border] setting, which
indicates the (non)use of borders by the tables of this package. Note
that changes to this setting influence only the tables created after
the change. Existing tables are not modified.

[para] The result of the command is the new state of the setting.

[para] If the command is called without an argument it simply returns the
current state of the setting, without making changes.

[para] The default value for the setting is [const yes].

Individual tables can override the global settings via their
[method borders] method, see [sectref {Table API}].

[list_begin arguments]
[arg_def boolean enable]
The new value of the setting. Optional.
[list_end]

[comment {- - -- --- ----- -------- -------------}]
[call [cmd ::cmdr::table] [method show] [opt [arg cmd]...]]

This command configures the global [term show] setting, which is the
command prefix to use to print a table, if the table is not given a
specific command to use. Note that changes to this setting influence
only the tables created after the change. Existing tables are not
modified.

[para] The result of the command is the new state of the setting

[para] If the command is called without any arguments it simply
returns the current state of the setting, without making changes.

[para] The default value for the setting is [const puts].

[list_begin arguments]
[arg_def word cmd]
The command prefix to use for printing a table, as varargs.
The prefix will be invoked with a single argument, the string
representation of the table.
[list_end]
[list_end]

[comment {- - -- --- ----- -------- ------------- ---------------------}]
[section {Table API}]

This section lists the methods available for configuration and
population of the tables created by this package.

[list_begin definitions]
[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method borders] [opt [arg enable]]]

This is the table-level [term borders] setting. On creation a table
inherits the global setting (See [cmd {::cmdr::table borders}]). If
that is not to suit then this method can be used to override it.

[para] The result of the method is the new state of the setting. When
called without argument no change is made and the result is the
current state of the setting.

[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method headers] [opt [arg enable]]]

This method controls the visibility of the header row.  By default
general tables have the header row visisble, while for dict tables the
header is suppressed. This method allows the user to override these
defaults.

[para] The result of the method is the new state of the setting. When
called without argument no change is made and the result is the
current state of the setting.

[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method style] [opt [arg style]]]

This method allows the user to force the use of a completely custom
style.

Please see the documentation for the Tcllib package [package report]
on how to define table styles.

[para] The package defines four styles of its own, all using the
common prefix [const cmdr/table/] in their names.

When no custom style is set the table chooses between these based on
its [term borders] and [term headers] settings.

[para] The result of the method is the new state of the setting. When
called without argument then no change is made and the result is the
current state of the setting.

[para] To revert from a custom style to the automatic choice invoke
this method with the empty string as the name of the style.

[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method add] [arg word]...]
[call [var t] [method +]   [arg word]...]
[call [var t] [method +=]  [arg word]...]
[call [var t] [method <<]  [arg word]...]
[call [var t] [method <=]  [arg word]...]

This method adds a new row to the table, containing the given words.
If less words than headers are specified the row is padded with empty columns.
If too many words are specified the superfluous words are ignored.

[para] The result of the method is the empty string.

[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method show*] [opt [arg cmd]]]

This method formats the table into a string and then invokes the
command prefix [arg cmd] to print that string. The command prefix is
run at the global namespace and level. If the [arg cmd] is not
specified the global [term show] setting is used instead.

[para] The result of the method is the empty string.

[comment {- - -- --- ----- -------- -------------}]
[call [var t] [method show] [opt [arg cmd]]]

This is a variant of method [method show*] above which not only prints
the table as above, but also destroys it.

[list_end]

[include parts/feedback.inc]
[manpage_end]
Changes to doc/parts/definitions.inc.
25
26
27
28
29
30
31

32
33
34
35
36
37
38
[vset TITLE_HELP_SQL      "[vset PTITLE] - Formatting help as series of SQL commands"]
[vset TITLE_HELP_TCL      "[vset PTITLE] - Formatting help as Tcl data structure"]
[vset TITLE_HISTORY       "[vset PTITLE] - Utilities for history management"]
[vset TITLE_OFFICER       "[vset PTITLE] - (Internal) Aggregation of multiple commands for dispatch."]
[vset TITLE_PAGER         "[vset PTITLE] - Paging long output"]
[vset TITLE_PARAMETER     "[vset PTITLE] - (Partially internal) Command parameters"]
[vset TITLE_PRIVATE       "[vset PTITLE] - (Internal) Single command handling, options, and arguments"]

[vset TITLE_TTY           "[vset PTITLE] - Check if stdin is a tty, i.e. terminal"]
[vset TITLE_UTIL          "[vset PTITLE] - (Internal) General Utilities"]
[vset TITLE_VALIDATE      "[vset PTITLE] - Standard validation types for parameters"]
[vset TITLE_VCOMMON       "[vset PTITLE] - Utilities for Validation Types"]
[vset TITLE_FLOW          "[vset PTITLE] - Runtime Processing Flow"]

[vset TITLE_VT_YEAR       "[vset PTITLE] - Validation type for years"]







>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
[vset TITLE_HELP_SQL      "[vset PTITLE] - Formatting help as series of SQL commands"]
[vset TITLE_HELP_TCL      "[vset PTITLE] - Formatting help as Tcl data structure"]
[vset TITLE_HISTORY       "[vset PTITLE] - Utilities for history management"]
[vset TITLE_OFFICER       "[vset PTITLE] - (Internal) Aggregation of multiple commands for dispatch."]
[vset TITLE_PAGER         "[vset PTITLE] - Paging long output"]
[vset TITLE_PARAMETER     "[vset PTITLE] - (Partially internal) Command parameters"]
[vset TITLE_PRIVATE       "[vset PTITLE] - (Internal) Single command handling, options, and arguments"]
[vset TITLE_TABLE         "[vset PTITLE] - Simple Table creation"]
[vset TITLE_TTY           "[vset PTITLE] - Check if stdin is a tty, i.e. terminal"]
[vset TITLE_UTIL          "[vset PTITLE] - (Internal) General Utilities"]
[vset TITLE_VALIDATE      "[vset PTITLE] - Standard validation types for parameters"]
[vset TITLE_VCOMMON       "[vset PTITLE] - Utilities for Validation Types"]
[vset TITLE_FLOW          "[vset PTITLE] - Runtime Processing Flow"]

[vset TITLE_VT_YEAR       "[vset PTITLE] - Validation type for years"]
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
[vset LABEL_HELP_SQL      [vset PROJECT]::help::sql]
[vset LABEL_HELP_TCL      [vset PROJECT]::help::tcl]
[vset LABEL_HISTORY       [vset PROJECT]::history]
[vset LABEL_OFFICER       [vset PROJECT]::officer]
[vset LABEL_PAGER         [vset PROJECT]::pager]
[vset LABEL_PARAMETER     [vset PROJECT]::parameter]
[vset LABEL_PRIVATE       [vset PROJECT]::private]

[vset LABEL_TTY           [vset PROJECT]::tty]
[vset LABEL_UTIL          [vset PROJECT]::util]
[vset LABEL_VALIDATE      [vset PROJECT]::validate]
[vset LABEL_VCOMMON       [vset PROJECT]::validate::common]
[vset LABEL_FLOW          [vset PROJECT]-spec-flow]

[vset LABEL_VT_YEAR       [vset PROJECT]::validate::year]
[vset LABEL_VT_WEEKDAY    [vset PROJECT]::validate::weekday]
[vset LABEL_VT_TIME       [vset PROJECT]::validate::time]
[vset LABEL_VT_TIME_MIN   [vset PROJECT]::validate::time::minute]
[vset LABEL_VT_POSINT     [vset PROJECT]::validate::posint]
[vset LABEL_VT_DATE       [vset PROJECT]::validate::date]







>












69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
[vset LABEL_HELP_SQL      [vset PROJECT]::help::sql]
[vset LABEL_HELP_TCL      [vset PROJECT]::help::tcl]
[vset LABEL_HISTORY       [vset PROJECT]::history]
[vset LABEL_OFFICER       [vset PROJECT]::officer]
[vset LABEL_PAGER         [vset PROJECT]::pager]
[vset LABEL_PARAMETER     [vset PROJECT]::parameter]
[vset LABEL_PRIVATE       [vset PROJECT]::private]
[vset LABEL_TABLE         [vset PROJECT]::table]
[vset LABEL_TTY           [vset PROJECT]::tty]
[vset LABEL_UTIL          [vset PROJECT]::util]
[vset LABEL_VALIDATE      [vset PROJECT]::validate]
[vset LABEL_VCOMMON       [vset PROJECT]::validate::common]
[vset LABEL_FLOW          [vset PROJECT]-spec-flow]

[vset LABEL_VT_YEAR       [vset PROJECT]::validate::year]
[vset LABEL_VT_WEEKDAY    [vset PROJECT]::validate::weekday]
[vset LABEL_VT_TIME       [vset PROJECT]::validate::time]
[vset LABEL_VT_TIME_MIN   [vset PROJECT]::validate::time::minute]
[vset LABEL_VT_POSINT     [vset PROJECT]::validate::posint]
[vset LABEL_VT_DATE       [vset PROJECT]::validate::date]
Added tests/table.test.












































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0
# # ## ### ##### ######## ############# #####################
## Testing the cmdr::table package.

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support debug
kt require support debug::caller
kt require support report
kt require support struct::matrix
kt local   support cmdr::color

kt local   testing cmdr::table

proc nop  {args} {}
proc ping {args} { set ::ping 1 ; return }
proc record  {s} { set ::ping $s }

# # ## ### ##### ######## ############# #####################
## Basic wrong#args checks.

test cmdr-table-1.0 {table, wrong num args, not enough} -body {
    cmdr table
} -returnCodes error \
    -result {wrong # args: should be "cmdr table subcommand ?argument ...?"}

test cmdr-table-1.1 {table, bogus sub-command} -body {
    cmdr table foo
} -returnCodes error \
    -result {unknown or ambiguous subcommand "foo": must be borders, dict, general, or show}

# # ## ### ##### ######## ############# #####################
## Global border control

test cmdr-table-2.0 {table borders, wrong num args, too many} -body {
    cmdr table borders 0 X
} -returnCodes error \
    -result {wrong # args: should be "cmdr table borders ?enable?"}

test cmdr-table-2.1 {table borders, default} -body {
    cmdr table borders
} -result yes

test cmdr-table-2.2.0 {table borders, clear} -body {
    cmdr table borders 0
} -result 0

test cmdr-table-2.2.1 {table borders, set} -body {
    cmdr table borders 1
} -result 1

test cmdr-table-2.2.2 {table borders, set, not boolean} -body {
    cmdr table borders bogus
} -returnCodes error -result {Expected boolean, got "bogus"}

test cmdr-table-2.3.0 {table borders, style influence, no borders} -body {
    cmdr table borders 0
    cmdr table general T {a b} {}
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/plain

test cmdr-table-2.3.1 {table borders, style influence, with borders} -body {
    cmdr table borders 1
    cmdr table general T {a b} {}
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders

# # ## ### ##### ######## ############# #####################
## Global show command
## Note: No wrong#args, accepts 0 and more arguments.

test cmdr-table-3.0 {table show, default} -body {
    cmdr table show
} -result puts

test cmdr-table-3.1 {table show, set} -body {
    cmdr table show this way
} -result {this way}

test cmdr-table-3.2 {table show, fallback} -setup {
    unset -nocomplain ping
} -body {
    cmdr table show ping
    cmdr table general T {a b} {}
    $T show*
    set ping
} -cleanup {
    $T destroy
    unset T ping
} -result 1

# # ## ### ##### ######## ############# #####################
## General table

test cmdr-table-4.0.0 {table general, wrong num args, not enough} -body {
    cmdr table general
} -returnCodes error \
    -result {wrong # args: should be "cmdr table general v headings script"}

test cmdr-table-4.0.1 {table general, wrong num args, not enough} -body {
    cmdr table general T
} -returnCodes error \
    -result {wrong # args: should be "cmdr table general v headings script"}

test cmdr-table-4.0.2 {table general, wrong num args, not enough} -body {
    cmdr table general T H
} -returnCodes error \
    -result {wrong # args: should be "cmdr table general v headings script"}

test cmdr-table-4.0.3 {table general, wrong num args, too many} -body {
    cmdr table general T H S X
} -returnCodes error \
    -result {wrong # args: should be "cmdr table general v headings script"}

test cmdr-table-4.1.0 {table general, empty, lifecycle, constructor} -body {
    cmdr table general T {a b} {}
} -cleanup {
    $T destroy
    unset T
} -match glob -result {::oo::Obj*}

test cmdr-table-4.1.1 {table general, empty, lifecycle, destructor} -setup {
    cmdr table general T {a b} {}
} -body {
    $T destroy
} -cleanup {
    unset T
} -result {}

# # ## ### ##### ######## ############# #####################
## Dict table

test cmdr-table-5.0.0 {table dict, wrong num args, not enough} -body {
    cmdr table dict
} -returnCodes error \
    -result {wrong # args: should be "cmdr table dict v script"}

test cmdr-table-5.0.1 {table dict, wrong num args, not enough} -body {
    cmdr table dict T
} -returnCodes error \
    -result {wrong # args: should be "cmdr table dict v script"}

test cmdr-table-5.0.2 {table dict, wrong num args, too many} -body {
    cmdr table dict T S X
} -returnCodes error \
    -result {wrong # args: should be "cmdr table dict v script"}

test cmdr-table-5.1.0 {table dict, empty, lifecycle, constructor} -body {
    cmdr table dict T {}
} -cleanup {
    $T destroy
    unset T
} -match glob -result {::oo::Obj*}

test cmdr-table-5.1.1 {table dict, empty, lifecycle, destructor} -setup {
    cmdr table dict T {}
} -body {
    $T destroy
} -cleanup {
    unset T
} -result {}

# # ## ### ##### ######## ############# #####################
## table row add - no wrong num args, everything is possible

test cmdr-table-6.0.0 {table row add, result} -setup {
    cmdr table general T {a b} {}
} -body {
    $T add c d
} -cleanup {
    $T destroy
    unset T
} -result {}

test cmdr-table-6.0.1 {table row add, content} -setup {
    unset -nocomplain ping
    cmdr table general T {a b} {}
} -body {
    $T add c d
    $T show* record
    set ping
} -cleanup {
    $T destroy
    unset T ping
} -match glob -result {*| c | d |*}

# # ## ### ##### ######## ############# #####################
## Per-table border control

test cmdr-table-7.0 {table borders, wrong num args, too many} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders 0 X
} -cleanup {
    $T destroy
    unset T
} -returnCodes error \
    -match glob -result {wrong # args: should be "::oo::Obj* borders \?enable\?"}

test cmdr-table-7.1.0 {table borders, default} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders
} -cleanup {
    $T destroy
    unset T
} -result 1

test cmdr-table-7.1.1 {dict borders, default} -setup {
    cmdr table dict T {}
} -body {
    $T borders
} -cleanup {
    $T destroy
    unset T
} -result 1

test cmdr-table-7.2.0 {table borders, clear} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders 0
} -cleanup {
    $T destroy
    unset T
} -result 0

test cmdr-table-7.2.1 {table borders, set} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders 1
} -cleanup {
    $T destroy
    unset T
} -result 1

test cmdr-table-7.2.2 {table borders, set, not boolean} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders bogus
} -cleanup {
    $T destroy
    unset T
} -returnCodes error -result {Expected boolean, got "bogus"}

test cmdr-table-7.3.0 {table borders, style influence, no borders} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders 0
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/plain

test cmdr-table-7.3.1 {table borders, style influence, with borders} -setup {
    cmdr table general T {a b} {}
} -body {
    $T borders 1
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders

# # ## ### ##### ######## ############# #####################
## Per-table header control

test cmdr-table-8.0 {table headers, wrong num args, too many} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers 0 X
} -cleanup {
    $T destroy
    unset T
} -returnCodes error \
    -match glob -result {wrong # args: should be "::oo::Obj* headers \?enable\?"}

test cmdr-table-8.1.0 {table headers, default} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers
} -cleanup {
    $T destroy
    unset T
} -result 1

test cmdr-table-8.1.1 {dict headers, default} -setup {
    cmdr table dict T {}
} -body {
    $T headers
} -cleanup {
    $T destroy
    unset T
} -result no

test cmdr-table-8.2.0 {table headers, clear} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers 0
} -cleanup {
    $T destroy
    unset T
} -result 0

test cmdr-table-8.2.1 {table headers, set} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers 1
} -cleanup {
    $T destroy
    unset T
} -result 1

test cmdr-table-8.2.2 {table headers, set, not boolean} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers bogus
} -cleanup {
    $T destroy
    unset T
} -returnCodes error -result {Expected boolean, got "bogus"}

test cmdr-table-8.3.0 {table headers, style influence, no headers} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers 0
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders/nohdr

test cmdr-table-8.3.1 {table headers, style influence, with headers} -setup {
    cmdr table general T {a b} {}
} -body {
    $T headers 1
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders

# # ## ### ##### ######## ############# #####################
## Per-table style control

test cmdr-table-9.0 {table style, wrong num args, too many} -setup {
    cmdr table general T {a b} {}
} -body {
    $T style 0 X
} -cleanup {
    $T destroy
    unset T
} -returnCodes error \
    -match glob -result {wrong # args: should be "::oo::Obj* style \?style\?"}

test cmdr-table-9.1.0 {table style, default} -setup {
    cmdr table general T {a b} {}
} -body {
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders

test cmdr-table-9.1.1 {dict style, default} -setup {
    cmdr table dict T {}
} -body {
    $T style
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders/nohdr

test cmdr-table-9.2.0 {table style, reset to default} -setup {
    cmdr table general T {a b} {}
    $T style foo
} -body {
    $T style {}
} -cleanup {
    $T destroy
    unset T
} -result cmdr/table/borders

test cmdr-table-9.2.1 {table style, set} -setup {
    cmdr table general T {a b} {}
} -body {
    $T style foo
} -cleanup {
    $T destroy
    unset T
} -result foo

# # ## ### ##### ######## ############# #####################
## Table printing with auto-destruction

test cmdr-table-10.0 {table show, wrong num args, too many} -setup {
    cmdr table general T {a b} {}
} -body {
    $T show C X
} -cleanup {
    $T destroy
    unset T
} -match glob -returnCodes error \
    -result {wrong # args: should be "::oo::Obj* show ?cmd?"}

test cmdr-table-10.1 {table show, and automatic destruction} -setup {
    unset -nocomplain ping
    cmdr table general T {a b} {}
} -body {
    $T show ping
    list $ping [llength [info commands $T]]
} -cleanup {
    unset T ping
} -result {1 0}

# # ## ### ##### ######## ############# #####################
## Table printing, no auto-destruction

test cmdr-table-11.0 {table show*, wrong num args, too many} -setup {
    cmdr table general T {a b} {}
} -body {
    $T show* C X
} -cleanup {
    $T destroy
    unset T
} -match glob -returnCodes error \
    -result {wrong # args: should be "::oo::Obj* show\* ?cmd?"}

test cmdr-table-11.1 {table show*, no destruction} -setup {
    unset -nocomplain ping
    cmdr table general T {a b} {}
} -body {
    $T show* ping
    list $ping [llength [info commands $T]]
} -cleanup {
    $T destroy
    unset T ping
} -result {1 1}

# # ## ### ##### ######## ############# #####################
rename nop    {}
rename ping   {}
rename record {}

cleanupTests
return
Changes to utilities/table.tcl.
1
2
3
4
5
6
7

8

9

10
11
12
13

14

15
16
17
18
19
20
21
# -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Easy table generation

# @@ Meta Begin
# Package cmdr::table 0
# Meta author      ?

# Meta category    ?

# Meta description ?

# Meta location    http:/core.tcl.tk/akupries/cmdr
# Meta platform    tcl
# Meta require     ?
# Meta subject     ?

# Meta summary     ?

# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5
package require TclOO





|
|
>
|
>
|
>
|
|
|
|
>
|
>







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
# -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Easy table generation

# @@ Meta Begin
# Package cmdr::table 0.1
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform    tcl
# Meta summary Easy generation of tables
# Meta description Easy generation of tables
# Meta subject {command line} table matrix report
# Meta require {Tcl 8.5-}
# Meta require TclOO
# Meta require cmdr::color
# Meta require debug
# Meta require debug::caller
# Meta require report
# Meta require struct::matrix
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5
package require TclOO
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112




113
114
115
116
117
118



119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
# # ## ### ##### ######## ############# ######################

namespace eval ::cmdr {
    namespace export table
    namespace ensemble create
}
namespace eval ::cmdr::table {
    variable plain   no   ;# Global style setting (plain yes/no)
    variable showcmd puts ;# Global print setting (command prefix)

    namespace export general dict plain show
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## API

proc ::cmdr::table::plain {v} {
    debug.cmdr/table {}
    variable plain $v




    return
}

proc ::cmdr::table::show {args} {
    debug.cmdr/table {}
    variable showcmd $args



    return
}

proc ::cmdr::table::general {v headings script} {
    debug.cmdr/table {}

    variable plain
    upvar 1 $v t
    set t [uplevel 1 [list ::cmdr::table::Impl::general new {*}$headings]]
    if {$plain} { $t plain }
    uplevel 1 $script
    return $t
}

proc ::cmdr::table::dict {v script} {
    debug.cmdr/table {}

    upvar 1 $v t
    variable plain
    set t [uplevel 1 [list ::cmdr::table::Impl::dict new]]
    if {$plain} { $t plain }
    uplevel 1 $script
    return $t
}








# # ## ### ##### ######## ############# #####################
## Internal classes

oo::class create ::cmdr::table::Impl::general {
    # # ## ### ##### ######## #############

    constructor {args} {
	debug.cmdr/table {}
	namespace import ::cmdr::color
	# args = headings.

	struct::matrix [self namespace]::M
	M add columns [llength $args]

	set headings {}
	foreach w $args { lappend headings [color heading $w] }

	M add row $headings
	set myplain 0
	set myheader 1
	set mystyle {}
	return
    }

    destructor {}

    # # ## ### ##### ######## #############







|


|






|

|
>
>
>
>
|




|
>
>
>
|





|


|








|

|



>
>
>
>
>
>
>



















|
|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
# # ## ### ##### ######## ############# ######################

namespace eval ::cmdr {
    namespace export table
    namespace ensemble create
}
namespace eval ::cmdr::table {
    variable borders yes  ;# Global style setting (use borders: yes/no)
    variable showcmd puts ;# Global print setting (command prefix)

    namespace export general dict borders show
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## API

proc ::cmdr::table::borders {{enable {}}} {
    debug.cmdr/table {}
    variable borders
    if {[llength [info level 0]] > 1} {
	CheckBool $enable
	set borders $enable
    }
    return $borders
}

proc ::cmdr::table::show {args} {
    debug.cmdr/table {}
    variable showcmd
    if {[llength $args]} {
	set showcmd $args
    }
    return $showcmd
}

proc ::cmdr::table::general {v headings script} {
    debug.cmdr/table {}

    variable borders
    upvar 1 $v t
    set t [uplevel 1 [list ::cmdr::table::Impl::general new {*}$headings]]
    if {!$borders} { $t borders no }
    uplevel 1 $script
    return $t
}

proc ::cmdr::table::dict {v script} {
    debug.cmdr/table {}

    upvar 1 $v t
    variable borders
    set t [uplevel 1 [list ::cmdr::table::Impl::dict new]]
    if {!$borders} { $t borders no }
    uplevel 1 $script
    return $t
}

proc ::cmdr::table::CheckBool {v} {
    debug.cmdr/table {}
    if {[string is boolean -strict $v]} return
    return -code error -errorcode {CMDR TABLE NOT-A-BOOLEAN} \
	"Expected boolean, got \"$v\""
}

# # ## ### ##### ######## ############# #####################
## Internal classes

oo::class create ::cmdr::table::Impl::general {
    # # ## ### ##### ######## #############

    constructor {args} {
	debug.cmdr/table {}
	namespace import ::cmdr::color
	# args = headings.

	struct::matrix [self namespace]::M
	M add columns [llength $args]

	set headings {}
	foreach w $args { lappend headings [color heading $w] }

	M add row $headings
	set myborders 1
	set myheaders 1
	set mystyle {}
	return
    }

    destructor {}

    # # ## ### ##### ######## #############
195
196
197
198
199
200
201
202
203


204

205
206
207
208
209


210

211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239




240
241






242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
	    variable ::cmdr::table::showcmd
	    set cmd $::cmdr::table::showcmd
	}
	uplevel #0 [list {*}$cmd [my String]]
	return
    }

    method plain {} {
	debug.cmdr/table {}


	set myplain 1

	return
    }

    method style {style} {
	debug.cmdr/table {}


	set mystyle $style

	return
    }

    method noheader {} {
	debug.cmdr/table {}
	if {!$myheader} return
	set myheader 0
	M delete row 0

	return
    }

    method String {} {
	debug.cmdr/table {}
	# Choose style (user-specified, plain y/n, header y/n)

	if {$mystyle ne {}} {
	    set thestyle $mystyle
	} elseif {$myplain} {
	    if {$myheader} {
		set thestyle cmdr/table/plain
	    } else {
		set thestyle cmdr/table/plain/nohdr
	    }
	} else {
	    if {$myheader} {
		set thestyle cmdr/table/borders
	    } else {
		set thestyle cmdr/table/borders/nohdr
	    }




	}







	set r [report::report [self namespace]::R [M columns] style $thestyle]
	set str [M format 2string $r]
	$r destroy

	return [string trimright $str]
    }

    # # ## ### ##### ######## #############
    ## Internal commands.

    # # ## ### ##### ######## #############
    ## State

    variable myplain myheader mystyle

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################

oo::class create ::cmdr::table::Impl::dict {
    # # ## ### ##### ######## #############
    superclass ::cmdr::table::Impl::general

    constructor {} {
	debug.cmdr/table {}
	next Key Value
	my noheader ;# suppress header row.
	# Keys are the headers (side ways table).
	return
    }

    destructor {}

    # # ## ### ##### ######## #############







|

>
>
|
>
|


|

>
>
|
>
|


|

|
|
<
>
|


|

|
<


|
|
<
<
<
<
<
<




>
>
>
>


>
>
>
>
>
>
|


<









|













|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249

250
251
252
253






254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	    variable ::cmdr::table::showcmd
	    set cmd $::cmdr::table::showcmd
	}
	uplevel #0 [list {*}$cmd [my String]]
	return
    }

    method borders {{enable {}}} {
	debug.cmdr/table {}
	if {[llength [info level 0]] > 2} {
	    ::cmdr::table::CheckBool $enable
	    set myborders $enable
	}
	return $myborders
    }

    method headers {{enable {}}} {
	debug.cmdr/table {}
	if {[llength [info level 0]] > 2} {
	    ::cmdr::table::CheckBool $enable
	    set myheaders $enable
	}
	return $myheaders
    }

    method style {{style {}}} {
	debug.cmdr/table {}
	if {[llength [info level 0]] > 2} {
	    set mystyle $style

	}
	return [my Style]
    }

    method Style {} {
	debug.cmdr/table {}
	# Determine and return style (user-specified, borders y/n, header y/n)

	if {$mystyle ne {}} {
	    set thestyle $mystyle
	} elseif {$myborders} {
	    if {$myheaders} {






		set thestyle cmdr/table/borders
	    } else {
		set thestyle cmdr/table/borders/nohdr
	    }
	} elseif {$myheaders} {
	    set thestyle cmdr/table/plain
	} else {
	    set thestyle cmdr/table/plain/nohdr
	}

	debug.cmdr/table {==> ($thestyle)}
	return $thestyle
    }

    method String {} {
	debug.cmdr/table {}
	set r [report::report [self namespace]::R [M columns] style [my Style]]
	set str [M format 2string $r]
	$r destroy

	return [string trimright $str]
    }

    # # ## ### ##### ######## #############
    ## Internal commands.

    # # ## ### ##### ######## #############
    ## State

    variable myborders myheaders mystyle

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################

oo::class create ::cmdr::table::Impl::dict {
    # # ## ### ##### ######## #############
    superclass ::cmdr::table::Impl::general

    constructor {} {
	debug.cmdr/table {}
	next Key Value
	my headers no ;# suppress header row.
	# Keys are the headers (side ways table).
	return
    }

    destructor {}

    # # ## ### ##### ######## #############
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
	# applied here.

	regexp {(^[- ]*)(.*)$} $key -> prefix thekey
	M add row [list $prefix[color heading $thekey] $value]
	return
    }

    # # ## ### ##### ######## #############
    ## Internal commands.

    # # ## ### ##### ######## #############
    ## State - None of its own.

    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::table 0







<
<
<
<
<
<





|
311
312
313
314
315
316
317






318
319
320
321
322
323
	# applied here.

	regexp {(^[- ]*)(.*)$} $key -> prefix thekey
	M add row [list $prefix[color heading $thekey] $value]
	return
    }







    # # ## ### ##### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::table 0.1