cmdr
Check-in [7acf8ff192]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added doc/cmdr_table.man.

            1  +[comment {-*- tcl -*- doctools manpage}]
            2  +[include parts/definitions.inc]
            3  +[vset VERSION 0.1]
            4  +[manpage_begin [vset LABEL_TABLE] [vset MAN_SECTION] [vset VERSION]]
            5  +[include parts/module.inc]
            6  +[require cmdr::util]
            7  +[titledesc [vset TITLE_TABLE]]
            8  +[description]
            9  +[include parts/welcome.inc]
           10  +
           11  +This package provides convenience commands for the easy creation of
           12  +simple tables.
           13  +
           14  +[comment {- - -- --- ----- -------- ------------- ---------------------}]
           15  +[section API]
           16  +[list_begin definitions]
           17  +[comment {- - -- --- ----- -------- -------------}]
           18  +[call [cmd ::cmdr::table] [method general] [arg var] [arg headers] [arg script]]
           19  +
           20  +This command creates a new table with the words found in the list of
           21  +[arg headers] as the top row.
           22  +
           23  +The [arg script] is run in the calling context to configure and
           24  +populate the table.
           25  +
           26  +The table's object command is stored in the named [arg var] for access
           27  +by the [arg script].
           28  +
           29  +The result of the command is the table's object command.
           30  +
           31  +[list_begin arguments]
           32  +[arg_def varname var]
           33  +The name of the variable in the calling scope the new table's object
           34  +command will be stored into.
           35  +[arg_def list headers]
           36  +The list of words to user as column headers.
           37  +[arg_def string  script]
           38  +The tcl script to be run to configure and populate the table.
           39  +[list_end]
           40  +
           41  +[comment {- - -- --- ----- -------- -------------}]
           42  +[call [cmd ::cmdr::table] [method dict] [arg var] [arg script]]
           43  +
           44  +This command creates a new table intended for the display of a Tcl
           45  +dictionary.
           46  +It will have two columns titled [const Key] and [const Value].
           47  +
           48  +The [arg script] is run in the calling context to configure and
           49  +populate the table.
           50  +
           51  +The table's object command is stored in the named [arg var] for access
           52  +by the [arg script].
           53  +
           54  +The result of the command is the table's object command.
           55  +
           56  +[list_begin arguments]
           57  +[arg_def varname var]
           58  +The name of the variable in the calling scope the new table's object
           59  +command will be stored into.
           60  +[arg_def string  script]
           61  +The tcl script to be run to configure and populate the table.
           62  +[list_end]
           63  +
           64  +[comment {- - -- --- ----- -------- -------------}]
           65  +[call [cmd ::cmdr::table] [method borders] [opt [arg enable]]]
           66  +
           67  +This command configures the global [term border] setting, which
           68  +indicates the (non)use of borders by the tables of this package. Note
           69  +that changes to this setting influence only the tables created after
           70  +the change. Existing tables are not modified.
           71  +
           72  +[para] The result of the command is the new state of the setting.
           73  +
           74  +[para] If the command is called without an argument it simply returns the
           75  +current state of the setting, without making changes.
           76  +
           77  +[para] The default value for the setting is [const yes].
           78  +
           79  +Individual tables can override the global settings via their
           80  +[method borders] method, see [sectref {Table API}].
           81  +
           82  +[list_begin arguments]
           83  +[arg_def boolean enable]
           84  +The new value of the setting. Optional.
           85  +[list_end]
           86  +
           87  +[comment {- - -- --- ----- -------- -------------}]
           88  +[call [cmd ::cmdr::table] [method show] [opt [arg cmd]...]]
           89  +
           90  +This command configures the global [term show] setting, which is the
           91  +command prefix to use to print a table, if the table is not given a
           92  +specific command to use. Note that changes to this setting influence
           93  +only the tables created after the change. Existing tables are not
           94  +modified.
           95  +
           96  +[para] The result of the command is the new state of the setting
           97  +
           98  +[para] If the command is called without any arguments it simply
           99  +returns the current state of the setting, without making changes.
          100  +
          101  +[para] The default value for the setting is [const puts].
          102  +
          103  +[list_begin arguments]
          104  +[arg_def word cmd]
          105  +The command prefix to use for printing a table, as varargs.
          106  +The prefix will be invoked with a single argument, the string
          107  +representation of the table.
          108  +[list_end]
          109  +[list_end]
          110  +
          111  +[comment {- - -- --- ----- -------- ------------- ---------------------}]
          112  +[section {Table API}]
          113  +
          114  +This section lists the methods available for configuration and
          115  +population of the tables created by this package.
          116  +
          117  +[list_begin definitions]
          118  +[comment {- - -- --- ----- -------- -------------}]
          119  +[call [var t] [method borders] [opt [arg enable]]]
          120  +
          121  +This is the table-level [term borders] setting. On creation a table
          122  +inherits the global setting (See [cmd {::cmdr::table borders}]). If
          123  +that is not to suit then this method can be used to override it.
          124  +
          125  +[para] The result of the method is the new state of the setting. When
          126  +called without argument no change is made and the result is the
          127  +current state of the setting.
          128  +
          129  +[comment {- - -- --- ----- -------- -------------}]
          130  +[call [var t] [method headers] [opt [arg enable]]]
          131  +
          132  +This method controls the visibility of the header row.  By default
          133  +general tables have the header row visisble, while for dict tables the
          134  +header is suppressed. This method allows the user to override these
          135  +defaults.
          136  +
          137  +[para] The result of the method is the new state of the setting. When
          138  +called without argument no change is made and the result is the
          139  +current state of the setting.
          140  +
          141  +[comment {- - -- --- ----- -------- -------------}]
          142  +[call [var t] [method style] [opt [arg style]]]
          143  +
          144  +This method allows the user to force the use of a completely custom
          145  +style.
          146  +
          147  +Please see the documentation for the Tcllib package [package report]
          148  +on how to define table styles.
          149  +
          150  +[para] The package defines four styles of its own, all using the
          151  +common prefix [const cmdr/table/] in their names.
          152  +
          153  +When no custom style is set the table chooses between these based on
          154  +its [term borders] and [term headers] settings.
          155  +
          156  +[para] The result of the method is the new state of the setting. When
          157  +called without argument then no change is made and the result is the
          158  +current state of the setting.
          159  +
          160  +[para] To revert from a custom style to the automatic choice invoke
          161  +this method with the empty string as the name of the style.
          162  +
          163  +[comment {- - -- --- ----- -------- -------------}]
          164  +[call [var t] [method add] [arg word]...]
          165  +[call [var t] [method +]   [arg word]...]
          166  +[call [var t] [method +=]  [arg word]...]
          167  +[call [var t] [method <<]  [arg word]...]
          168  +[call [var t] [method <=]  [arg word]...]
          169  +
          170  +This method adds a new row to the table, containing the given words.
          171  +If less words than headers are specified the row is padded with empty columns.
          172  +If too many words are specified the superfluous words are ignored.
          173  +
          174  +[para] The result of the method is the empty string.
          175  +
          176  +[comment {- - -- --- ----- -------- -------------}]
          177  +[call [var t] [method show*] [opt [arg cmd]]]
          178  +
          179  +This method formats the table into a string and then invokes the
          180  +command prefix [arg cmd] to print that string. The command prefix is
          181  +run at the global namespace and level. If the [arg cmd] is not
          182  +specified the global [term show] setting is used instead.
          183  +
          184  +[para] The result of the method is the empty string.
          185  +
          186  +[comment {- - -- --- ----- -------- -------------}]
          187  +[call [var t] [method show] [opt [arg cmd]]]
          188  +
          189  +This is a variant of method [method show*] above which not only prints
          190  +the table as above, but also destroys it.
          191  +
          192  +[list_end]
          193  +
          194  +[include parts/feedback.inc]
          195  +[manpage_end]

Changes to doc/parts/definitions.inc.

    25     25   [vset TITLE_HELP_SQL      "[vset PTITLE] - Formatting help as series of SQL commands"]
    26     26   [vset TITLE_HELP_TCL      "[vset PTITLE] - Formatting help as Tcl data structure"]
    27     27   [vset TITLE_HISTORY       "[vset PTITLE] - Utilities for history management"]
    28     28   [vset TITLE_OFFICER       "[vset PTITLE] - (Internal) Aggregation of multiple commands for dispatch."]
    29     29   [vset TITLE_PAGER         "[vset PTITLE] - Paging long output"]
    30     30   [vset TITLE_PARAMETER     "[vset PTITLE] - (Partially internal) Command parameters"]
    31     31   [vset TITLE_PRIVATE       "[vset PTITLE] - (Internal) Single command handling, options, and arguments"]
           32  +[vset TITLE_TABLE         "[vset PTITLE] - Simple Table creation"]
    32     33   [vset TITLE_TTY           "[vset PTITLE] - Check if stdin is a tty, i.e. terminal"]
    33     34   [vset TITLE_UTIL          "[vset PTITLE] - (Internal) General Utilities"]
    34     35   [vset TITLE_VALIDATE      "[vset PTITLE] - Standard validation types for parameters"]
    35     36   [vset TITLE_VCOMMON       "[vset PTITLE] - Utilities for Validation Types"]
    36     37   [vset TITLE_FLOW          "[vset PTITLE] - Runtime Processing Flow"]
    37     38   
    38     39   [vset TITLE_VT_YEAR       "[vset PTITLE] - Validation type for years"]
................................................................................
    68     69   [vset LABEL_HELP_SQL      [vset PROJECT]::help::sql]
    69     70   [vset LABEL_HELP_TCL      [vset PROJECT]::help::tcl]
    70     71   [vset LABEL_HISTORY       [vset PROJECT]::history]
    71     72   [vset LABEL_OFFICER       [vset PROJECT]::officer]
    72     73   [vset LABEL_PAGER         [vset PROJECT]::pager]
    73     74   [vset LABEL_PARAMETER     [vset PROJECT]::parameter]
    74     75   [vset LABEL_PRIVATE       [vset PROJECT]::private]
           76  +[vset LABEL_TABLE         [vset PROJECT]::table]
    75     77   [vset LABEL_TTY           [vset PROJECT]::tty]
    76     78   [vset LABEL_UTIL          [vset PROJECT]::util]
    77     79   [vset LABEL_VALIDATE      [vset PROJECT]::validate]
    78     80   [vset LABEL_VCOMMON       [vset PROJECT]::validate::common]
    79     81   [vset LABEL_FLOW          [vset PROJECT]-spec-flow]
    80     82   
    81     83   [vset LABEL_VT_YEAR       [vset PROJECT]::validate::year]
    82     84   [vset LABEL_VT_WEEKDAY    [vset PROJECT]::validate::weekday]
    83     85   [vset LABEL_VT_TIME       [vset PROJECT]::validate::time]
    84     86   [vset LABEL_VT_TIME_MIN   [vset PROJECT]::validate::time::minute]
    85     87   [vset LABEL_VT_POSINT     [vset PROJECT]::validate::posint]
    86     88   [vset LABEL_VT_DATE       [vset PROJECT]::validate::date]

Added tests/table.test.

            1  +# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0
            2  +# # ## ### ##### ######## ############# #####################
            3  +## Testing the cmdr::table package.
            4  +
            5  +kt check Tcl     8.5
            6  +kt check tcltest 2
            7  +
            8  +kt require support TclOO
            9  +kt require support debug
           10  +kt require support debug::caller
           11  +kt require support report
           12  +kt require support struct::matrix
           13  +kt local   support cmdr::color
           14  +
           15  +kt local   testing cmdr::table
           16  +
           17  +proc nop  {args} {}
           18  +proc ping {args} { set ::ping 1 ; return }
           19  +proc record  {s} { set ::ping $s }
           20  +
           21  +# # ## ### ##### ######## ############# #####################
           22  +## Basic wrong#args checks.
           23  +
           24  +test cmdr-table-1.0 {table, wrong num args, not enough} -body {
           25  +    cmdr table
           26  +} -returnCodes error \
           27  +    -result {wrong # args: should be "cmdr table subcommand ?argument ...?"}
           28  +
           29  +test cmdr-table-1.1 {table, bogus sub-command} -body {
           30  +    cmdr table foo
           31  +} -returnCodes error \
           32  +    -result {unknown or ambiguous subcommand "foo": must be borders, dict, general, or show}
           33  +
           34  +# # ## ### ##### ######## ############# #####################
           35  +## Global border control
           36  +
           37  +test cmdr-table-2.0 {table borders, wrong num args, too many} -body {
           38  +    cmdr table borders 0 X
           39  +} -returnCodes error \
           40  +    -result {wrong # args: should be "cmdr table borders ?enable?"}
           41  +
           42  +test cmdr-table-2.1 {table borders, default} -body {
           43  +    cmdr table borders
           44  +} -result yes
           45  +
           46  +test cmdr-table-2.2.0 {table borders, clear} -body {
           47  +    cmdr table borders 0
           48  +} -result 0
           49  +
           50  +test cmdr-table-2.2.1 {table borders, set} -body {
           51  +    cmdr table borders 1
           52  +} -result 1
           53  +
           54  +test cmdr-table-2.2.2 {table borders, set, not boolean} -body {
           55  +    cmdr table borders bogus
           56  +} -returnCodes error -result {Expected boolean, got "bogus"}
           57  +
           58  +test cmdr-table-2.3.0 {table borders, style influence, no borders} -body {
           59  +    cmdr table borders 0
           60  +    cmdr table general T {a b} {}
           61  +    $T style
           62  +} -cleanup {
           63  +    $T destroy
           64  +    unset T
           65  +} -result cmdr/table/plain
           66  +
           67  +test cmdr-table-2.3.1 {table borders, style influence, with borders} -body {
           68  +    cmdr table borders 1
           69  +    cmdr table general T {a b} {}
           70  +    $T style
           71  +} -cleanup {
           72  +    $T destroy
           73  +    unset T
           74  +} -result cmdr/table/borders
           75  +
           76  +# # ## ### ##### ######## ############# #####################
           77  +## Global show command
           78  +## Note: No wrong#args, accepts 0 and more arguments.
           79  +
           80  +test cmdr-table-3.0 {table show, default} -body {
           81  +    cmdr table show
           82  +} -result puts
           83  +
           84  +test cmdr-table-3.1 {table show, set} -body {
           85  +    cmdr table show this way
           86  +} -result {this way}
           87  +
           88  +test cmdr-table-3.2 {table show, fallback} -setup {
           89  +    unset -nocomplain ping
           90  +} -body {
           91  +    cmdr table show ping
           92  +    cmdr table general T {a b} {}
           93  +    $T show*
           94  +    set ping
           95  +} -cleanup {
           96  +    $T destroy
           97  +    unset T ping
           98  +} -result 1
           99  +
          100  +# # ## ### ##### ######## ############# #####################
          101  +## General table
          102  +
          103  +test cmdr-table-4.0.0 {table general, wrong num args, not enough} -body {
          104  +    cmdr table general
          105  +} -returnCodes error \
          106  +    -result {wrong # args: should be "cmdr table general v headings script"}
          107  +
          108  +test cmdr-table-4.0.1 {table general, wrong num args, not enough} -body {
          109  +    cmdr table general T
          110  +} -returnCodes error \
          111  +    -result {wrong # args: should be "cmdr table general v headings script"}
          112  +
          113  +test cmdr-table-4.0.2 {table general, wrong num args, not enough} -body {
          114  +    cmdr table general T H
          115  +} -returnCodes error \
          116  +    -result {wrong # args: should be "cmdr table general v headings script"}
          117  +
          118  +test cmdr-table-4.0.3 {table general, wrong num args, too many} -body {
          119  +    cmdr table general T H S X
          120  +} -returnCodes error \
          121  +    -result {wrong # args: should be "cmdr table general v headings script"}
          122  +
          123  +test cmdr-table-4.1.0 {table general, empty, lifecycle, constructor} -body {
          124  +    cmdr table general T {a b} {}
          125  +} -cleanup {
          126  +    $T destroy
          127  +    unset T
          128  +} -match glob -result {::oo::Obj*}
          129  +
          130  +test cmdr-table-4.1.1 {table general, empty, lifecycle, destructor} -setup {
          131  +    cmdr table general T {a b} {}
          132  +} -body {
          133  +    $T destroy
          134  +} -cleanup {
          135  +    unset T
          136  +} -result {}
          137  +
          138  +# # ## ### ##### ######## ############# #####################
          139  +## Dict table
          140  +
          141  +test cmdr-table-5.0.0 {table dict, wrong num args, not enough} -body {
          142  +    cmdr table dict
          143  +} -returnCodes error \
          144  +    -result {wrong # args: should be "cmdr table dict v script"}
          145  +
          146  +test cmdr-table-5.0.1 {table dict, wrong num args, not enough} -body {
          147  +    cmdr table dict T
          148  +} -returnCodes error \
          149  +    -result {wrong # args: should be "cmdr table dict v script"}
          150  +
          151  +test cmdr-table-5.0.2 {table dict, wrong num args, too many} -body {
          152  +    cmdr table dict T S X
          153  +} -returnCodes error \
          154  +    -result {wrong # args: should be "cmdr table dict v script"}
          155  +
          156  +test cmdr-table-5.1.0 {table dict, empty, lifecycle, constructor} -body {
          157  +    cmdr table dict T {}
          158  +} -cleanup {
          159  +    $T destroy
          160  +    unset T
          161  +} -match glob -result {::oo::Obj*}
          162  +
          163  +test cmdr-table-5.1.1 {table dict, empty, lifecycle, destructor} -setup {
          164  +    cmdr table dict T {}
          165  +} -body {
          166  +    $T destroy
          167  +} -cleanup {
          168  +    unset T
          169  +} -result {}
          170  +
          171  +# # ## ### ##### ######## ############# #####################
          172  +## table row add - no wrong num args, everything is possible
          173  +
          174  +test cmdr-table-6.0.0 {table row add, result} -setup {
          175  +    cmdr table general T {a b} {}
          176  +} -body {
          177  +    $T add c d
          178  +} -cleanup {
          179  +    $T destroy
          180  +    unset T
          181  +} -result {}
          182  +
          183  +test cmdr-table-6.0.1 {table row add, content} -setup {
          184  +    unset -nocomplain ping
          185  +    cmdr table general T {a b} {}
          186  +} -body {
          187  +    $T add c d
          188  +    $T show* record
          189  +    set ping
          190  +} -cleanup {
          191  +    $T destroy
          192  +    unset T ping
          193  +} -match glob -result {*| c | d |*}
          194  +
          195  +# # ## ### ##### ######## ############# #####################
          196  +## Per-table border control
          197  +
          198  +test cmdr-table-7.0 {table borders, wrong num args, too many} -setup {
          199  +    cmdr table general T {a b} {}
          200  +} -body {
          201  +    $T borders 0 X
          202  +} -cleanup {
          203  +    $T destroy
          204  +    unset T
          205  +} -returnCodes error \
          206  +    -match glob -result {wrong # args: should be "::oo::Obj* borders \?enable\?"}
          207  +
          208  +test cmdr-table-7.1.0 {table borders, default} -setup {
          209  +    cmdr table general T {a b} {}
          210  +} -body {
          211  +    $T borders
          212  +} -cleanup {
          213  +    $T destroy
          214  +    unset T
          215  +} -result 1
          216  +
          217  +test cmdr-table-7.1.1 {dict borders, default} -setup {
          218  +    cmdr table dict T {}
          219  +} -body {
          220  +    $T borders
          221  +} -cleanup {
          222  +    $T destroy
          223  +    unset T
          224  +} -result 1
          225  +
          226  +test cmdr-table-7.2.0 {table borders, clear} -setup {
          227  +    cmdr table general T {a b} {}
          228  +} -body {
          229  +    $T borders 0
          230  +} -cleanup {
          231  +    $T destroy
          232  +    unset T
          233  +} -result 0
          234  +
          235  +test cmdr-table-7.2.1 {table borders, set} -setup {
          236  +    cmdr table general T {a b} {}
          237  +} -body {
          238  +    $T borders 1
          239  +} -cleanup {
          240  +    $T destroy
          241  +    unset T
          242  +} -result 1
          243  +
          244  +test cmdr-table-7.2.2 {table borders, set, not boolean} -setup {
          245  +    cmdr table general T {a b} {}
          246  +} -body {
          247  +    $T borders bogus
          248  +} -cleanup {
          249  +    $T destroy
          250  +    unset T
          251  +} -returnCodes error -result {Expected boolean, got "bogus"}
          252  +
          253  +test cmdr-table-7.3.0 {table borders, style influence, no borders} -setup {
          254  +    cmdr table general T {a b} {}
          255  +} -body {
          256  +    $T borders 0
          257  +    $T style
          258  +} -cleanup {
          259  +    $T destroy
          260  +    unset T
          261  +} -result cmdr/table/plain
          262  +
          263  +test cmdr-table-7.3.1 {table borders, style influence, with borders} -setup {
          264  +    cmdr table general T {a b} {}
          265  +} -body {
          266  +    $T borders 1
          267  +    $T style
          268  +} -cleanup {
          269  +    $T destroy
          270  +    unset T
          271  +} -result cmdr/table/borders
          272  +
          273  +# # ## ### ##### ######## ############# #####################
          274  +## Per-table header control
          275  +
          276  +test cmdr-table-8.0 {table headers, wrong num args, too many} -setup {
          277  +    cmdr table general T {a b} {}
          278  +} -body {
          279  +    $T headers 0 X
          280  +} -cleanup {
          281  +    $T destroy
          282  +    unset T
          283  +} -returnCodes error \
          284  +    -match glob -result {wrong # args: should be "::oo::Obj* headers \?enable\?"}
          285  +
          286  +test cmdr-table-8.1.0 {table headers, default} -setup {
          287  +    cmdr table general T {a b} {}
          288  +} -body {
          289  +    $T headers
          290  +} -cleanup {
          291  +    $T destroy
          292  +    unset T
          293  +} -result 1
          294  +
          295  +test cmdr-table-8.1.1 {dict headers, default} -setup {
          296  +    cmdr table dict T {}
          297  +} -body {
          298  +    $T headers
          299  +} -cleanup {
          300  +    $T destroy
          301  +    unset T
          302  +} -result no
          303  +
          304  +test cmdr-table-8.2.0 {table headers, clear} -setup {
          305  +    cmdr table general T {a b} {}
          306  +} -body {
          307  +    $T headers 0
          308  +} -cleanup {
          309  +    $T destroy
          310  +    unset T
          311  +} -result 0
          312  +
          313  +test cmdr-table-8.2.1 {table headers, set} -setup {
          314  +    cmdr table general T {a b} {}
          315  +} -body {
          316  +    $T headers 1
          317  +} -cleanup {
          318  +    $T destroy
          319  +    unset T
          320  +} -result 1
          321  +
          322  +test cmdr-table-8.2.2 {table headers, set, not boolean} -setup {
          323  +    cmdr table general T {a b} {}
          324  +} -body {
          325  +    $T headers bogus
          326  +} -cleanup {
          327  +    $T destroy
          328  +    unset T
          329  +} -returnCodes error -result {Expected boolean, got "bogus"}
          330  +
          331  +test cmdr-table-8.3.0 {table headers, style influence, no headers} -setup {
          332  +    cmdr table general T {a b} {}
          333  +} -body {
          334  +    $T headers 0
          335  +    $T style
          336  +} -cleanup {
          337  +    $T destroy
          338  +    unset T
          339  +} -result cmdr/table/borders/nohdr
          340  +
          341  +test cmdr-table-8.3.1 {table headers, style influence, with headers} -setup {
          342  +    cmdr table general T {a b} {}
          343  +} -body {
          344  +    $T headers 1
          345  +    $T style
          346  +} -cleanup {
          347  +    $T destroy
          348  +    unset T
          349  +} -result cmdr/table/borders
          350  +
          351  +# # ## ### ##### ######## ############# #####################
          352  +## Per-table style control
          353  +
          354  +test cmdr-table-9.0 {table style, wrong num args, too many} -setup {
          355  +    cmdr table general T {a b} {}
          356  +} -body {
          357  +    $T style 0 X
          358  +} -cleanup {
          359  +    $T destroy
          360  +    unset T
          361  +} -returnCodes error \
          362  +    -match glob -result {wrong # args: should be "::oo::Obj* style \?style\?"}
          363  +
          364  +test cmdr-table-9.1.0 {table style, default} -setup {
          365  +    cmdr table general T {a b} {}
          366  +} -body {
          367  +    $T style
          368  +} -cleanup {
          369  +    $T destroy
          370  +    unset T
          371  +} -result cmdr/table/borders
          372  +
          373  +test cmdr-table-9.1.1 {dict style, default} -setup {
          374  +    cmdr table dict T {}
          375  +} -body {
          376  +    $T style
          377  +} -cleanup {
          378  +    $T destroy
          379  +    unset T
          380  +} -result cmdr/table/borders/nohdr
          381  +
          382  +test cmdr-table-9.2.0 {table style, reset to default} -setup {
          383  +    cmdr table general T {a b} {}
          384  +    $T style foo
          385  +} -body {
          386  +    $T style {}
          387  +} -cleanup {
          388  +    $T destroy
          389  +    unset T
          390  +} -result cmdr/table/borders
          391  +
          392  +test cmdr-table-9.2.1 {table style, set} -setup {
          393  +    cmdr table general T {a b} {}
          394  +} -body {
          395  +    $T style foo
          396  +} -cleanup {
          397  +    $T destroy
          398  +    unset T
          399  +} -result foo
          400  +
          401  +# # ## ### ##### ######## ############# #####################
          402  +## Table printing with auto-destruction
          403  +
          404  +test cmdr-table-10.0 {table show, wrong num args, too many} -setup {
          405  +    cmdr table general T {a b} {}
          406  +} -body {
          407  +    $T show C X
          408  +} -cleanup {
          409  +    $T destroy
          410  +    unset T
          411  +} -match glob -returnCodes error \
          412  +    -result {wrong # args: should be "::oo::Obj* show ?cmd?"}
          413  +
          414  +test cmdr-table-10.1 {table show, and automatic destruction} -setup {
          415  +    unset -nocomplain ping
          416  +    cmdr table general T {a b} {}
          417  +} -body {
          418  +    $T show ping
          419  +    list $ping [llength [info commands $T]]
          420  +} -cleanup {
          421  +    unset T ping
          422  +} -result {1 0}
          423  +
          424  +# # ## ### ##### ######## ############# #####################
          425  +## Table printing, no auto-destruction
          426  +
          427  +test cmdr-table-11.0 {table show*, wrong num args, too many} -setup {
          428  +    cmdr table general T {a b} {}
          429  +} -body {
          430  +    $T show* C X
          431  +} -cleanup {
          432  +    $T destroy
          433  +    unset T
          434  +} -match glob -returnCodes error \
          435  +    -result {wrong # args: should be "::oo::Obj* show\* ?cmd?"}
          436  +
          437  +test cmdr-table-11.1 {table show*, no destruction} -setup {
          438  +    unset -nocomplain ping
          439  +    cmdr table general T {a b} {}
          440  +} -body {
          441  +    $T show* ping
          442  +    list $ping [llength [info commands $T]]
          443  +} -cleanup {
          444  +    $T destroy
          445  +    unset T ping
          446  +} -result {1 1}
          447  +
          448  +# # ## ### ##### ######## ############# #####################
          449  +rename nop    {}
          450  +rename ping   {}
          451  +rename record {}
          452  +
          453  +cleanupTests
          454  +return

Changes to utilities/table.tcl.

     1      1   # -*- tcl -*-
     2      2   # # ## ### ##### ######## ############# #####################
     3      3   ## Easy table generation
     4      4   
     5      5   # @@ Meta Begin
     6         -# Package cmdr::table 0
     7         -# Meta author      ?
     8         -# Meta category    ?
     9         -# Meta description ?
    10         -# Meta location    http:/core.tcl.tk/akupries/cmdr
            6  +# Package cmdr::table 0.1
            7  +# Meta author   {Andreas Kupries}
            8  +# Meta location https://core.tcl.tk/akupries/cmdr
    11      9   # Meta platform    tcl
    12         -# Meta require     ?
    13         -# Meta subject     ?
    14         -# Meta summary     ?
           10  +# Meta summary Easy generation of tables
           11  +# Meta description Easy generation of tables
           12  +# Meta subject {command line} table matrix report
           13  +# Meta require {Tcl 8.5-}
           14  +# Meta require TclOO
           15  +# Meta require cmdr::color
           16  +# Meta require debug
           17  +# Meta require debug::caller
           18  +# Meta require report
           19  +# Meta require struct::matrix
    15     20   # @@ Meta End
    16     21   
    17     22   # # ## ### ##### ######## ############# #####################
    18     23   ## Requirements
    19     24   
    20     25   package require Tcl 8.5
    21     26   package require TclOO
................................................................................
    93     98   # # ## ### ##### ######## ############# ######################
    94     99   
    95    100   namespace eval ::cmdr {
    96    101       namespace export table
    97    102       namespace ensemble create
    98    103   }
    99    104   namespace eval ::cmdr::table {
   100         -    variable plain   no   ;# Global style setting (plain yes/no)
          105  +    variable borders yes  ;# Global style setting (use borders: yes/no)
   101    106       variable showcmd puts ;# Global print setting (command prefix)
   102    107   
   103         -    namespace export general dict plain show
          108  +    namespace export general dict borders show
   104    109       namespace ensemble create
   105    110   }
   106    111   
   107    112   # # ## ### ##### ######## ############# #####################
   108    113   ## API
   109    114   
   110         -proc ::cmdr::table::plain {v} {
          115  +proc ::cmdr::table::borders {{enable {}}} {
   111    116       debug.cmdr/table {}
   112         -    variable plain $v
   113         -    return
          117  +    variable borders
          118  +    if {[llength [info level 0]] > 1} {
          119  +	CheckBool $enable
          120  +	set borders $enable
          121  +    }
          122  +    return $borders
   114    123   }
   115    124   
   116    125   proc ::cmdr::table::show {args} {
   117    126       debug.cmdr/table {}
   118         -    variable showcmd $args
   119         -    return
          127  +    variable showcmd
          128  +    if {[llength $args]} {
          129  +	set showcmd $args
          130  +    }
          131  +    return $showcmd
   120    132   }
   121    133   
   122    134   proc ::cmdr::table::general {v headings script} {
   123    135       debug.cmdr/table {}
   124    136   
   125         -    variable plain
          137  +    variable borders
   126    138       upvar 1 $v t
   127    139       set t [uplevel 1 [list ::cmdr::table::Impl::general new {*}$headings]]
   128         -    if {$plain} { $t plain }
          140  +    if {!$borders} { $t borders no }
   129    141       uplevel 1 $script
   130    142       return $t
   131    143   }
   132    144   
   133    145   proc ::cmdr::table::dict {v script} {
   134    146       debug.cmdr/table {}
   135    147   
   136    148       upvar 1 $v t
   137         -    variable plain
          149  +    variable borders
   138    150       set t [uplevel 1 [list ::cmdr::table::Impl::dict new]]
   139         -    if {$plain} { $t plain }
          151  +    if {!$borders} { $t borders no }
   140    152       uplevel 1 $script
   141    153       return $t
   142    154   }
          155  +
          156  +proc ::cmdr::table::CheckBool {v} {
          157  +    debug.cmdr/table {}
          158  +    if {[string is boolean -strict $v]} return
          159  +    return -code error -errorcode {CMDR TABLE NOT-A-BOOLEAN} \
          160  +	"Expected boolean, got \"$v\""
          161  +}
   143    162   
   144    163   # # ## ### ##### ######## ############# #####################
   145    164   ## Internal classes
   146    165   
   147    166   oo::class create ::cmdr::table::Impl::general {
   148    167       # # ## ### ##### ######## #############
   149    168   
................................................................................
   155    174   	struct::matrix [self namespace]::M
   156    175   	M add columns [llength $args]
   157    176   
   158    177   	set headings {}
   159    178   	foreach w $args { lappend headings [color heading $w] }
   160    179   
   161    180   	M add row $headings
   162         -	set myplain 0
   163         -	set myheader 1
          181  +	set myborders 1
          182  +	set myheaders 1
   164    183   	set mystyle {}
   165    184   	return
   166    185       }
   167    186   
   168    187       destructor {}
   169    188   
   170    189       # # ## ### ##### ######## #############
................................................................................
   195    214   	    variable ::cmdr::table::showcmd
   196    215   	    set cmd $::cmdr::table::showcmd
   197    216   	}
   198    217   	uplevel #0 [list {*}$cmd [my String]]
   199    218   	return
   200    219       }
   201    220   
   202         -    method plain {} {
          221  +    method borders {{enable {}}} {
   203    222   	debug.cmdr/table {}
   204         -	set myplain 1
   205         -	return
          223  +	if {[llength [info level 0]] > 2} {
          224  +	    ::cmdr::table::CheckBool $enable
          225  +	    set myborders $enable
          226  +	}
          227  +	return $myborders
   206    228       }
   207    229   
   208         -    method style {style} {
          230  +    method headers {{enable {}}} {
   209    231   	debug.cmdr/table {}
   210         -	set mystyle $style
   211         -	return
          232  +	if {[llength [info level 0]] > 2} {
          233  +	    ::cmdr::table::CheckBool $enable
          234  +	    set myheaders $enable
          235  +	}
          236  +	return $myheaders
   212    237       }
   213    238   
   214         -    method noheader {} {
          239  +    method style {{style {}}} {
   215    240   	debug.cmdr/table {}
   216         -	if {!$myheader} return
   217         -	set myheader 0
   218         -	M delete row 0
   219         -	return
          241  +	if {[llength [info level 0]] > 2} {
          242  +	    set mystyle $style
          243  +	}
          244  +	return [my Style]
   220    245       }
   221    246   
   222         -    method String {} {
          247  +    method Style {} {
   223    248   	debug.cmdr/table {}
   224         -	# Choose style (user-specified, plain y/n, header y/n)
   225         -
          249  +	# Determine and return style (user-specified, borders y/n, header y/n)
   226    250   	if {$mystyle ne {}} {
   227    251   	    set thestyle $mystyle
   228         -	} elseif {$myplain} {
   229         -	    if {$myheader} {
   230         -		set thestyle cmdr/table/plain
   231         -	    } else {
   232         -		set thestyle cmdr/table/plain/nohdr
   233         -	    }
   234         -	} else {
   235         -	    if {$myheader} {
          252  +	} elseif {$myborders} {
          253  +	    if {$myheaders} {
   236    254   		set thestyle cmdr/table/borders
   237    255   	    } else {
   238    256   		set thestyle cmdr/table/borders/nohdr
   239    257   	    }
          258  +	} elseif {$myheaders} {
          259  +	    set thestyle cmdr/table/plain
          260  +	} else {
          261  +	    set thestyle cmdr/table/plain/nohdr
   240    262   	}
   241    263   
   242         -	set r [report::report [self namespace]::R [M columns] style $thestyle]
          264  +	debug.cmdr/table {==> ($thestyle)}
          265  +	return $thestyle
          266  +    }
          267  +
          268  +    method String {} {
          269  +	debug.cmdr/table {}
          270  +	set r [report::report [self namespace]::R [M columns] style [my Style]]
   243    271   	set str [M format 2string $r]
   244    272   	$r destroy
   245         -
   246    273   	return [string trimright $str]
   247    274       }
   248    275   
   249    276       # # ## ### ##### ######## #############
   250    277       ## Internal commands.
   251    278   
   252    279       # # ## ### ##### ######## #############
   253    280       ## State
   254    281   
   255         -    variable myplain myheader mystyle
          282  +    variable myborders myheaders mystyle
   256    283   
   257    284       # # ## ### ##### ######## #############
   258    285   }
   259    286   
   260    287   # # ## ### ##### ######## ############# #####################
   261    288   
   262    289   oo::class create ::cmdr::table::Impl::dict {
   263    290       # # ## ### ##### ######## #############
   264    291       superclass ::cmdr::table::Impl::general
   265    292   
   266    293       constructor {} {
   267    294   	debug.cmdr/table {}
   268    295   	next Key Value
   269         -	my noheader ;# suppress header row.
          296  +	my headers no ;# suppress header row.
   270    297   	# Keys are the headers (side ways table).
   271    298   	return
   272    299       }
   273    300   
   274    301       destructor {}
   275    302   
   276    303       # # ## ### ##### ######## #############
................................................................................
   284    311   	# applied here.
   285    312   
   286    313   	regexp {(^[- ]*)(.*)$} $key -> prefix thekey
   287    314   	M add row [list $prefix[color heading $thekey] $value]
   288    315   	return
   289    316       }
   290    317   
   291         -    # # ## ### ##### ######## #############
   292         -    ## Internal commands.
   293         -
   294         -    # # ## ### ##### ######## #############
   295         -    ## State - None of its own.
   296         -
   297    318       # # ## ### ##### ######## #############
   298    319   }
   299    320   
   300    321   # # ## ### ##### ######## ############# #####################
   301    322   ## Ready
   302         -package provide cmdr::table 0
          323  +package provide cmdr::table 0.1